cvs commit: httpd-apreq-2/glue/perl/t/response/TestApReq request.pm

[joes]

joes        2004/07/05 07:18:26

  Modified:    glue/perl/t/apreq request.t
               glue/perl/t/response/TestApReq request.pm
  Log:
  Add link() and TEMP_DIR tests
  
  Revision  Changes    Path
  1.15      +2 -2      httpd-apreq-2/glue/perl/t/apreq/request.t
  
  Index: request.t
  ===================================================================
  RCS file: /home/cvs/httpd-apreq-2/glue/perl/t/apreq/request.t,v
  retrieving revision 1.14
  retrieving revision 1.15
  diff -u -r1.14 -r1.15
  --- request.t 4 Jul 2004 17:44:34 -0000       1.14
  +++ request.t 5 Jul 2004 14:18:26 -0000       1.15
  @@ -6,7 +6,7 @@
   use Apache::TestUtil;
   use Apache::TestRequest qw(GET_BODY UPLOAD_BODY);
   
  -plan tests => 15, have_lwp;
  +plan tests => 17, have_lwp;
   
   my $location = "/TestApReq__request";
   #print GET_BODY $location;
  @@ -20,7 +20,7 @@
                "basic param");
   }
   
  -for my $test (qw/slurp bb tempname fh io bad;query=string%%/) {
  +for my $test (qw/slurp bb tempname link fh io bad;query=string%%/) {
       # upload a string as a file
       my $value = ('DataUpload' x 10 . "\r\n") x 1_000;
       my $result = UPLOAD_BODY("$location?test=$test", content => $value); 
  
  
  
  1.20      +19 -2     httpd-apreq-2/glue/perl/t/response/TestApReq/request.pm
  
  Index: request.pm
  ===================================================================
  RCS file: /home/cvs/httpd-apreq-2/glue/perl/t/response/TestApReq/request.pm,v
  retrieving revision 1.19
  retrieving revision 1.20
  diff -u -r1.19 -r1.20
  --- request.pm        4 Jul 2004 17:44:34 -0000       1.19
  +++ request.pm        5 Jul 2004 14:18:26 -0000       1.20
  @@ -10,10 +10,13 @@
   use Apache::Upload;
   use APR::Pool;
   use APR::PerlIO;
  +use Apache::ServerUtil;
  +use File::Spec;
   
   sub handler {
       my $r = shift;
  -    my $req = Apache::Request->new($r);
  +    my $temp_dir = $r->server->server_root_relative('logs');
  +    my $req = Apache::Request->new($r, TEMP_DIR => $temp_dir);
   
       $req->content_type('text/plain');
   
  @@ -46,9 +49,23 @@
       elsif ($test eq 'tempname') {
           my $upload = $req->upload("HTTPUPLOAD");
           my $name = $upload->tempname;
  +        my ($dir) = $name =~ /^(.+)apreq\w{6}$/;
  +        chop $dir;
  +        die "Tempfile in wrong temp_dir (expected $temp_dir, saw $dir)" 
unless
  +            $dir eq $temp_dir;
  +
           open my $fh, "<:APR", $name, $upload->pool or die "Can't open $name: 
$!";
           $r->print(<$fh>);
       }
  +    elsif ($test eq 'link') {
  +        my $upload = $req->upload("HTTPUPLOAD");
  +        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, "<:APR", $link_file, $upload->pool
  +            or die "Can't open $link_file: $!";
  +        $r->print(<$fh>);
  +    }
       elsif ($test eq 'fh') {
           my $upload = $req->upload(($req->upload)[0]);
           my $fh = $upload->fh;
  @@ -89,7 +106,7 @@
       }
       elsif ($test eq 'type') {
           my $upload = $req->upload("HTTPUPLOAD");
  -        die "content-type mismatch" 
  +        die "content-type mismatch"
               unless $upload->info->{"Content-Type"} eq $upload->type;
           $r->print($upload->type);
       }