[libcatmandu-perl] 16/101: Fixing the importer for body variables

[Jonas Smedegaard]

This is an automated email from the git hooks/post-receive script.

js pushed a commit to branch master
in repository libcatmandu-perl.

commit 63b1c232e8b4a2972a71acee2fb0432e05d56501
Author: Patrick Hochstenbach <patrick.hochstenbach at ugent.be>
Date:   Fri Dec 11 10:10:14 2015 +0100

    Fixing the importer for body variables
---
 lib/Catmandu/Importer.pm | 37 ++++++++++++++++++++++++++++++++++++-
 t/Catmandu-Importer.t    | 26 ++++++++++++++++++++++++++
 2 files changed, 62 insertions(+), 1 deletion(-)

diff --git a/lib/Catmandu/Importer.pm b/lib/Catmandu/Importer.pm
index c9d9df9..6d57034 100644
--- a/lib/Catmandu/Importer.pm
+++ b/lib/Catmandu/Importer.pm
@@ -90,9 +90,12 @@ sub _build_fh {
 
         if ($self->has_http_body) {
             $body = $self->http_body;
+            
             if (ref $body) {
                 $body = $self->serialize($body);
-            } elsif ($self->has_variables) {
+            }
+
+            if ($self->has_variables) {
                 my $vars = $self->variables;
                 if (is_hash_ref($vars)) { # named variables
                     for my $key (keys %$vars) {
@@ -291,18 +294,50 @@ These options are only relevant if C<file> is a url. See L<LWP::UserAgent> for d
 
 =over
 
+=item http_body
+
+Set the GET/POST message body.
+
 =item http_method
 
+Set the type of HTTP request 'GET', 'POST' , ...
+
 =item http_headers
 
+A reference to a HTTP::Headers objects.
+
+=back
+
+=head2 Set an own HTTP client
+
+=over 
+
+=item user_agent(LWP::UserAgent->new(...))
+
+Set an own HTTP client
+
+=back
+
+=head2 Alternative set the parameters of the default client
+
+=over
+
 =item http_agent
 
+A string containing the name of the HTTP client.
+
 =item http_max_redirect
 
+Maximum number of HTTP redirects allowed.
+
 =item http_timeout 
 
+Maximum execution time.
+
 =item http_verify_hostname
 
+Verify the SSL certificate.
+
 =back
 
 =head1 METHODS
diff --git a/t/Catmandu-Importer.t b/t/Catmandu-Importer.t
index 2af0dc7..1fb5663 100644
--- a/t/Catmandu-Importer.t
+++ b/t/Catmandu-Importer.t
@@ -74,6 +74,22 @@ $i = T::Importer->new( user_agent => user_agent() , file => 'http://demo.org/{1}
 is $i->file , "http://demo.org/red,green,blue";
 is $i->readall , "RED-GREEN-BLUE" , "read from http (file + variables list)";
 
+$i = T::Importer->new(user_agent => user_agent() , file => 'http://demo.org/post' , http_method => 'POST' , http_body => '=={id}==' , variables => { id => 1234} );
+is $i->file , "http://demo.org/post";
+is $i->readall , "POST" , "read from http (file + variables list + post request)";
+
+$i = T::Importer->new(user_agent => user_agent() , file => 'http://demo.org/post' , http_method => 'POST',  http_body => '=={id}==' , variables => "red,green,blue" );
+is $i->file , "http://demo.org/post";
+is $i->readall , "POST" , "read from http (file + variables list + post request)";
+
+$i = T::Importer->new(user_agent => user_agent() , file => 'http://demo.org/not-exsists' , http_method => 'POST',  http_body => '=={id}==' , variables => "red,green,blue" );
+
+throws_ok { $i->readall } 'Catmandu::HTTPError' , "throws an error on non-existing pages";
+
+$i = T::Importer->new(file => 'http://demo.org');
+
+is ref($i->_http_client) , 'LWP::UserAgent' , 'Got a real client';
+
 done_testing;
 
 sub user_agent  {
@@ -109,6 +125,16 @@ sub user_agent  {
         )
     );
 
+    $ua->map_response(
+        qr{^http://demo.org/post$},
+        HTTP::Response->new(
+            '200' ,
+            'OK' ,
+            [ 'Content-Type' => 'text/plain'] ,
+            'POST'
+        )
+    );
+
     $ua;
 }
 

-- 
Alioth's /usr/local/bin/git-commit-notice on /srv/git.debian.org/git/pkg-perl/packages/libcatmandu-perl.git