cvs commit: modperl-2.0/t/response/TestAPR finfo.pm

[geoff]

geoff       2003/11/17 15:31:02

  Added:       t/response/TestAPR finfo.pm
  Log:
  add $r->finfo tests
  
  Revision  Changes    Path
  1.1                  modperl-2.0/t/response/TestAPR/finfo.pm
  
  Index: finfo.pm
  ===================================================================
  package TestAPR::finfo;
  
  use strict;
  use warnings FATAL => 'all';
  
  use Apache::Test;
  use Apache::TestUtil;
  use Apache::TestTrace;
  
  use Apache::RequestRec ();
  use APR::Finfo ();
  use APR::Const -compile => qw(SUCCESS FINFO_NORM REG
                                WREAD WWRITE WEXECUTE);
  
  use File::Spec::Functions qw(catfile);
  use Fcntl qw(:mode);
  
  use Apache::Const -compile => 'OK';
  
  sub handler {
      my $r = shift;
  
      plan $r, tests => 17;
  
      {
          my $finfo = $r->finfo;
          my $isa = $finfo->isa('APR::Finfo');
  
          t_debug "\$r->finfo $finfo";
          ok $isa;
      }
  
      {
          my $pool = $r->finfo->pool;
          my $isa = $pool->isa('APR::Pool');
  
          t_debug "\$r->finfo->pool $pool";
          ok $isa;
      }
  
      my $file = Apache->server_root_relative(catfile qw(htdocs index.html));
  
      # stat tests
      {
          # populate the finfo struct first
          my $status = APR::Finfo::stat($r->finfo, $file, 
                                        APR::FINFO_NORM, $r->pool);
  
          ok t_cmp(APR::SUCCESS,
                   $status,
                   "stat $file");
  
          # now, get information from perl's stat()
          our ($device, $inode, $protection, $nlink, $user, $group,
               undef, $size, $atime, $mtime, $ctime) = stat $file;
  
          # compare stat fields between perl and apr_stat
          {
              no strict qw(refs);
              foreach my $method (qw(device inode nlink user group
                                     size atime mtime ctime)) {
  
                  ok t_cmp(${$method},
                           $r->finfo->$method(),
                           "\$r->finfo->$method()");
              }
          }
  
          # match world bits
  
          ok t_cmp($protection & S_IROTH,
                   $r->finfo->protection & APR::WREAD,
                   '$r->finfo->protection() & APR::WREAD');
  
          ok t_cmp($protection & S_IWOTH,
                   $r->finfo->protection & APR::WWRITE,
                   '$r->finfo->protection() & APR::WWRITE');
  
          ok t_cmp($protection & S_IXOTH,
                   $r->finfo->protection & APR::WEXECUTE,
                   '$r->finfo->protection() & APR::WEXECUTE');
      }
  
      # tests for stuff not in perl's stat
      {
          ok t_cmp($file,
                   $r->finfo->fname,
                   '$r->finfo->fname()');
  
          ok t_cmp(APR::REG,
                   $r->finfo->filetype,
                   '$r->finfo->filetype()');
      }        
  
      Apache::OK;
  }
  
  1;