view release on metacpan or  search on metacpan

t/001provider-DB.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 Test::Deep;
use DBI;
use File::Basename 'dirname';

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

my $data=<<'EOD';
#id	xkey	xuri		xblock	xorder	xaction
0	k1	u1		0	0	a
1	k1	u1		0	1	b
2	k1	u1		1	0	c
3	k1	u2		0	0	d
4	k1	u2		1	0	e
5	k1	u2		1	1	f
EOD

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 $cache_value;
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');
  my $stmt=$dbh->prepare('SELECT MAX(v) FROM cache');
  $stmt->execute;
  ($cache_value)=$stmt->fetchrow_array;
  $stmt->finish;

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

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

}

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

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

use Apache2::Translation::DB;

my $o=Apache2::Translation::DB->new
  (
   Database=>$db, User=>$user, Passwd=>$pw,
   Table=>'trans', Key=>'xkey', Uri=>'xuri', Block=>'xblock',
   Order=>'xorder', Action=>'xaction', Id=>'id',
   CacheSize=>1000, CacheTbl=>'cache', CacheCol=>'v',
   DBInit=>"$dbinit",
  );

ok $o, n 'provider object';

ok tied(%{$o->_cache}), n 'tied cache';

$o->start;
cmp_deeply $o->_cache_version, $cache_value, n 'cache version is 1';
$o->stop;

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

$o->start;
cmp_deeply $o->_cache_version, $cache_value+1, n 'cache version is 2';
cmp_deeply [$o->fetch('k1', 'u1')],
           [['0', '0', 'a', '0'], ['0', '1', 'b', '1'], ['1', '0', 'c', '2']],
           n 'fetch uri u1';