Commits

Toby Inkster  committed d5ea296

improve HTTP request body serialization

  • Participants
  • Parent commits 2efee77

Comments (0)

Files changed (1)

File lib/Web/Magic.pm

 use HTTP::Date 0                   qw//;
 use HTTP::Response 0               qw//;
 use HTTP::Request 0                qw//;
+use HTTP::Request::Common 5.0      qw//;
 use JSON::JOM 0.501                qw/to_jom from_json to_json/;
 use JSON::JOM::Plugins::Dumper 0   qw//;
 use JSON::JOM::Plugins::JsonPath 0 qw//;
 		return $class->_http_request_to_uri($method, $_[0]);
 	}
 
-	$_[0] = $class->_blessed_thing_to_uri($_[0]);
+	unshift @_, $class->_blessed_thing_to_uri(shift);
 	
 	my ($u, %args) = map {"$_"} @_; # stringify
 	$u =~ s{(^\s*)|(\*$)}{}g;       # trim whitespace
 				$success++;
 			}
 		}
-		elsif (blessed $body and $body->isa('XML::LibXML::Document'))
+		elsif (blessed $body and $body->isa('XML::LibXML::Node'))
 		{
 			$self->__deferred_load('XML::LibXML' => '1.70');
 			
 			
 			given ( $req_ct // 'xml' )
 			{
-				when (/xml/)     { $ser = $body->toString }
-				when (/html/)    { $ser = HTML::HTML5::Writer->new->document($body) }
+				when (/html/ and $body->isa('XML::LibXML::Document'))
+					{ $ser = HTML::HTML5::Writer->new->document($body) }
+				when (/html/ and $body->isa('XML::LibXML::Element'))
+					{ $ser = HTML::HTML5::Writer->new->element($body) }
+				when (/html/ and $body->isa('XML::LibXML::Comment'))
+					{ $ser = HTML::HTML5::Writer->new->comment($body) }
+				when (/html/ and $body->isa('XML::LibXML::Attr'))
+					{ $ser = HTML::HTML5::Writer->new->attribute($body) }
+				default
+					{ $ser = $body->toString }
 			}
 			
 			if ($ser)
 			$req->content(Dump $body);
 			$success++;
 		}
-		elsif (ref $body eq 'HASH' and ($req_ct//'urlencoded') =~ /urlencoded/i)
+		elsif (ref $body ~~ [qw/HASH ARRAY/] and ($req_ct//'urlencoded') =~ /urlencoded/i)
 		{
-			my $axwwfue = join '&',
-				map { sprintf('%s=%s', uri_escape($_), uri_escape($body->{$_})) }
-				keys %$body;
-			$req->content($axwwfue);
+			$req->content(_ref_to_axwwfue($body));
 			$req->content_type('application/x-www-form-urlencoded') unless $req_ct;
 			$success++;
 		}
+		elsif (ref $body ~~ [qw/HASH ARRAY/] and ($req_ct//'form-data') =~ /form-data/i)
+		{
+			my $R = HTTP::Request::Common::POST(
+				$$self, Content => $body, Content_Type => ($req_ct//'form-data'),
+				);
+			$req->content($R->content);
+			# don't use ->content_type because we need "boundary" parameter
+			$req->content_type($R->header('Content-Type'));
+			$success++;
+		}
 		else
 		{
 			my $ref = ref $body;
 	return $req;
 }
 
+sub _hash_to_array
+{
+	my %hash  = ref $_[0] ? %{+shift} : @_;
+	my @array = ();
+	foreach my $k (keys %hash)
+	{
+		push @array, $k, $hash{$k};
+	}
+	return \@array;
+}
+
+sub _array_to_axwwfue
+{
+	my @array = ref $_[0] ? @{+shift} : @_;
+	my @return;
+	while (@array)
+	{
+		push @return, sprintf(
+			'%s=%s',
+			uri_escape(shift @array),
+			uri_escape(shift @array),
+			);
+	}
+	return join '&', @return;
+}
+
+sub _ref_to_axwwfue
+{
+	my $ref = shift;
+	return _array_to_axwwfue(
+		(ref $ref eq 'ARRAY') ? $ref : _hash_to_array($ref)
+		);
+}
+
 sub is_requested
 {
 	my ($self) = @_;
 A Web::Magic::Exception::BadPhase::Cancel exception will be thrown if the
 body can't be serialised, but not until the request is actually performed.
 
+B<Attaching files to a form submission:> to attach files, you need to
+use a Content-Type of "multipart/form-data".
+
+  my $magic = W('http://example.ie/song-competition-entry-form')
+    ->POST
+    ->Content_Type('multipart/form-data')
+    ->set_request_body([
+          title   => 'My Lovely Horse',
+          singer  => 'Ted Krilly',
+          attach  => ['dir/horse.mp3',
+                      'horse.mp3',
+                      Content_Type => 'audio/mp3',
+                      X_Encoding_Rate => '192 kbps',
+                     ],
+      ]);
+
+Note that the key "attach" is not especially significant. It's equivalent
+to the name attribute of an HTML file submission control:
+
+  <input type="file" name="attach">
+
+What is significant is the use of an arrayref as attach's value. The first
+element in the array specifies a filename to load the data from (yes, a
+file handle might be nice, but it's not supported yet). The second element
+is the file name that you'd like to inform the server. Everything else is
+additional headers to submit with the file. "Content-Type" is just about
+the only additional header worth bothering with.
+
 =item C<< set_auth($username, $password) >>
 
 Set username and password for HTTP Basic authentication.