PATCH: Using "plain" content for ->post method
am 14.12.2005 17:12:21 von srezic--=-mYCttjxVuVlL68GGb2dt
Content-Type: text/plain
Content-Transfer-Encoding: 7bit
The attached patch adds the feature to use plain content (that is, no
param-value pairs) for POST requests.
E.g.
my $ua = LWP::UserAgent->new;
my $soap_request_string = "
my $response = $ua->post($soap_url,
\$soap_request_string,
"Content-Type" => "text/xml;charset=UTF-8",
"SOAPAction" => "Something",
);
....
Regards,
Slaven
--
Slaven Rezic . Development CELLULAR GmbH
Schmiedehof 15 . 10965 Berlin . Germany
Schulterblatt 58 . 20357 Hamburg . Germany
Phone +49 30 789519-13 . Fax +49 30 890686-50
Email srezic@cellular.de
--=-mYCttjxVuVlL68GGb2dt
Content-Disposition: attachment; filename=libwww-post-addition.patch
Content-Transfer-Encoding: quoted-printable
Content-Type: text/plain; name=libwww-post-addition.patch; charset=ISO-8859-15
#=20
#=20
# To apply this patch:
# STEP 1: Chdir to the source directory.
# STEP 2: Run the 'applypatch' program with this patch file as input.
#
# If you do not have 'applypatch', it is part of the 'makepatch' package
# that you can fetch from the Comprehensive Perl Archive Network:
# http://www.perl.com/CPAN/authors/Johan_Vromans/makepatch-x.y .tar.gz
# In the above URL, 'x' should be 2 or higher.
#
# To apply this patch without the use of 'applypatch':
# STEP 1: Chdir to the source directory.
# STEP 2: Run the 'patch' program with this file as input.
#
#### End of Preamble ####
#### Patch data follows ####
diff -up 'libwww-perl-5.805/lib/HTTP/Request/Common.pm' '/home/slavenr/tmp/=
new.libwww-perl-5.805/lib/HTTP/Request/Common.pm'
Index: ./lib/HTTP/Request/Common.pm
Prereq: 1.26=20
--- ./lib/HTTP/Request/Common.pm Mon Nov 15 15:52:37 2004
+++ ./lib/HTTP/Request/Common.pm Wed Dec 14 16:43:39 2005
@@ -76,12 +76,17 @@ sub POST
$ct =3D HTTP::Headers::Util::join_header_words(@v);
}
else {
- # We use a temporary URI object to format
- # the application/x-www-form-urlencoded content.
- require URI;
- my $url =3D URI->new('http:');
- $url->query_form(ref($content) eq "HASH" ? %$content : @$content);
- $content =3D $url->query;
+ if (ref($content) eq 'SCALAR') {
+ $content =3D $$content;
+ }
+ else {
+ # We use a temporary URI object to format
+ # the application/x-www-form-urlencoded content.
+ require URI;
+ my $url =3D URI->new('http:');
+ $url->query_form(ref($content) eq "HASH" ? %$content : @$content);
+ $content =3D $url->query;
+ }
}
}
=20
@@ -352,7 +357,7 @@ Like GET() but the method in the request
=3Ditem POST $url, Header =3D> Value,..., Content =3D> $form_ref
=20
This works mostly like GET() with "POST" as the method, but this function
-also takes a second optional array or hash reference parameter
+also takes a second optional array, hash, or scalar reference parameter
($form_ref). This argument can be used to pass key/value pairs for
the form content. By default we will initialize a request using the
C
@@ -457,6 +462,9 @@ applications) like this. Also, if the f
the time the Content-Length is calculated and the time that the last
chunk is delivered, the subroutine will C
=20
+If $form_ref is a SCALAR reference, then the POST content is set to
+the dereferenced value of $form_ref.
+
The post(...) method of "LWP::UserAgent" exists as a shortcut for
$ua->request(POST ...).
=20
diff -up 'libwww-perl-5.805/t/local/http-get.t' '/home/slavenr/tmp/new.libw=
ww-perl-5.805/t/local/http-get.t'
Index: ./t/local/http-get.t
--- ./t/local/http-get.t Mon Nov 15 12:37:15 2004
+++ ./t/local/http-get.t Wed Dec 14 16:44:22 2005
@@ -50,7 +50,7 @@ else {
open(DAEMON, "$perl local/http-get.t daemon |") or die "Can't exec dae=
mon: $!";
}
=20
-print "1..20\n";
+print "1..21\n";
=20
=20
my $greeting =3D
@@ -384,6 +384,28 @@ print "ok 19\n"; =09
=20
}
=20
+{
+
+my $content;
+
+$res =3D $ua->post(
+ url("/echo/foo", $base),
+ \"Plain Text",
+ 'Content-Type' =3D> 'text/plain',
+ ':content_cb' =3D> sub { $content .=3D $_[0]; return; },
+);
+
+$_ =3D $content;
+print "not " unless $res->is_success
+ and /^Content-Length:\s*10$/mi
+ and /^Content-Type:\s*text\/plain$/mi
+ and /^Plain Text$/m
+ and ! $res->content
+;
+print "ok 20\n"; =09
+
+}
+
#----------------------------------------------------------- -----
print "#------------Testing: Terminating server...\n";
sub httpd_get_quit
@@ -396,5 +418,5 @@ sub httpd_get_quit
$res =3D $ua->get( url("/quit", $base) );
=20
print "not " unless $res->code == 503 and $res->content =3D~ /Bye, bye=
/;
-print "ok 20\n";
+print "ok 21\n";
=20
#### End of Patch data ####
#### ApplyPatch data follows ####
# Data version : 1.0
# Date generated : Wed Dec 14 16:51:08 2005
# Generated by : makepatch 2.00_11*
# Recurse directories : Yes
# Excluded files : (\A|/).*\~\Z
# (\A|/).*\.a\Z
# (\A|/).*\.bak\Z
# (\A|/).*\.BAK\Z
# (\A|/).*\.elc\Z
# (\A|/).*\.exe\Z
# (\A|/).*\.gz\Z
# (\A|/).*\.ln\Z
# (\A|/).*\.o\Z
# (\A|/).*\.obj\Z
# (\A|/).*\.olb\Z
# (\A|/).*\.old\Z
# (\A|/).*\.orig\Z
# (\A|/).*\.rej\Z
# (\A|/).*\.so\Z
# (\A|/).*\.Z\Z
# (\A|/)\.del\-.*\Z
# (\A|/)\.make\.state\Z
# (\A|/)\.nse_depinfo\Z
# (\A|/)core\Z
# (\A|/)tags\Z
# (\A|/)TAGS\Z
# p 'lib/HTTP/Request/Common.pm' 12980 1134575019 0100644
# p 't/local/http-get.t' 9510 1134575062 0100755
#### End of ApplyPatch data ####
#### End of Patch kit [created: Wed Dec 14 16:51:08 2005] ####
#### Patch checksum: 132 4458 54821 ####
#### Checksum: 150 5083 40864 ####
--=-mYCttjxVuVlL68GGb2dt--