view release on metacpan or  search on metacpan

t/011directives.t  view on Meta::CPAN

# -*- mode: cperl; cperl-indent-level: 2; cperl-continued-statement-offset: 2; indent-tabs-mode: nil -*-
use strict;
use warnings FATAL => 'all';

use Apache::Test ();            # just load it to get the version
use version;
use Apache::Test (version->parse(Apache::Test->VERSION)>=version->parse('1.35')
                  ? '-withtestmore' : ':withtestmore');
use Apache::TestUtil;
use Apache::TestUtil qw/t_write_shell_script t_write_perl_script/;
use Apache::TestRequest qw{GET_BODY GET GET_RC};
use DBI;
use File::Basename 'dirname';

plan tests=>36;
#plan 'no_plan';

{
  my $f;
  sub t_start_error_log_watch {
    my $name=File::Spec->catfile( Apache::Test::vars->{t_logs}, 'error_log' );
    open $f, "$name" or die "ERROR: Cannot open $name: $!\n";
    seek $f, 0, 2;
  }

  sub t_finish_error_log_watch {
    local $/="\n";
    my @lines=<$f>;
    undef $f;
    return @lines;
  }
}

my $serverroot=Apache::Test::vars->{serverroot};
my $documentroot=Apache::Test::vars->{documentroot};
my ($db,$user,$pw)=@ENV{qw/DB USER PW/};
$user='' unless defined $user;
$pw='' unless defined $pw;
my $dbinit='';
unless( defined $db and length $db ) {
  ($db,$user,$pw)=("dbi:SQLite:dbname=$serverroot/test.sqlite", '', '');
  $dbinit="PRAGMA synchronous = OFF";
}
t_debug "Using DB=$db USER=$user";
my $dbh;

my $data;

sub update_db {
  $dbh->do('DELETE FROM trans');

  my $stmt=$dbh->prepare( <<'SQL' );
INSERT INTO trans (id, xkey, xuri, xblock, xorder, xaction) VALUES (?,?,?,?,?,?)
SQL

  my $header=<<'EOD';
#id	xkey	xuri	xblock	xorder	xaction
1	default	:PRE:	0	1	Config: 'ErrorDocument 404 /error'
2	default	:PRE:	0	2	Key: 'k'
EOD

  foreach my $l (grep !/^\s*#/, split /\n+/, $header) {
    $stmt->execute(split /\t+/, $l);
  }

  if( defined $data and length $data ) {
    foreach my $l (grep !/^\s*#/, split /\n+/, $data) {
      $stmt->execute(split /\t+/, $l);
    }
  }

  $dbh->do('UPDATE cache SET v=v+1');
}

sub prepare_db {
  $dbh=DBI->connect( $db, $user, $pw,
		     {AutoCommit=>1, PrintError=>0, RaiseError=>1} )
    or die "ERROR: Cannot connect to $db: $DBI::errstr\n";

  $dbh->do($dbinit) if( length $dbinit );
  $dbh->do('DELETE FROM sequences');
  $dbh->do('DELETE FROM trans');

  update_db
}

prepare_db;
sub n {my @c=caller; $c[1].'('.$c[2].'): '.$_[0];}

Apache::TestRequest::user_agent(reset => 1, requests_redirectable => 0);

######################################################################
## the real tests begin here                                        ##
######################################################################

$data=<<'EOD';
#id	xkey	xuri	xblock	xorder	xaction
#                                       a subsequent mod_alias handler maps /ALIAS do DOC_ROOT/alias

10	k	/alias	0	0	Uri: '/ALIAS'.$MATCHED_PATH_INFO

11	k	/file	0	0	Do: $CTX{R}=$r->document_root
110	k	/file	0	1	File: $ctx->{R}.$MATCHED_PATH_INFO

12	k	/cgi	0	0	Cgiscript
13	k	/cgi	0	1	File: $r->document_root.$MATCHED_PATH_INFO

14	k	/perl	0	0	Perlscript
15	k	/perl	0	1	File: $r->document_root.$MATCHED_PATH_INFO