dougm 01/05/07 22:07:11
Modified: Apache-Test/lib/Apache TestRequest.pm
Log:
add file upload shortcut functions
Revision Changes Path
1.5 +50 -1 modperl-2.0/Apache-Test/lib/Apache/TestRequest.pm
Index: TestRequest.pm
===================================================================
RCS file: /home/cvs/modperl-2.0/Apache-Test/lib/Apache/TestRequest.pm,v
retrieving revision 1.4
retrieving revision 1.5
diff -u -r1.4 -r1.5
--- TestRequest.pm 2001/05/05 18:39:35 1.4
+++ TestRequest.pm 2001/05/08 05:07:11 1.5
@@ -47,7 +47,7 @@
return "http://$hostport$url";;
}
-my %wanted_args = map {$_, 1} qw(username password realm content);
+my %wanted_args = map {$_, 1} qw(username password realm content filename);
sub wanted_args {
\%wanted_args;
@@ -121,6 +121,53 @@
return ($url, $pass, $keep);
}
+sub UPLOAD {
+ my($url, $pass, $keep) = prepare(@_);
+
+ if ($keep->{filename}) {
+ return upload_file($url, $keep->{filename}, $pass);
+ }
+ else {
+ return upload_string($url, $keep->{content});
+ }
+}
+
+sub UPLOAD_BODY {
+ UPLOAD(@_)->content;
+}
+
+#lwp only supports files
+sub upload_string {
+ my($url, $data) = @_;
+
+ my $CRLF = "\015\012";
+ my $bound = 742617000027;
+ my $req = HTTP::Request->new(POST => $url);
+
+ my $content = join $CRLF,
+ "--$bound",
+ "Content-Disposition: form-data; name=\"HTTPUPLOAD\"; filename=\"b\"",
+ "Content-Type: text/plain", "",
+ $data, "--$bound--", "";
+
+ $req->header("Content-Length", length($content));
+ $req->content_type("multipart/form-data; boundary=$bound");
+ $req->content($content);
+
+ $UA->request($req);
+}
+
+sub upload_file {
+ my($url, $file, $args) = @_;
+
+ my $content = [@$args, filename => [$file]];
+
+ $UA->request(HTTP::Request::Common::POST($url,
+ Content_Type => 'form-data',
+ Content => $content,
+ ));
+}
+
my %shortcuts = (RC => sub { shift->code },
OK => sub { shift->is_success },
STR => sub { shift->as_string },
@@ -145,6 +192,8 @@
for my $method (@export_std) {
push @EXPORT, map { join '_', $method, $_ } keys %shortcuts;
}
+
+push @EXPORT, qw(UPLOAD_BODY);
#this is intended to be a fallback if LWP is not installed
#so at least some tests can be run, it is not meant to be robust
