Mailing-List: contact apreq-dev-help@httpd.apache.org; run by ezmlm
Precedence: bulk
Date: Sat, 10 Jul 2004 20:48:50 -0500 (CDT)
From: Randy Kobes <randy@theoryx5.uwinnipeg.ca>
To: apreq-dev@httpd.apache.org
Subject: [apreq-2] perl glue upload tests
Message-ID: <Pine.LNX.4.56.0407102041150.17590@theoryx5.uwinnipeg.ca>
MIME-Version: 1.0
Content-Type: TEXT/PLAIN; charset=US-ASCII

In order to try to keep tabs on the Win32 line-endings
issues, especially with uploads, I wrote some additional
upload tests for the perl glue. They do duplicate some of
the upload tests in request.pm; however, they use files,
including a binary file (image). Anyway, for what it's
worth, here they are: this assumes the apache_pb2.png under
$APACHE2/icons/ has been copied into glue/perl/t/apreq/.
======================================================
Index: glue/perl/t/apreq/upload.t
===================================================================
RCS file: glue/perl/t/apreq/upload.t
diff -N glue/perl/t/apreq/upload.t
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ glue/perl/t/apreq/upload.t	11 Jul 2004 01:18:32 -0000
@@ -0,0 +1,38 @@
+use strict;
+use warnings FATAL => 'all';
+
+use Apache::Test;
+use Apache::TestUtil;
+use Apache::TestRequest qw(UPLOAD_BODY);
+use Cwd;
+
+my @names = qw(upload.t apache_pb2.png);
+my $cwd = getcwd();
+my $location = "/TestApReq__upload";
+plan tests => 14, have_lwp;
+
+foreach my $file( map {File::Spec->catfile($cwd, 't', 'apreq', $_)} @names) {
+    my $contents = '';
+    my $size = -s $file;
+    open(my $fh, $file) or die "Cannot open $file: $!";
+    {
+        binmode $fh;
+        local $/;
+        $contents = <$fh>;
+    }
+    close $fh;
+    my $type = ($file =~ /\.t$/) ? 'application/x-troff' : 'image/png';
+
+    my %expected = (slurp    => $contents,
+                    fh_read  => $contents,
+                    tempname  => $contents,
+                    link  => $contents,
+                    filename => $file,
+                    size     => $size,
+                    type     => $type,
+                   );
+    for my $test ( sort keys %expected ) {
+        my $result = UPLOAD_BODY("$location?test=$test", filename => $file);
+        ok t_cmp($result, $expected{$test}, "$test test for $file");
+    }
+}
Index: glue/perl/t/response/TestApreq/upload.pm
===================================================================
RCS file: glue/perl/t/response/TestApreq/upload.pm
diff -N glue/perl/t/response/TestApreq/upload.pm
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ glue/perl/t/response/TestApreq/upload.pm	11 Jul 2004 01:18:32 -0000
@@ -0,0 +1,57 @@
+package TestApReq::upload;
+
+use strict;
+use warnings FATAL => 'all';
+
+use Apache::RequestRec;
+use Apache::RequestIO;
+use Apache::Request ();
+use Apache::Upload;
+use File::Spec;
+
+sub handler {
+    my $r = shift;
+    my $req = Apache::Request->new($r);
+    my $temp_dir = File::Spec->tmpdir;
+
+    my $test  = $req->args('test');
+    my $upload = $req->upload(($req->upload)[0]);
+    my $type = $upload->type;
+
+    if ($test eq 'slurp') {
+        $req->content_type($type);
+        $upload->slurp(my $data);
+        $req->print($data);
+    }
+    elsif ($test eq 'fh_read') {
+        $req->content_type($type);
+        my $fh = $upload->fh;
+        binmode $fh;
+        $r->print(<$fh>);
+    }
+    elsif ($test eq 'tempname') {
+        $req->content_type($type);
+        my $name = $upload->tempname;
+        open my $fh, "<:APR", $name, $upload->pool
+            or die "Can't open $name: $!";
+        binmode $fh;
+        $r->print(<$fh>);
+    }
+    elsif ($test eq 'link') {
+        $req->content_type($type);
+        my $link_file = File::Spec->catfile($temp_dir, "linktest");
+        unlink $link_file if -f $link_file;
+        $upload->link($link_file) or die "Can't link to $link_file: $!";
+        open my $fh, "<", $link_file or die "Can't open $link_file: $!";
+        binmode $fh;
+        $r->print(<$fh>);
+    }
+    else  {
+        $req->content_type('text/plain');
+        $r->print($upload->$test);
+    }
+
+    return 0;
+}
+1;
+__END__

=================================================================

-- 
best regards,
randy