view release on metacpan or  search on metacpan

t/010states.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::TestRequest qw{GET_BODY GET OPTIONS};
use DBI;
use File::Basename 'dirname';

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

my $serverroot=Apache::Test::vars->{serverroot};
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	Do: $r->notes->{t}=$r->notes->{t}." init";
2	default	:PRE:	0	2	PerlHandler: 'My::Handler'
3	default	:PRE:	0	3	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');
}

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                                        ##
######################################################################

# test key change during :PRE:
$data=<<'EOD';
#id	xkey	xuri	xblock	xorder	xaction
10	k	:PRE:	0	0	Do: $r->notes->{t}=$r->notes->{t}." pre"
EOD
update_db;

ok t_cmp GET_BODY( '/' ), 'init pre', n 'init';

# test normal processing
$data=<<'EOD';
#id	xkey	xuri	xblock	xorder	xaction
10	k	/	0	0	Do: $r->notes->{t}=$r->notes->{t}." /"
11	k	/uri	0	0	Do: $r->notes->{t}=$r->notes->{t}." /uri"
EOD