I had committed to taking over Apache::Session and the original
maintainer, Jeffrey Baker, was interested in a patch to prove that I was
worthy, or competent, or something.
I chose to address the biggest issue in terms of taking over
development. Tests. I rewrote the entire test suite using modern,
Test::Builder inspired tools. That is step one, and the step I've
completed. Every test file, including the RDBM related tests were tested
by hand.
Now that we have a modern test suite step two is incredible coverage.
That's where I'm going to go next. When running the test suite without
any RDBM tests (for simplicity), the following coverage is achieved.
---------------------------- ------ ------ ------ ------ ------ ------ ------
File stmt branch cond sub pod time total
---------------------------- ------ ------ ------ ------ ------ ------ ------
blib/lib/Apache/Session.pm 67.7 64.3 76.5 35.1 0.0 9.4 53.7
...Apache/Session/DB_File.pm 100.0 n/a n/a 100.0 0.0 8.0 97.4
...ib/Apache/Session/File.pm 100.0 n/a n/a 100.0 0.0 9.0 97.7
...ib/Apache/Session/Flex.pm 100.0 54.2 n/a 100.0 0.0 3.1 81.2
...e/Session/Generate/MD5.pm 100.0 100.0 n/a 100.0 0.0 10.1 92.9
...n/Generate/ModUniqueId.pm 69.2 25.0 n/a 75.0 0.0 0.3 56.5
...ache/Session/Lock/File.pm 77.9 42.5 50.0 83.3 0.0 17.5 63.4
...ache/Session/Lock/Null.pm 84.6 n/a n/a 75.0 0.0 0.3 63.0
...Session/Lock/Semaphore.pm 94.5 76.9 50.0 92.3 0.0 17.1 81.7
...ssion/Serialize/Base64.pm 100.0 n/a n/a 100.0 0.0 2.6 91.7
...ion/Serialize/Storable.pm 100.0 n/a n/a 100.0 0.0 1.4 90.0
...ion/Serialize/UUEncode.pm 100.0 n/a n/a 100.0 0.0 0.4 90.0
.../Session/Store/DB_File.pm 84.3 60.0 n/a 100.0 0.0 7.7 75.0
...che/Session/Store/File.pm 92.2 57.1 66.7 100.0 0.0 13.1 77.7
Total 85.8 58.0 63.8 77.8 0.0 100.0 72.3
---------------------------- ------ ------ ------ ------ ------ ------ ------
That's not bad at all, for a start. Now it's time to increase the
testing coverage. To do that I intend to write Test-Apache-Session. This
distribution will provide common utilities for testing portion of the
Apache-Session distribution. There are so many common parts that this
will greatly reduce the work.
If it's alright with everyone[*], I'd like to release a new version of
Apache-Session for development. The only change is an upgraded test
suite. Since there will be more releases I'd also like to alter the
version number system. Instead of using single digits, my first release
would be 1.61_00. Once coverage is at least in the 90's 1.62 could be
released.
After I'm happy with coverage, new features and bug fixes can be
integrated.
Attached is a patch against Apache-Session-1.6 for my test suite
updates. Feel free to poke around. It's possible I messed something up.
[*] Jeffrey had eluded to a 1.7 release. He may still want to do that.
Casey West
--
Live TV died in the late 1950s, electronic bulletin boards came along
in the mid-1980s, meaning there was about a 25-year gap when it was
difficult to put your foot in your mouth and have people all across
the country know about it.
-- Mark Leeper
diff -ru /tmp/Apache-Session-1.6/Makefile.PL Apache-Session/Makefile.PL
--- /tmp/Apache-Session-1.6/Makefile.PL Thu Oct 11 14:06:31 2001
+++ Apache-Session/Makefile.PL Fri Mar 19 09:51:53 2004
@@ -1,9 +1,11 @@
use ExtUtils::MakeMaker;
-
WriteMakefile(
-
- NAME => "Apache::Session",
- VERSION_FROM => "Session.pm",
- 'dist' => { COMPRESS=>"gzip", SUFFIX=>"gz" }
+ NAME => "Apache::Session",
+ VERSION_FROM => "Session.pm",
+ PREREQ_PM => {
+ 'Test::More' => 0,
+ 'Test::Deep' => 0,
+ 'Test::Exception' => 0,
+ },
);
diff -ru /tmp/Apache-Session-1.6/t/99base64.t Apache-Session/t/99base64.t
--- /tmp/Apache-Session-1.6/t/99base64.t Fri May 26 02:11:50 2000
+++ Apache-Session/t/99base64.t Thu Mar 18 18:17:32 2004
@@ -1,35 +1,38 @@
-eval {require MIME::Base64; require Storable;};
-if ($@) {
- print "1..0\n";
- exit;
-}
+use Test::More;
+use Test::Deep;
-use Apache::Session::Serialize::Base64;
-
-print "1..1\n";
-
-my $s = \&Apache::Session::Serialize::Base64::serialize;
-my $u = \&Apache::Session::Serialize::Base64::unserialize;
-
-my $session = {serialized => undef, data => undef};
-my $simple = {foo => 1, bar => 2, baz => 'quux', quux => ['foo', 'bar']};
+plan skip_all => "Optional modules (MIME::Base64,Storable) not installed"
+ unless eval {
+ require MIME::Base64;
+ require Storable;
+ };
+
+plan tests => 3;
+
+my $package = 'Apache::Session::Serialize::Base64';
+use_ok $package;
+can_ok $package, qw[serialize unserialize];
+
+my $serialize = \&{"$package\::serialize"};
+my $unserialize = \&{"$package\::unserialize"};
+
+my $session = {
+ serialized => undef,
+ data => undef,
+ };
+my $simple = {
+ foo => 1,
+ bar => 2,
+ baz => 'quux',
+ quux => ['foo', 'bar'],
+ };
$session->{data} = $simple;
-&$s($session);
+$serialize->($session);
$session->{data} = undef;
-&$u($session);
+$unserialize->($session);
-if ($session->{data}->{foo} == 1 &&
- $session->{data}->{bar} == 2 &&
- $session->{data}->{baz} eq 'quux' &&
- $session->{data}->{quux}->[0] eq 'foo' &&
- $session->{data}->{quux}->[1] eq 'bar') {
-
- print "ok 1\n";
-}
-else {
- print "not ok 1\n";
-}
+cmp_deeply $session->{data}, $simple, "Session was deserialized correctly";
diff -ru /tmp/Apache-Session-1.6/t/99dbfile.t Apache-Session/t/99dbfile.t
--- /tmp/Apache-Session-1.6/t/99dbfile.t Fri May 26 12:13:25 2000
+++ Apache-Session/t/99dbfile.t Thu Mar 18 18:38:23 2004
@@ -1,78 +1,56 @@
-eval {require DB_File;};
-if ($@) {
- print "1..0\n";
- exit;
-}
-
-use Apache::Session::DB_File;
-
-my $mydir = int(rand(1000));
-mkdir "./$mydir", 0777;
-chdir $mydir;
-
-print "1..5\n";
-
-my $s = {};
-
-tie %$s, 'Apache::Session::DB_File', undef, {
- FileName => './test.db',
- LockDirectory => '.'
-};
-
-if (tied %$s) {
- print "ok 1\n";
-}
-else {
- print "not ok 1\n";
-}
-
-if (exists $s->{_session_id}) {
- print "ok 2\n";
-}
-else {
- print "not ok 2\n";
-}
-
-my $id = $s->{_session_id};
-
-$s->{foo} = 'bar';
-$s->{baz} = ['tom', 'dick', 'harry'];
-
-untie %$s;
-undef $s;
-$s = {};
-
-tie %$s, 'Apache::Session::DB_File', $id, {
- FileName => './test.db',
- LockDirectory => '.'
-};
-
-if (tied %$s) {
- print "ok 3\n";
-}
-else {
- print "not ok 3\n";
-}
-
-if ($s->{_session_id} eq $id) {
- print "ok 4\n";
-}
-else {
- print "not ok 4\n";
-}
-
-if ($s->{foo} eq 'bar' && $s->{baz}->[0] eq 'tom' && $s->{baz}->[2] eq 'harry'){
- print "ok 5\n";
-}
-else {
- print "not ok 5\n";
-}
-
-tied(%$s)->delete;
-
-
-unlink "./Apache-Session-$id.lock" || die $!;
-unlink "./test.db" || die $!;
-chdir "..";
-rmdir $mydir || die $!;
+use Test::More;
+use Test::Deep;
+use File::Temp qw[tempdir];
+use Cwd qw[getcwd];
+plan skip_all => "Optional module (DB_File) not installed"
+ unless eval {
+ require DB_File;
+ };
+
+my $package = 'Apache::Session::DB_File';
+
+plan tests => 8;
+
+use_ok $package;
+
+my $origdir = getcwd;
+my $tempdir = tempdir( DIR => '.', CLEANUP => 1 );
+chdir( $tempdir );
+
+my %session;
+my %tie_params = (
+ FileName => './text.db',
+ LockDirectory => '.',
+);
+
+tie %session, $package, undef, { %tie_params };
+
+ok( tied(%session), "The session is tied" );
+
+ok( exists($session{_session_id}), "Session id exists" );
+ok( defined($session{_session_id}), "Session id is defined" );
+
+my $id = $session{_session_id};
+
+my $foo = 'bar';
+my $baz = [ qw[tom dick harry] ];
+
+$session{foo} = $foo;
+$session{baz} = $baz;
+
+untie %session;
+undef %session;
+
+tie %session, $package, $id, { %tie_params };
+
+ok( tied(%session), "The session is tied again" );
+
+is( $session{_session_id}, $id, "Session IDs match" );
+
+cmp_deeply $session{foo}, $foo, "Foo matches";
+cmp_deeply $session{baz}, $baz, "Baz matches";
+
+tied(%session)->delete;
+
+chdir( $origdir );
\ No newline at end of file
diff -ru /tmp/Apache-Session-1.6/t/99dbfilestore.t Apache-Session/t/99dbfilestore.t
--- /tmp/Apache-Session-1.6/t/99dbfilestore.t Fri May 26 12:11:20 2000
+++ Apache-Session/t/99dbfilestore.t Fri Mar 19 09:56:08 2004
@@ -1,73 +1,78 @@
-eval {require DB_File};
-if ($@) {
- print "1..0\n";
- exit;
-}
-
-use Apache::Session::Store::DB_File;
-use DB_File;
-
-my $mydir = int(rand(1000));
-mkdir "./$mydir", 0777;
-chdir $mydir;
+use Test::More;
+use Test::Deep;
+use Test::Exception;
+use File::Temp qw[tempdir];
+use Cwd qw[getcwd];
+
+plan skip_all => "Optional module (DB_File) not installed"
+ unless eval {
+ require DB_File;
+ };
+
+my $package = 'Apache::Session::Store::DB_File';
+
+my $origdir = getcwd;
+my $tempdir = tempdir( DIR => '.', CLEANUP => 1 );
+chdir( $tempdir );
+
+my $serial = '12345';
+my $id = 'test1';
+my $dbfile = 'foo.dbm';
+my $session = {
+ serialized => $serial,
+ data => {
+ _session_id => $id,
+ },
+ args => {
+ FileName => $dbfile,
+ },
+};
-print "1..4\n";
+plan tests => 13;
-my $session = {serialized => '12345', data => {_session_id => 'test1'}, args =>
{FileName => 'foo.dbm'}};
+use_ok $package;
+use_ok 'DB_File';
+can_ok $package, qw[new insert materialize remove];
-my $store = new Apache::Session::Store::DB_File;
+my $store = $package->new;
+isa_ok $store, $package;
-$store->insert($session);
+my $i_ret = $store->insert($session);
+is( $i_ret, $serial, "insert() returned value of serialized" );
-if (-e "./foo.dbm") {
- print "ok 1\n";
-}
-else {
- print "not ok 1\n";
-}
+ok( -e $dbfile, 'dbm file exists' );
undef $store;
-$store = new Apache::Session::Store::DB_File;
-$session->{serialized} = '';
-$store->materialize($session);
-
-if ($session->{serialized} eq '12345') {
- print "ok 2\n";
-}
-else {
- print "not ok 2\n";
-}
+$store = $package->new;
+isa_ok $store, $package;
+
+$session->{serialized} = undef;
+lives_ok {
+ $store->materialize($session)
+} 'materialize did not die';
+is( $session->{serialized}, $serial, "materialized session is correct" );
+
+my $new_serial = 'hi';
+$session->{serialized} = $new_serial;
+my $u_ret = $store->update($session);
+is( $u_ret, $new_serial, "update() returned value of new serialized" );
-$session->{serialized} = 'hi';
-$store->update($session);
undef $store;
my %hash;
-tie %hash, 'DB_File', './foo.dbm';
-if ($hash{test1} eq 'hi') {
- print "ok 3\n";
-}
-else {
- print "not ok 3\n";
-}
+tie %hash, 'DB_File', $dbfile;
-$store = new Apache::Session::Store::DB_File;
+is( $hash{$id}, $new_serial, "dbm file updated correctly" );
+
+$store = $package->new;
+isa_ok $store, $package;
$store->remove($session);
-eval {
+dies_ok {
$store->materialize($session);
-};
-if ($@) {
- print "ok 4\n";
-}
-else {
- print "not ok 4\n";
-}
+} "Can't materialize removed session";
undef $store;
-unlink "./foo.dbm";
-
-chdir "..";
-rmdir $mydir || die $!;
+chdir( $origdir );
diff -ru /tmp/Apache-Session-1.6/t/99file.t Apache-Session/t/99file.t
--- /tmp/Apache-Session-1.6/t/99file.t Fri Sep 1 18:12:09 2000
+++ Apache-Session/t/99file.t Fri Mar 19 09:56:46 2004
@@ -1,91 +1,62 @@
-eval {require Fcntl;};
-if ($@) {
- print "1..0\n";
- exit;
-}
+use Test::More;
+use Test::Deep;
+use Test::Exception;
+use File::Temp qw[tempdir];
+use Cwd qw[getcwd];
+
+plan skip_all => "Optional module (Fcntl) not installed"
+ unless eval {
+ require Fcntl;
+ };
+
+my $origdir = getcwd;
+my $tempdir = tempdir( DIR => '.', CLEANUP => 1 );
+chdir( $tempdir );
-use Apache::Session::File;
+plan tests => 9;
-my $mydir = int(rand(1000));
-mkdir "./$mydir", 0777;
-chdir $mydir;
+my $package = 'Apache::Session::File';
+use_ok $package;
-print "1..6\n";
-
-my $s = {};
-
-tie %$s, 'Apache::Session::File', undef, {
+my %session;
+my %tie_params = (
Directory => '.',
LockDirectory => '.'
-};
+);
-if (tied %$s) {
- print "ok 1\n";
-}
-else {
- print "not ok 1\n";
-}
-
-if (exists $s->{_session_id}) {
- print "ok 2\n";
-}
-else {
- print "not ok 2\n";
-}
-
-my $id = $s->{_session_id};
-
-$s->{foo} = 'bar';
-$s->{baz} = ['tom', 'dick', 'harry'];
-
-untie %$s;
-undef $s;
-$s = {};
+tie %session, $package, undef, { %tie_params };
-tie %$s, 'Apache::Session::File', $id, {
- Directory => '.',
- LockDirectory => '.'
-};
+ok( tied(%session), "session is tied" );
+
+ok( exists($session{_session_id}), "session id exists" );
+ok( defined($session{_session_id}), "session id is defined" );
+
+my $id = $session{_session_id};
+
+my $foo = 'bar';
+my $baz = [ qw[tom dick harry] ];
+
+$session{foo} = $foo;
+$session{baz} = $baz;
+
+untie %session;
+undef %session;
+
+tie %session, $package, $id, { %tie_params };
+
+ok( tied(%session), "The session is tied again" );
+
+is( $session{_session_id}, $id, "Session IDs match" );
+
+cmp_deeply $session{foo}, $foo, "Foo matches";
+cmp_deeply $session{baz}, $baz, "Baz matches";
+
+tied(%session)->delete;
+untie %session;
+undef %session;
-if (tied %$s) {
- print "ok 3\n";
-}
-else {
- print "not ok 3\n";
-}
-
-if ($s->{_session_id} eq $id) {
- print "ok 4\n";
-}
-else {
- print "not ok 4\n";
-}
-
-if ($s->{foo} eq 'bar' && $s->{baz}->[0] eq 'tom' && $s->{baz}->[2] eq 'harry'){
- print "ok 5\n";
-}
-else {
- print "not ok 5\n";
-}
-
-tied(%$s)->delete;
-untie %$s;
-
-eval {
- tie %$s, 'Apache::Session::File', '../../../../../../../../foo', {
- Directory => '.',
- LockDirectory => '.'
- };
-};
-if ($@) {
- print "ok 6\n";
-}
-else {
- print "not ok 6\n";
- untie %$s
-}
-
-unlink "./Apache-Session-$id.lock" || die $!;
-chdir "..";
-rmdir $mydir || die $!;
+dies_ok {
+ tie %session, $package, '../../../../../../../../foo', { %tie_params };
+} "unsafe tie detected correctly";
+chdir( $origdir );
diff -ru /tmp/Apache-Session-1.6/t/99filelock.t Apache-Session/t/99filelock.t
--- /tmp/Apache-Session-1.6/t/99filelock.t Fri May 26 12:07:35 2000
+++ Apache-Session/t/99filelock.t Wed Aug 18 19:04:30 2004
@@ -1,55 +1,54 @@
+use Test::More;
+use Test::Deep;
+use Test::Exception;
+use File::Temp qw[tempdir];
+use Cwd qw[getcwd];
+
eval {require Fcntl;};
if ($@) {
print "1..0\n";
exit;
}
-use Apache::Session::Lock::File;
+plan skip_all => "Optional module (Fcntl) not installed"
+ unless eval {
+ require Fcntl;
+ };
-print "1..3\n";
+my $origdir = getcwd;
+my $tempdir = tempdir( DIR => '.', CLEANUP => 1 );
+chdir( $tempdir );
-my $dir = int(rand(1000));
-mkdir $dir, 0700;
-chdir $dir;
+plan tests => 4;
-my $l = new Apache::Session::Lock::File;
-my $s = {data => {_session_id => 'foo'}, args => {LockDirectory => '.'}};
+my $package = 'Apache::Session::Lock::File';
+use_ok $package;
-$l->acquire_read_lock($s);
+my $lock = $package->new;
+my $session = {
+ data => { _session_id => 'foo' },
+ args => { LockDirectory => '.' },
+};
-if (-e './Apache-Session-foo.lock') {
- print "ok 1\n";
-}
-else {
- print "not ok 1\n";
-}
+$lock->acquire_read_lock($session);
+
+ok -e './Apache-Session-foo.lock', 'lock file exists';
-undef $l;
+undef $lock;
unlink('./Apache-Session-foo.lock');
-$l = new Apache::Session::Lock::File;
+$lock = $package->new;
-$l->acquire_write_lock($s);
+$lock->acquire_write_lock($session);
-if (-e './Apache-Session-foo.lock') {
- print "ok 2\n";
-}
-else {
- print "not ok 2\n";
-}
+ok -e './Apache-Session-foo.lock', 'lock file exists';
-$l->release_all_locks($s);
+$lock->release_all_locks($session);
-$l->clean('.', 0);
+$lock->clean('.', 0);
-if (!-e './Apache-Session-foo.lock') {
- print "ok 3\n";
-}
-else {
- print "not ok 3\n";
-}
+ok !-e './Apache-Session-foo.lock', 'lock file does not exist';
-chdir '..';
-rmdir $dir;
+chdir( $origdir );
diff -ru /tmp/Apache-Session-1.6/t/99filestore.t Apache-Session/t/99filestore.t
--- /tmp/Apache-Session-1.6/t/99filestore.t Fri Sep 1 18:08:55 2000
+++ Apache-Session/t/99filestore.t Wed Aug 18 18:36:41 2004
@@ -1,98 +1,76 @@
-eval {require Fcntl;};
-if ($@) {
- print "1..0\n";
- exit;
-}
-
-use Apache::Session::Store::File;
-
-my $mydir = int(rand(1000));
-mkdir "./$mydir", 0777;
-chdir $mydir;
-
-print "1..6\n";
-
-my $session = {serialized => '12345', data => {_session_id => 'test1'}};
+use Test::More;
+use Test::Deep;
+use Test::Exception;
+use File::Temp qw[tempdir];
+use Cwd qw[getcwd];
+
+plan skip_all => "Optional module (Fcntl) not installed"
+ unless eval {
+ require Fcntl;
+ };
+
+my $origdir = getcwd;
+my $tempdir = tempdir( DIR => '.', CLEANUP => 1 );
+chdir( $tempdir );
+
+plan tests => 7;
+
+my $package = 'Apache::Session::Store::File';
+use_ok $package;
+
+my $session = {
+ serialized => 12345,
+ data => { _session_id => 'test1'},
+};
$Apache::Session::Store::File::Directory = '.';
+$Apache::Session::Store::File::Directory = '.';
-my $store = new Apache::Session::Store::File;
+my $store = Apache::Session::Store::File->new;
$store->insert($session);
-if (-e "./test1") {
- print "ok 1\n";
-}
-else {
- print "not ok 1\n";
-}
+ok( -e "./test1", "Store file exists" );
undef $store;
-open (TEST, '<./test1') || die $!;
+open (TEST, '<./test1');
-my $foo;
-while (<TEST>) {$foo .= $_};
+my $store_contents = do { local $/; <TEST> };
-if ($foo eq $session->{serialized} && $foo eq '12345') {
- print "ok 2\n";
-}
-else {
- print "not ok 2\n";
-}
+ok( $store_contents eq $session->{serialized} && $store_contents == 12345,
+ "Store contents are okay" );
close TEST;
-$store = new Apache::Session::Store::File;
+$store = Apache::Session::Store::File->new;
$session->{serialized} = '';
$store->materialize($session);
-if ($session->{serialized} eq '12345') {
- print "ok 3\n";
-}
-else {
- print "not ok 3\n";
-}
+ok( $session->{serialized} == 12345, 'restoring from file worked' );
$session->{serialized} = 'hi';
$store->update($session);
undef $store;
-open (TEST, '<./test1') || die $!;
+open (TEST, '<./test1');
-$foo = '';
-while (<TEST>) {$foo .= $_};
+undef $store_contents;
+$store_contents = do { local $/; <TEST> };
-if ($foo eq $session->{serialized} && $foo eq 'hi') {
- print "ok 4\n";
-}
-else {
- print "not ok 4\n";
-}
+ok( $store_contents eq $session->{serialized} && $store_contents eq 'hi',
+ 'Store contents are okay' );
close TEST;
-$store = new Apache::Session::Store::File;
+undef $store;
+$store = Apache::Session::Store::File->new;
$store->remove($session);
-if (-e "./test1") {
- print "not ok 5\n";
-}
-else {
- print "ok 5\n";
-}
+ok( !-e "./test1", 'Session removed properly' );
-eval {
+dies_ok {
$store->materialize($session);
-};
-if ($@) {
- print "ok 6\n";
-}
-else {
- print "not ok 6\n";
-}
-
-unlink "./test1";
+} "could not materialize nonexistent session";
-chdir "..";
-rmdir $mydir || die $!;
+chdir( $origdir );
diff -ru /tmp/Apache-Session-1.6/t/99flex.t Apache-Session/t/99flex.t
--- /tmp/Apache-Session-1.6/t/99flex.t Fri May 26 02:11:51 2000
+++ Apache-Session/t/99flex.t Wed Aug 18 16:12:34 2004
@@ -1,40 +1,52 @@
-eval {require Fcntl; require DB_File; require IPC::Semaphore; require IPC::SysV;};
-if ($@) {
- print "1..0\n";
- exit;
+use Test::More;
+use Test::Deep;
+use Test::Exception;
+use File::Temp qw[tempdir];
+use Cwd qw[getcwd];
+
+plan skip_all => "Optional modules (Fcntl, DB_File, IPC::Semaphore, IPC::SysV) not
installed: $@"
+ unless eval {
+ require Fcntl;
+ require DB_File;
+ require IPC::Semaphore;
+ require IPC::SysV;
+ };
+
+my $origdir = getcwd;
+my $tempdir = tempdir( DIR => '.', CLEANUP => 1 );
+chdir( $tempdir );
+
+plan tests => 11;
+
+my $package = 'Apache::Session::Flex';
+use_ok $package;
+
+{
+ my $session = tie my %session, $package, undef, {
+ Store => 'File',
+ Lock => 'File',
+ Generate => 'MD5',
+ Serialize => 'Storable',
+ };
+ isa_ok $session->{object_store}, 'Apache::Session::Store::File';
+ isa_ok $session->{lock_manager}, 'Apache::Session::Lock::File';
+ is ref($session->{generate}), 'CODE', 'generate is CODE';
+ is ref($session->{serialize}), 'CODE', 'serialize is CODE';
+ is ref($session->{unserialize}), 'CODE', 'unserialize is CODE';
}
-use Apache::Session::Flex;
-
-print "1..2\n";
-
-my (%s, $s);
-
-$s = tie %s, 'Apache::Session::Flex', undef, {Store => 'File', Lock => 'File',
Generate => 'MD5', Serialize => 'Storable'};
-
-if (ref($s->{object_store}) =~ /Apache::Session::Store::File/ &&
- ref($s->{lock_manager}) =~ /Apache::Session::Lock::File/ &&
- ref($s->{generate}) eq 'CODE' &&
- ref($s->{serialize}) eq 'CODE' &&
- ref($s->{unserialize}) eq 'CODE') {
- print "ok 1\n";
-}
-else {
- print "not ok 1\n";
+{
+ my $session = tie my %session, $package, undef, {
+ Store => 'DB_File',
+ Lock => 'Semaphore',
+ Generate => 'MD5',
+ Serialize => 'Base64',
+ };
+ isa_ok $session->{object_store}, 'Apache::Session::Store::DB_File';
+ isa_ok $session->{lock_manager}, 'Apache::Session::Lock::Semaphore';
+ is ref($session->{generate}), 'CODE', 'generate is CODE';
+ is ref($session->{serialize}), 'CODE', 'serialize is CODE';
+ is ref($session->{unserialize}), 'CODE', 'unserialize is CODE';
}
-undef $s;
-untie %s;
-
-$s = tie %s, 'Apache::Session::Flex', undef, {Store => 'DB_File', Lock =>
'Semaphore', Generate => 'MD5', Serialize => 'Base64'};
-
-if (ref($s->{object_store}) =~ /Apache::Session::Store::DB_File/ &&
- ref($s->{lock_manager}) =~ /Apache::Session::Lock::Semaphore/ &&
- ref($s->{generate}) eq 'CODE' &&
- ref($s->{serialize}) eq 'CODE' &&
- ref($s->{unserialize}) eq 'CODE') {
- print "ok 2\n";
-}
-else {
- print "not ok 2\n";
-}
+chdir( $origdir );
diff -ru /tmp/Apache-Session-1.6/t/99md5gen.t Apache-Session/t/99md5gen.t
--- /tmp/Apache-Session-1.6/t/99md5gen.t Thu Oct 11 13:37:05 2001
+++ Apache-Session/t/99md5gen.t Wed Aug 18 16:39:28 2004
@@ -1,61 +1,46 @@
-eval {require Digest::MD5;};
-if ($@) {
- print "1..0\n";
- exit;
-}
+use Test::More;
+use Test::Deep;
+use Test::Exception;
+use File::Temp qw[tempdir];
+use Cwd qw[getcwd];
+
+plan skip_all => "Optional module (Digest::MD5) not installed"
+ unless eval {
+ require Digest::MD5;
+ };
+
+my $origdir = getcwd;
+my $tempdir = tempdir( DIR => '.', CLEANUP => 1 );
+chdir( $tempdir );
-use Apache::Session::Generate::MD5;
+plan tests => 33;
-print "1..36\n";
+my $package = 'Apache::Session::Generate::MD5';
+use_ok $package;
my $session = {};
Apache::Session::Generate::MD5::generate($session);
-if (exists $session->{data}->{_session_id}) {
- print "ok 1\n";
-}
-else {
- print "not ok 1\n";
-}
+ok exists($session->{data}->{_session_id}), 'session id created';
-if ((scalar keys %{$session->{data}}) == 1) {
- print "ok 2\n";
-}
-else {
- print "not ok 2\n";
-}
+ok keys(%{$session->{data}}) == 1, 'just one key in the data hashref';
-if ($session->{data}->{_session_id} =~ /^[0-9a-fA-F]{32}$/) {
- print "ok 3\n";
-}
-else {
- print "not ok 3\n";
-}
+like $session->{data}->{_session_id}, qr/^[0-9a-fA-F]{32}$/, 'id looks like hex';
-my $old = $session->{data}->{_session_id};
+my $old_id = $session->{data}->{_session_id};
Apache::Session::Generate::MD5::generate($session);
-if ($old ne $session->{data}->{_session_id}) {
- print "ok 4\n";
-}
-else {
- print "not ok 4\n";
-}
+isnt $old_id, $session->{data}->{_session_id}, 'old session id does not match new
one';
-my $n = 5;
-for (my $i = 1; $i <= 32; $i++) {
- $session->{args}->{IDLength} = $i;
+for my $length (5 .. 32) {
+ $session->{args}->{IDLength} = $length;
Apache::Session::Generate::MD5::generate($session);
- if ($session->{data}->{_session_id} =~ /^[0-9a-fA-F]{$i}$/) {
- print "ok $n\n";
- }
- else {
- print "not ok $n\n";
- }
-
- $n++;
+ like $session->{data}->{_session_id}, qr/^[0-9a-fA-F]{$length}$/,
+ "id is $length chars long";
}
+
+chdir( $origdir );
diff -ru /tmp/Apache-Session-1.6/t/99moduniqgen.t Apache-Session/t/99moduniqgen.t
--- /tmp/Apache-Session-1.6/t/99moduniqgen.t Thu Oct 11 13:40:56 2001
+++ Apache-Session/t/99moduniqgen.t Wed Aug 18 16:45:48 2004
@@ -1,6 +1,17 @@
-use Apache::Session::Generate::ModUniqueId;
+use Test::More;
+use Test::Deep;
+use Test::Exception;
+use File::Temp qw[tempdir];
+use Cwd qw[getcwd];
+
+my $origdir = getcwd;
+my $tempdir = tempdir( DIR => '.', CLEANUP => 1 );
+chdir( $tempdir );
-print "1..3\n";
+plan tests => 4;
+
+my $package = 'Apache::Session::Generate::ModUniqueId';
+use_ok $package;
$ENV{UNIQUE_ID} = '12345678790abcdef';
@@ -8,23 +19,11 @@
Apache::Session::Generate::ModUniqueId::generate($session);
-if (exists $session->{data}->{_session_id}) {
- print "ok 1\n";
-}
-else {
- print "not ok 1\n";
-}
-
-if ((scalar keys %{$session->{data}}) == 1) {
- print "ok 2\n";
-}
-else {
- print "not ok 2\n";
-}
-
-if ($session->{data}->{_session_id} eq $ENV{UNIQUE_ID}) {
- print "ok 3\n";
-}
-else {
- print "not ok 3\n";
-}
+ok exists($session->{data}->{_session_id}), 'session id created';
+
+ok keys(%{$session->{data}}) == 1, 'just one key in the data hashref';
+
+is $session->{data}->{_session_id}, $ENV{UNIQUE_ID},
+ 'id matches UNIQUE_ID env param';
+
+chdir( $origdir );
diff -ru /tmp/Apache-Session-1.6/t/99mysql.t Apache-Session/t/99mysql.t
--- /tmp/Apache-Session-1.6/t/99mysql.t Tue Feb 24 14:46:00 2004
+++ Apache-Session/t/99mysql.t Wed Aug 18 18:46:02 2004
@@ -1,135 +1,104 @@
-eval {require DBI; require DBD::mysql;};
-if ($@ || !$ENV{APACHE_SESSION_MAINTAINER}) {
- print "1..0\n";
- exit;
-}
-
-use Apache::Session::MySQL;
-use DBI;
-
-print "1..10\n";
-
-my $s = {};
-
-tie %$s, 'Apache::Session::MySQL', undef, {
- DataSource => 'dbi:mysql:sessions',
- UserName => 'test',
- Password => '',
+use Test::More;
+use Test::Deep;
+use Test::Exception;
+use File::Temp qw[tempdir];
+use Cwd qw[getcwd];
+
+plan skip_all => "Optional modules (DBD::mysql, DBI) not installed"
+ unless eval {
+ require DBI;
+ require DBD::mysql;
+ };
+plan skip_all => "Not running RDBM tests without APACHE_SESSION_MAINTAINER=1"
+ unless $ENV{APACHE_SESSION_MAINTAINER};
+
+my $origdir = getcwd;
+my $tempdir = tempdir( DIR => '.', CLEANUP => 1 );
+chdir( $tempdir );
+
+plan tests => 13;
+
+my $package = 'Apache::Session::MySQL';
+use_ok $package;
+
+my $session = {};
+
+tie %{$session}, $package, undef, {
+ DataSource => 'dbi:mysql:sessions',
+ UserName => 'test',
+ Password => '',
LockDataSource => 'dbi:mysql:sessions',
- LockUserName => 'test',
- LockPassword => ''
+ LockUserName => 'test',
+ LockPassword => ''
};
-if (tied %$s) {
- print "ok 1\n";
-}
-else {
- print "not ok 1\n";
-}
-
-if (exists $s->{_session_id}) {
- print "ok 2\n";
-}
-else {
- print "not ok 2\n";
-}
-
-my $id = $s->{_session_id};
-
-$s->{foo} = 'bar';
-$s->{baz} = ['tom', 'dick', 'harry'];
-
-untie %$s;
-undef $s;
-$s = {};
-
-tie %$s, 'Apache::Session::MySQL', $id, {
- DataSource => 'dbi:mysql:sessions',
- UserName => 'test',
- Password => '',
+ok tied(%{$session}), 'session tied';
+
+ok exists($session->{_session_id}), 'session id exists';
+
+my $id = $session->{_session_id};
+
+my $foo = $session->{foo} = 'bar';
+my $baz = $session->{baz} = ['tom', 'dick', 'harry'];
+
+untie %{$session};
+undef $session;
+$session = {};
+
+tie %{$session}, $package, $id, {
+ DataSource => 'dbi:mysql:sessions',
+ UserName => 'test',
+ Password => '',
LockDataSource => 'dbi:mysql:sessions',
- LockUserName => 'test',
- LockPassword => ''
+ LockUserName => 'test',
+ LockPassword => ''
};
-if (tied %$s) {
- print "ok 3\n";
-}
-else {
- print "not ok 3\n";
-}
-
-if ($s->{_session_id} eq $id) {
- print "ok 4\n";
-}
-else {
- print "not ok 4\n";
-}
-
-if ($s->{foo} eq 'bar' && $s->{baz}->[0] eq 'tom' && $s->{baz}->[2] eq 'harry'){
- print "ok 5\n";
-}
-else {
- print "not ok 5\n";
-}
-
-untie %$s;
-undef $s;
-$s = {};
-
-tie %$s, 'Apache::Session::MySQL', undef, {
- DataSource => 'dbi:mysql:sessions',
- UserName => 'test',
- Password => '',
- TableName => 's',
+ok tied(%{$session}), 'session tied';
+
+is $session->{_session_id}, $id, 'id retrieved matches one stored';
+
+cmp_deeply $session->{foo}, $foo, "Foo matches";
+cmp_deeply $session->{baz}, $baz, "Baz matches";
+
+untie %{$session};
+undef $session;
+$session = {};
+
+tie %{$session}, $package, undef, {
+ DataSource => 'dbi:mysql:sessions',
+ UserName => 'test',
+ Password => '',
+ TableName => 's',
LockDataSource => 'dbi:mysql:sessions',
- LockUserName => 'test',
- LockPassword => ''
+ LockUserName => 'test',
+ LockPassword => ''
};
-if (tied %$s) {
- print "ok 6\n";
-}
-else {
- print "not ok 6\n";
-}
-
-if (exists $s->{_session_id}) {
- print "ok 7\n";
-}
-else {
- print "not ok 7\n";
-}
-
-untie %$s;
-undef $s;
-$s = {};
+ok tied(%{$session}), 'session tied';
+
+ok exists($session->{_session_id}), 'session id exists';
+
+untie %{$session};
+undef $session;
+$session = {};
my $dbh = DBI->connect('dbi:mysql:sessions', 'test', '', {RaiseError => 1});
-tie %$s, 'Apache::Session::MySQL', $id, {Handle => $dbh, LockHandle => $dbh};
+tie %{$session}, $package, $id, {
+ Handle => $dbh,
+ LockHandle => $dbh,
+};
+
+ok tied(%{$session}), 'session tied';
-if (tied %$s) {
- print "ok 8\n";
-}
-else {
- print "not ok 8\n";
-}
-
-if ($s->{_session_id} eq $id) {
- print "ok 9\n";
-}
-else {
- print "not ok 9\n";
-}
-
-if ($s->{foo} eq 'bar' && $s->{baz}->[0] eq 'tom' && $s->{baz}->[2] eq 'harry'){
- print "ok 10\n";
-}
-else {
- print "not ok 10\n";
-}
+is $session->{_session_id}, $id, 'id retrieved matches one stored';
-tied(%$s)->delete;
+cmp_deeply $session->{foo}, $foo, "Foo matches";
+cmp_deeply $session->{baz}, $baz, "Baz matches";
+tied(%{$session})->delete;
+untie %{$session};
$dbh->disconnect;
+
+chdir( $origdir );
diff -ru /tmp/Apache-Session-1.6/t/99mysqllock.t Apache-Session/t/99mysqllock.t
--- /tmp/Apache-Session-1.6/t/99mysqllock.t Thu Oct 11 14:30:20 2001
+++ Apache-Session/t/99mysqllock.t Wed Aug 18 18:45:53 2004
@@ -1,15 +1,27 @@
-eval {require DBI; require DBD::mysql;};
-if ($@ || !$ENV{APACHE_SESSION_MAINTAINER}) {
- print "1..0\n";
- exit;
-}
+use Test::More;
+use Test::Deep;
+use Test::Exception;
+use File::Temp qw[tempdir];
+use Cwd qw[getcwd];
+
+plan skip_all => "Optional modules (DBD::mysql, DBI) not installed"
+ unless eval {
+ require DBI;
+ require DBD::mysql;
+ };
+plan skip_all => "Not running RDBM tests without APACHE_SESSION_MAINTAINER=1"
+ unless $ENV{APACHE_SESSION_MAINTAINER};
+
+my $origdir = getcwd;
+my $tempdir = tempdir( DIR => '.', CLEANUP => 1 );
+chdir( $tempdir );
-use Apache::Session::Lock::MySQL;
-use DBI;
+plan tests => 4;
-print "1..3\n";
+my $package = 'Apache::Session::Lock::MySQL';
+use_ok $package;
-my $s = {
+my $session = {
args => {
LockDataSource => 'dbi:mysql:test',
LockUserName => 'test',
@@ -20,55 +32,38 @@
}
};
-my $l = new Apache::Session::Lock::MySQL;
-my $dbh = DBI->connect('dbi:mysql:test', 'test', '', {RaiseError => 1});
-my $sth = $dbh->prepare(q{SELECT
GET_LOCK('Apache-Session-09876543210987654321098765432109', 0)});
+my $lock = $package->new;
+my $dbh = DBI->connect('dbi:mysql:test', 'test', '', {RaiseError => 1});
+my $sth = $dbh->prepare(q{SELECT
GET_LOCK('Apache-Session-09876543210987654321098765432109', 0)});
my $sth2 = $dbh->prepare(q{SELECT
RELEASE_LOCK('Apache-Session-09876543210987654321098765432109')});
-$l->acquire_write_lock($s);
+$lock->acquire_write_lock($session);
$sth->execute();
-my @array = $sth->fetchrow_array;
+is +($sth->fetchrow_array)[0], 0, 'could not get lock';
-if ($array[0] == 0) {
- print "ok 1\n";
-}
-else {
- print "not ok 1\n";
-}
-
-$l->release_write_lock($s);
+$lock->release_write_lock($session);
$sth->execute();
[EMAIL PROTECTED] = $sth->fetchrow_array;
-
-if ($array[0] == 1) {
- print "ok 2\n";
-}
-else {
- print "not ok 2\n";
-}
+is +($sth->fetchrow_array)[0], 1, 'could get lock';
$sth2->execute;
+undef $lock;
-undef $l;
-
-$s->{args}->{LockHandle} = $dbh;
+$session->{args}->{LockHandle} = $dbh;
-$l = new Apache::Session::Lock::MySQL;
+$lock = $package->new;
-$l->acquire_read_lock($s);
+$lock->acquire_read_lock($session);
$sth->execute();
[EMAIL PROTECTED] = $sth->fetchrow_array;
+$sth->execute();
+is +($sth->fetchrow_array)[0], 1, 'could get lock';
-if ($array[0] == 1) {
- print "ok 3\n";
-}
-else {
- print "not ok 3\n";
-}
+undef $lock;
$sth->finish;
$sth2->finish;
$dbh->disconnect;
+
+chdir( $origdir );
diff -ru /tmp/Apache-Session-1.6/t/99mysqlstore.t Apache-Session/t/99mysqlstore.t
--- /tmp/Apache-Session-1.6/t/99mysqlstore.t Thu Oct 11 14:30:53 2001
+++ Apache-Session/t/99mysqlstore.t Wed Aug 18 18:45:27 2004
@@ -1,22 +1,28 @@
-eval {require DBI; require DBD::mysql;};
-if ($@ || !$ENV{'APACHE_SESSION_MAINTAINER'}) {
- print "1..0\n";
- exit;
-}
-
-use Apache::Session::Store::MySQL;
-use DBI;
-
-use strict;
-
-print "1..1\n";
-
-my $foo = new Apache::Session::Store::MySQL;
-
-if (ref $foo) {
- print "ok 1\n";
-}
-else {
- print "not ok 1\n";
-}
+use Test::More;
+use Test::Deep;
+use Test::Exception;
+use File::Temp qw[tempdir];
+use Cwd qw[getcwd];
+
+plan skip_all => "Optional modules (DBD::mysql, DBI) not installed"
+ unless eval {
+ require DBI;
+ require DBD::mysql;
+ };
+plan skip_all => "Not running RDBM tests without APACHE_SESSION_MAINTAINER=1"
+ unless $ENV{APACHE_SESSION_MAINTAINER};
+
+my $origdir = getcwd;
+my $tempdir = tempdir( DIR => '.', CLEANUP => 1 );
+chdir( $tempdir );
+
+plan tests => 2;
+my $package = 'Apache::Session::Store::MySQL';
+use_ok $package;
+
+my $foo = $package->new;
+
+isa_ok $foo, $package;
+
+chdir( $origdir );
diff -ru /tmp/Apache-Session-1.6/t/99nulllock.t Apache-Session/t/99nulllock.t
--- /tmp/Apache-Session-1.6/t/99nulllock.t Fri May 26 02:11:52 2000
+++ Apache-Session/t/99nulllock.t Wed Aug 18 17:21:00 2004
@@ -1,23 +1,32 @@
-use Apache::Session::Lock::Null;
+use Test::More;
+use Test::Deep;
+use Test::Exception;
+use File::Temp qw[tempdir];
+use Cwd qw[getcwd];
-print "1..4\n";
+plan skip_all => "Optional module (Fcntl) not installed"
+ unless eval {
+ require Fcntl;
+ };
-my $s = {};
-my $l = new Apache::Session::Lock::Null;
+my $origdir = getcwd;
+my $tempdir = tempdir( DIR => '.', CLEANUP => 1 );
+chdir( $tempdir );
-$l->acquire_read_lock($s);
+plan tests => 4;
-print "ok 1\n";
+my $package = 'Apache::Session::Lock::Null';
+use_ok $package;
-$l->acquire_write_lock($s);
+my $session = {};
+my $lock = $package->new;
-print "ok 2\n";
+ok $lock->acquire_read_lock($s), 'got read';
-$l->release_all_locks($s);
+ok $lock->acquire_write_lock($s), 'got write';
-print "ok 3\n";
+ok $lock->release_all_locks($s), 'released all';
-undef $l;
-
-print "ok 4\n";
+undef $lock;
+chdir( $origdir );
diff -ru /tmp/Apache-Session-1.6/t/99oracle.t Apache-Session/t/99oracle.t
--- /tmp/Apache-Session-1.6/t/99oracle.t Fri May 26 18:23:22 2000
+++ Apache-Session/t/99oracle.t Wed Aug 18 18:46:42 2004
@@ -1,125 +1,102 @@
-eval {require DBI; require DBD::Oracle;};
-if ($@) {
- print "1..0\n";
- exit;
-}
+use Test::More;
+use Test::Deep;
+use Test::Exception;
+use File::Temp qw[tempdir];
+use Cwd qw[getcwd];
+
+plan skip_all => "Optional modules (DBD::Oracle, DBI) not installed"
+ unless eval {
+ require DBI;
+ require DBD::Oracle;
+ };
+plan skip_all => "Not running RDBM tests without APACHE_SESSION_MAINTAINER=1"
+ unless $ENV{APACHE_SESSION_MAINTAINER};
+
+my $origdir = getcwd;
+my $tempdir = tempdir( DIR => '.', CLEANUP => 1 );
+chdir( $tempdir );
-use Apache::Session::Oracle;
+plan tests => 13;
-print "1..10\n";
+my $package = 'Apache::Session::Oracle';
+use_ok $package;
-my $s = {};
+my $session = {};
-tie %$s, 'Apache::Session::Oracle', undef, {
+tie %{$session}, $package, undef, {
DataSource => "dbi:Oracle:$ENV{ORACLE_SID}",
UserName => $ENV{AS_ORACLE_USER},
Password => $ENV{AS_ORACLE_PASS},
Commit => 1
};
-if (tied %$s) {
- print "ok 1\n";
-}
-else {
- print "not ok 1\n";
-}
-
-if (exists $s->{_session_id}) {
- print "ok 2\n";
-}
-else {
- print "not ok 2\n";
-}
-
-my $id = $s->{_session_id};
-
-$s->{foo} = 'bar';
-$s->{baz} = ['tom', 'dick', 'harry'];
-
-untie %$s;
-undef $s;
-$s = {};
+ok tied(%{$session}), 'session tied';
-tie %$s, 'Apache::Session::Oracle', $id, {
+ok exists($session->{_session_id}), 'session id exists';
+
+my $id = $session->{_session_id};
+
+my $foo = $session->{foo} = 'bar';
+my $baz = $session->{baz} = ['tom', 'dick', 'harry'];
+
+untie %{$session};
+undef $session;
+$session = {};
+
+tie %{$session}, $package, $id, {
DataSource => "dbi:Oracle:$ENV{ORACLE_SID}",
UserName => $ENV{AS_ORACLE_USER},
Password => $ENV{AS_ORACLE_PASS},
Commit => 1
};
-if (tied %$s) {
- print "ok 3\n";
-}
-else {
- print "not ok 3\n";
-}
-
-if ($s->{_session_id} eq $id) {
- print "ok 4\n";
-}
-else {
- print "not ok 4\n";
-}
-
-if ($s->{foo} eq 'bar' && $s->{baz}->[0] eq 'tom' && $s->{baz}->[2] eq 'harry'){
- print "ok 5\n";
-}
-else {
- print "not ok 5\n";
-}
-
-$s->{long} = 'A'x(10*2**10);
-
-untie %$s;
-undef $s;
-$s = {};
+ok tied(%{$session}), 'session tied';
+
+is $session->{_session_id}, $id, 'id retrieved matches one stored';
+
+cmp_deeply $session->{foo}, $foo, "Foo matches";
+cmp_deeply $session->{baz}, $baz, "Baz matches";
+
+$session->{long} = 'A'x(10*2**10);
+
+untie %{$session};
+undef $session;
+$session = {};
my $dbh = DBI->connect("dbi:Oracle:$ENV{ORACLE_SID}", $ENV{AS_ORACLE_USER},
$ENV{AS_ORACLE_PASS}, {RaiseError => 1, AutoCommit => 0});
-tie %$s, 'Apache::Session::Oracle', $id, {Handle => $dbh, Commit => 0, LongReadLen =>
20*2**10};
+tie %{$session}, $package, $id, {
+ Handle => $dbh,
+ Commit => 0,
+ LongReadLen => 20*2**10,
+};
+
+ok tied(%{$session}), 'session tied';
-if (tied %$s) {
- print "ok 6\n";
-}
-else {
- print "not ok 6\n";
-}
-
-if ($s->{long} eq 'A'x(10*2**10)) {
- print "ok 7\n";
-}
-else {
- print "not ok 7\n";
-}
-
-delete $s->{long};
-
-untie %$s;
-undef $s;
-$s = {};
-
-tie %$s, 'Apache::Session::Oracle', $id, {Handle => $dbh, Commit => 0};
-
-if (tied %$s) {
- print "ok 8\n";
-}
-else {
- print "not ok 8\n";
-}
-
-if ($s->{_session_id} eq $id) {
- print "ok 9\n";
-}
-else {
- print "not ok 9\n";
-}
-
-if ($s->{foo} eq 'bar' && $s->{baz}->[0] eq 'tom' && $s->{baz}->[2] eq 'harry'){
- print "ok 10\n";
-}
-else {
- print "not ok 10\n";
-}
+is $session->{long}, 'A'x(10*2**10), 'long read worked';
+
+delete $session->{long};
+
+untie %{$session};
+undef $session;
+$session = {};
+
+tie %{$session}, $package, $id, {
+ Handle => $dbh,
+ Commit => 0,
+};
+
+ok tied(%{$session}), 'session tied';
+
+is $session->{_session_id}, $id, 'id retrieved matches one stored';
+
+cmp_deeply $session->{foo}, $foo, "Foo matches";
+cmp_deeply $session->{baz}, $baz, "Baz matches";
+
+tied(%{$session})->delete;
+untie %{$session};
$dbh->commit;
$dbh->disconnect;
+
+chdir( $origdir );
diff -ru /tmp/Apache-Session-1.6/t/99postgres.t Apache-Session/t/99postgres.t
--- /tmp/Apache-Session-1.6/t/99postgres.t Tue Feb 24 14:53:23 2004
+++ Apache-Session/t/99postgres.t Wed Aug 18 18:47:07 2004
@@ -1,129 +1,101 @@
-eval {require DBI; require DBD::Pg;};
-if ($@ || !$ENV{APACHE_SESSION_MAINTAINER}) {
- print "1..0\n";
- exit;
-}
-
-use Apache::Session::Postgres;
-
-print "1..10\n";
-
-my $s = {};
-
-tie %$s, 'Apache::Session::Postgres', undef, {
- DataSource => 'dbi:Pg:dbname=sessions',
- UserName => 'postgres',
- Password => '',
- Commit => 1
+use Test::More;
+use Test::Deep;
+use Test::Exception;
+use File::Temp qw[tempdir];
+use Cwd qw[getcwd];
+
+plan skip_all => "Optional modules (DBD::Pg, DBI) not installed"
+ unless eval {
+ require DBI;
+ require DBD::Pg;
+ };
+plan skip_all => "Not running RDBM tests without APACHE_SESSION_MAINTAINER=1"
+ unless $ENV{APACHE_SESSION_MAINTAINER};
+
+my $origdir = getcwd;
+my $tempdir = tempdir( DIR => '.', CLEANUP => 1 );
+chdir( $tempdir );
+
+plan tests => 13;
+
+my $package = 'Apache::Session::Postgres';
+use_ok $package;
+
+my $session = {};
+
+my ($dbname, $user, $pass) = ('sessions', 'postgres', '');
+
+tie %{$session}, $package, undef, {
+ DataSource => "dbi:Pg:dbname=$dbname",
+ UserName => $user,
+ Password => $pass,
+ Commit => 1
};
-if (tied %$s) {
- print "ok 1\n";
-}
-else {
- print "not ok 1\n";
-}
-
-if (exists $s->{_session_id}) {
- print "ok 2\n";
-}
-else {
- print "not ok 2\n";
-}
-
-my $id = $s->{_session_id};
-
-$s->{foo} = 'bar';
-$s->{baz} = ['tom', 'dick', 'harry'];
-
-untie %$s;
-undef $s;
-$s = {};
-
-tie %$s, 'Apache::Session::Postgres', $id, {
- DataSource => 'dbi:Pg:dbname=sessions',
- UserName => 'postgres',
- Password => '',
+ok tied(%{$session}), 'session tied';
+
+ok exists($session->{_session_id}), 'session id exists';
+
+my $id = $session->{_session_id};
+
+my $foo = $session->{foo} = 'bar';
+my $baz = $session->{baz} = ['tom', 'dick', 'harry'];
+
+untie %{$session};
+undef $session;
+$session = {};
+
+tie %{$session}, $package, $id, {
+ DataSource => "dbi:Pg:dbname=$dbname",
+ UserName => $user,
+ Password => $pass,
Commit => 1
};
-if (tied %$s) {
- print "ok 3\n";
-}
-else {
- print "not ok 3\n";
-}
-
-if ($s->{_session_id} eq $id) {
- print "ok 4\n";
-}
-else {
- print "not ok 4\n";
-}
-
-if ($s->{foo} eq 'bar' && $s->{baz}->[0] eq 'tom' && $s->{baz}->[2] eq 'harry'){
- print "ok 5\n";
-}
-else {
- print "not ok 5\n";
-}
-
-untie %$s;
-undef $s;
-$s = {};
-
-tie %$s, 'Apache::Session::Postgres', undef, {
- DataSource => 'dbi:Pg:dbname=sessions',
- UserName => 'postgres',
- Password => '',
+ok tied(%{$session}), 'session tied';
+
+is $session->{_session_id}, $id, 'id retrieved matches one stored';
+
+cmp_deeply $session->{foo}, $foo, "Foo matches";
+cmp_deeply $session->{baz}, $baz, "Baz matches";
+
+untie %{$session};
+undef $session;
+$session = {};
+
+tie %{$session}, $package, undef, {
+ DataSource => "dbi:Pg:dbname=$dbname",
+ UserName => $user,
+ Password => $pass,
Commit => 1,
TableName => 's'
};
-if (tied %$s) {
- print "ok 6\n";
-}
-else {
- print "not ok 6\n";
-}
-
-if (exists($s->{_session_id})) {
- print "ok 7\n";
-}
-else {
- print "not ok 7\n";
-}
-
-untie %$s;
-undef $s;
-$s = {};
-
-my $dbh = DBI->connect('dbi:Pg:dbname=sessions', 'postgres', '', {RaiseError => 1,
AutoCommit => 0});
-
-tie %$s, 'Apache::Session::Postgres', $id, {Handle => $dbh, Commit => 0};
-
-if (tied %$s) {
- print "ok 8\n";
-}
-else {
- print "not ok 8\n";
-}
-
-if ($s->{_session_id} eq $id) {
- print "ok 9\n";
-}
-else {
- print "not ok 9\n";
-}
-
-if ($s->{foo} eq 'bar' && $s->{baz}->[0] eq 'tom' && $s->{baz}->[2] eq 'harry'){
- print "ok 10\n";
-}
-else {
- print "not ok 10\n";
-}
+ok tied(%{$session}), 'session tied';
+
+ok exists($session->{_session_id}), 'session id exists';
+
+untie %{$session};
+undef $session;
+$session = {};
-tied(%$s)->delete;
+my $dbh = DBI->connect("dbi:Pg:dbname=$dbname", $user, $pass, {RaiseError => 1,
AutoCommit => 0});
+
+tie %{$session}, $package, $id, {
+ Handle => $dbh,
+ Commit => 0,
+};
+ok tied(%{$session}), 'session tied';
+
+is $session->{_session_id}, $id, 'id retrieved matches one stored';
+
+cmp_deeply $session->{foo}, $foo, "Foo matches";
+cmp_deeply $session->{baz}, $baz, "Baz matches";
+
+tied(%{$session})->delete;
+untie %{$session};
$dbh->commit;
$dbh->disconnect;
+
+chdir( $origdir );
diff -ru /tmp/Apache-Session-1.6/t/99semaphore.t Apache-Session/t/99semaphore.t
--- /tmp/Apache-Session-1.6/t/99semaphore.t Fri May 26 02:11:50 2000
+++ Apache-Session/t/99semaphore.t Wed Aug 18 18:57:47 2004
@@ -1,15 +1,26 @@
-eval {require IPC::SysV; require IPC::Semaphore;};
-if ($@) {
- print "1..0\n";
- exit;
-}
+use Test::More;
+use Test::Deep;
+use Test::Exception;
+use File::Temp qw[tempdir];
+use Cwd qw[getcwd];
+
+plan skip_all => "Optional modules (IPC::SysV, IPC::Semaphore) not installed"
+ unless eval {
+ require IPC::SysV;
+ require IPC::Semaphore;
+ };
+
+my $origdir = getcwd;
+my $tempdir = tempdir( DIR => '.', CLEANUP => 1 );
+chdir( $tempdir );
+
+plan tests => 29;
-use Apache::Session::Lock::Semaphore;
+my $package = 'Apache::Session::Lock::Semaphore';
+use_ok $package;
use IPC::SysV qw(IPC_CREAT S_IRWXU SEM_UNDO);
use IPC::Semaphore;
-print "1..28\n";
-
my $semkey = int(rand(2**15-1));
my $session = {
@@ -17,93 +28,56 @@
args => {SemaphoreKey => $semkey}
};
-my $n = 1;
-
-for (my $i = 2; $i <= 8; $i += 2) {
- $session->{args}->{NSems} = $i;
- my $locker = new Apache::Session::Lock::Semaphore $session;
-
- if (ref $locker) {
- print "ok $n\n";
- }
- else {
- print "not ok $n\n";
- }
- $n++;
+my $number = 1;
+for my $iter (2,4,6,8) {
+ $session->{args}->{NSems} = $iter;
+ my $locker = $package->new($session);
+
+ isa_ok $locker, $package;
$locker->acquire_read_lock($session);
my $semnum = $locker->{read_sem};
- my $sem = new IPC::Semaphore $semkey, $i, S_IRWXU;
+ my $sem = IPC::Semaphore->new($semkey, $number++, S_IRWXU);
+
+ isa_ok $sem, 'IPC::Semaphore';
- if (ref $sem) {
- print "ok $n\n";
- }
- else {
- print "not ok $n\n";
- exit;
- }
- $n++;
-
my @sems = $sem->getall;
- if ($sems[$semnum] == 1 && $sems[$semnum+$i/2] == 0) {
- print "ok $n\n";
- }
- else {
- print "not ok $n\n";
- }
- $n++;
+ ok $sems[$semnum] == 1 && $sems[$semnum+$iter/2] == 0,
+ 'the semaphores seem right';
$locker->acquire_write_lock($session);
@sems = $sem->getall;
- if ($sems[$semnum] == 0 && $sems[$semnum+$i/2] == 1) {
- print "ok $n\n";
- }
- else {
- print "not ok $n\n";
- }
- $n++;
+ ok $sems[$semnum] == 0 && $sems[$semnum+$iter/2] == 1,
+ 'semaphores seem right again';
$locker->release_write_lock($session);
@sems = $sem->getall;
- if ($sems[$semnum] == 0 && $sems[$semnum+$i/2] == 0) {
- print "ok $n\n";
- }
- else {
- print "not ok $n\n";
- }
- $n++;
+ ok $sems[$semnum] == 0 && $sems[$semnum+$iter/2] == 0,
+ 'the semaphores seem right x3';
$locker->acquire_write_lock($session);
$locker->release_all_locks($session);
@sems = $sem->getall;
- if ($sems[$semnum] == 0 && $sems[$semnum+$i/2] == 0) {
- print "ok $n\n";
- }
- else {
- print "not ok $n\n";
- }
- $n++;
+ ok $sems[$semnum] == 0 && $sems[$semnum+$iter/2] == 0,
+ 'the semaphores seem right x4';
$locker->acquire_read_lock($session);
$locker->release_all_locks($session);
@sems = $sem->getall;
- if ($sems[$semnum] == 0 && $sems[$semnum+$i/2] == 0) {
- print "ok $n\n";
- }
- else {
- print "not ok $n\n";
- }
- $n++;
+ ok $sems[$semnum] == 0 && $sems[$semnum+$iter/2] == 0,
+ 'the semaphores seem right x5';
$sem->remove;
}
+
+chdir( $origdir );
diff -ru /tmp/Apache-Session-1.6/t/99storable.t Apache-Session/t/99storable.t
--- /tmp/Apache-Session-1.6/t/99storable.t Fri May 26 02:11:49 2000
+++ Apache-Session/t/99storable.t Wed Aug 18 18:31:31 2004
@@ -1,35 +1,46 @@
-eval {require Storable;};
-if ($@) {
- print "1..0\n";
- exit;
-}
-
-use Apache::Session::Serialize::Storable;
-
-print "1..1\n";
-
-my $s = \&Apache::Session::Serialize::Storable::serialize;
-my $u = \&Apache::Session::Serialize::Storable::unserialize;
-
-my $session = {serialized => undef, data => undef};
-my $simple = {foo => 1, bar => 2, baz => 'quux', quux => ['foo', 'bar']};
+use Test::More;
+use Test::Deep;
+use Test::Exception;
+use File::Temp qw[tempdir];
+use Cwd qw[getcwd];
+
+plan skip_all => "Optional module (Storable) not installed"
+ unless eval {
+ require Storable;
+ };
+
+my $origdir = getcwd;
+my $tempdir = tempdir( DIR => '.', CLEANUP => 1 );
+chdir( $tempdir );
+
+plan tests => 2;
+
+my $package = 'Apache::Session::Serialize::Storable';
+use_ok $package;
+
+
+my $serial = \&Apache::Session::Serialize::Storable::serialize;
+my $unserial = \&Apache::Session::Serialize::Storable::unserialize;
+
+my $session = {
+ serialized => undef,
+ data => undef,
+};
+my $simple = {
+ foo => 1,
+ bar => 2,
+ baz => 'quux',
+ quux => ['foo', 'bar'],
+};
$session->{data} = $simple;
-&$s($session);
+&$serial($session);
$session->{data} = undef;
-&$u($session);
+&$unserial($session);
+
+cmp_deeply($simple, $session->{data}, 'session data is correct');
-if ($session->{data}->{foo} == 1 &&
- $session->{data}->{bar} == 2 &&
- $session->{data}->{baz} eq 'quux' &&
- $session->{data}->{quux}->[0] eq 'foo' &&
- $session->{data}->{quux}->[1] eq 'bar') {
-
- print "ok 1\n";
-}
-else {
- print "not ok 1\n";
-}
+chdir( $origdir );
diff -ru /tmp/Apache-Session-1.6/t/99uue.t Apache-Session/t/99uue.t
--- /tmp/Apache-Session-1.6/t/99uue.t Fri May 26 02:11:51 2000
+++ Apache-Session/t/99uue.t Wed Aug 18 18:33:01 2004
@@ -1,35 +1,45 @@
-eval {require Storable;};
-if ($@) {
- print "1..0\n";
- exit;
-}
-
-use Apache::Session::Serialize::UUEncode;
-
-print "1..1\n";
-
-my $s = \&Apache::Session::Serialize::UUEncode::serialize;
-my $u = \&Apache::Session::Serialize::UUEncode::unserialize;
-
-my $session = {serialized => undef, data => undef};
-my $simple = {foo => 1, bar => 2, baz => 'quux', quux => ['foo', 'bar']};
+use Test::More;
+use Test::Deep;
+use Test::Exception;
+use File::Temp qw[tempdir];
+use Cwd qw[getcwd];
+
+plan skip_all => "Optional module (Storable) not installed"
+ unless eval {
+ require Storable;
+ };
+
+my $origdir = getcwd;
+my $tempdir = tempdir( DIR => '.', CLEANUP => 1 );
+chdir( $tempdir );
+
+plan tests => 2;
+
+my $package = 'Apache::Session::Serialize::UUEncode';
+use_ok $package;
+
+my $serial = \&Apache::Session::Serialize::UUEncode::serialize;
+my $unserial = \&Apache::Session::Serialize::UUEncode::unserialize;
+
+my $session = {
+ serialized => undef,
+ data => undef,
+};
+my $simple = {
+ foo => 1,
+ bar => 2,
+ baz => 'quux',
+ quux => ['foo', 'bar'],
+};
$session->{data} = $simple;
-&$s($session);
+&$serial($session);
$session->{data} = undef;
-&$u($session);
+&$unserial($session);
+
+cmp_deeply($simple, $session->{data}, 'session data is correct');
-if ($session->{data}->{foo} == 1 &&
- $session->{data}->{bar} == 2 &&
- $session->{data}->{baz} eq 'quux' &&
- $session->{data}->{quux}->[0] eq 'foo' &&
- $session->{data}->{quux}->[1] eq 'bar') {
-
- print "ok 1\n";
-}
-else {
- print "not ok 1\n";
-}
+chdir( $origdir );
--
Report problems: http://perl.apache.org/bugs/
Mail list info: http://perl.apache.org/maillist/modperl.html
List etiquette: http://perl.apache.org/maillist/email-etiquette.html
