r1442 - in packages/libapache-session-perl/trunk: . Session/Lock
debian t
Gunnar Wolf
gwolf at costa.debian.org
Mon Oct 24 16:45:31 UTC 2005
Author: gwolf
Date: 2005-10-24 16:44:44 +0000 (Mon, 24 Oct 2005)
New Revision: 1442
Modified:
packages/libapache-session-perl/trunk/CHANGES
packages/libapache-session-perl/trunk/INSTALL
packages/libapache-session-perl/trunk/MANIFEST
packages/libapache-session-perl/trunk/META.yml
packages/libapache-session-perl/trunk/Makefile.PL
packages/libapache-session-perl/trunk/README
packages/libapache-session-perl/trunk/Session.pm
packages/libapache-session-perl/trunk/Session/Lock/Semaphore.pm
packages/libapache-session-perl/trunk/TODO
packages/libapache-session-perl/trunk/debian/changelog
packages/libapache-session-perl/trunk/t/99base64.t
packages/libapache-session-perl/trunk/t/99dbfile.t
packages/libapache-session-perl/trunk/t/99dbfilestore.t
packages/libapache-session-perl/trunk/t/99file.t
packages/libapache-session-perl/trunk/t/99filelock.t
packages/libapache-session-perl/trunk/t/99filestore.t
packages/libapache-session-perl/trunk/t/99flex.t
packages/libapache-session-perl/trunk/t/99md5gen.t
packages/libapache-session-perl/trunk/t/99moduniqgen.t
packages/libapache-session-perl/trunk/t/99mysql.t
packages/libapache-session-perl/trunk/t/99mysqllock.t
packages/libapache-session-perl/trunk/t/99mysqlstore.t
packages/libapache-session-perl/trunk/t/99nulllock.t
packages/libapache-session-perl/trunk/t/99oracle.t
packages/libapache-session-perl/trunk/t/99postgres.t
packages/libapache-session-perl/trunk/t/99semaphore.t
packages/libapache-session-perl/trunk/t/99storable.t
packages/libapache-session-perl/trunk/t/99uue.t
Log:
New upstream version
Modified: packages/libapache-session-perl/trunk/CHANGES
===================================================================
--- packages/libapache-session-perl/trunk/CHANGES 2005-10-24 16:43:35 UTC (rev 1441)
+++ packages/libapache-session-perl/trunk/CHANGES 2005-10-24 16:44:44 UTC (rev 1442)
@@ -1,3 +1,15 @@
+1.8 2005-10-06
+
+ - Bug fix to stop death in Apache::Session::Lock::Semaphore.
+
+1.70_01 2004-09-01
+
+ - Casey West takes the pumpkin.
+ - Complete rewrite of test suite to use Test::* modules.
+ - Minor documentation tweaks.
+
+---
+
Changes in 1.6:
Fixed file age test for clean(). The previous test was never true.
Modified: packages/libapache-session-perl/trunk/INSTALL
===================================================================
--- packages/libapache-session-perl/trunk/INSTALL 2005-10-24 16:43:35 UTC (rev 1441)
+++ packages/libapache-session-perl/trunk/INSTALL 2005-10-24 16:44:44 UTC (rev 1442)
@@ -7,7 +7,7 @@
perl Makefile.PL
make install
- perldoc Session
+ perldoc Apache::Session
Have fun,
Jeffrey
Modified: packages/libapache-session-perl/trunk/MANIFEST
===================================================================
--- packages/libapache-session-perl/trunk/MANIFEST 2005-10-24 16:43:35 UTC (rev 1441)
+++ packages/libapache-session-perl/trunk/MANIFEST 2005-10-24 16:44:44 UTC (rev 1442)
@@ -1,7 +1,17 @@
+b/dbi.b
+b/dbinew.b
+b/dbipop.b
+b/dbstore.b
+b/flexpop.b
+b/gdbm.b
+b/mysqllock.b
+b/uuevsmime.b
CHANGES
+eg/example.perl
INSTALL
-MANIFEST
Makefile.PL
+MANIFEST This list of files
+META.yml
README
Session.pm
Session/DB_File.pm
@@ -23,8 +33,8 @@
Session/Serialize/Storable.pm
Session/Serialize/Sybase.pm
Session/Serialize/UUEncode.pm
+Session/Store/DB_File.pm
Session/Store/DBI.pm
-Session/Store/DB_File.pm
Session/Store/File.pm
Session/Store/Informix.pm
Session/Store/MySQL.pm
@@ -32,16 +42,6 @@
Session/Store/Postgres.pm
Session/Store/Sybase.pm
Session/Sybase.pm
-TODO
-b/dbi.b
-b/dbinew.b
-b/dbipop.b
-b/dbstore.b
-b/flexpop.b
-b/gdbm.b
-b/mysqllock.b
-b/uuevsmime.b
-eg/example.perl
t/99base64.t
t/99dbfile.t
t/99dbfilestore.t
@@ -60,4 +60,4 @@
t/99semaphore.t
t/99storable.t
t/99uue.t
-META.yml Module meta-data (added by MakeMaker)
+TODO
Modified: packages/libapache-session-perl/trunk/META.yml
===================================================================
--- packages/libapache-session-perl/trunk/META.yml 2005-10-24 16:43:35 UTC (rev 1441)
+++ packages/libapache-session-perl/trunk/META.yml 2005-10-24 16:44:44 UTC (rev 1442)
@@ -1,10 +1,13 @@
# http://module-build.sourceforge.net/META-spec.html
#XXXXXXX This is a prototype!!! It will change in the future!!! XXXXX#
name: Apache-Session
-version: 1.6
+version: 1.80
version_from: Session.pm
installdirs: site
requires:
+ Test::Deep: 0.082
+ Test::Exception: 0.15
+ Test::More: 0.47
distribution_type: module
generated_by: ExtUtils::MakeMaker version 6.17
Modified: packages/libapache-session-perl/trunk/Makefile.PL
===================================================================
--- packages/libapache-session-perl/trunk/Makefile.PL 2005-10-24 16:43:35 UTC (rev 1441)
+++ packages/libapache-session-perl/trunk/Makefile.PL 2005-10-24 16:44:44 UTC (rev 1442)
@@ -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.47',
+ 'Test::Deep' => '0.082',
+ 'Test::Exception' => '0.15',
+ },
);
Modified: packages/libapache-session-perl/trunk/README
===================================================================
--- packages/libapache-session-perl/trunk/README 2005-10-24 16:43:35 UTC (rev 1441)
+++ packages/libapache-session-perl/trunk/README 2005-10-24 16:44:44 UTC (rev 1442)
@@ -17,6 +17,9 @@
Apache::Session is Copyright (c) 1998, 1999, 2000, 2001, 2004 Jeffrey William
Baker <jwbaker at acm.org>. Distribute under the same terms as Perl itself.
+Apache::Session is Copyright (c) 2004 Casey West, <casey at geeknest.com>.
+Disribute under the same terms as Perl itself.
+
PREREQUISITES
-------------
Modified: packages/libapache-session-perl/trunk/Session/Lock/Semaphore.pm
===================================================================
--- packages/libapache-session-perl/trunk/Session/Lock/Semaphore.pm 2005-10-24 16:43:35 UTC (rev 1441)
+++ packages/libapache-session-perl/trunk/Session/Lock/Semaphore.pm 2005-10-24 16:44:44 UTC (rev 1442)
@@ -49,7 +49,7 @@
my $session = shift;
return if $self->{read};
- die if $self->{write};
+ return if $self->{write};
if (!$self->{sem}) {
$self->{sem} = new IPC::Semaphore($self->{sem_key}, $self->{nsems},
@@ -122,7 +122,7 @@
my $session = shift;
- die unless $self->{read};
+ return unless $self->{read};
$self->{sem}->op($self->{read_sem}, -1, SEM_UNDO);
@@ -133,7 +133,7 @@
my $self = shift;
my $session = shift;
- die unless $self->{write};
+ return unless $self->{write};
$self->{sem}->op($self->{read_sem} + $self->{nsems}/2, -1, SEM_UNDO);
Modified: packages/libapache-session-perl/trunk/Session.pm
===================================================================
--- packages/libapache-session-perl/trunk/Session.pm 2005-10-24 16:43:35 UTC (rev 1441)
+++ packages/libapache-session-perl/trunk/Session.pm 2005-10-24 16:44:44 UTC (rev 1442)
@@ -312,7 +312,7 @@
use strict;
use vars qw($VERSION);
-$VERSION = '1.6';
+$VERSION = '1.80';
#State constants
#
Modified: packages/libapache-session-perl/trunk/TODO
===================================================================
--- packages/libapache-session-perl/trunk/TODO 2005-10-24 16:43:35 UTC (rev 1441)
+++ packages/libapache-session-perl/trunk/TODO 2005-10-24 16:44:44 UTC (rev 1442)
@@ -1 +1,18 @@
-Nothing left!
+- Document the API Apache::Session expects you to implement for new
+ stores, lockers, serializers, and generators.
+- Make interfaces more abstract so using a tied hash is not the only
+ easily accessible option.
+- Review and expand test coverage as much as possible (anybody have
+ a spare Sybase or Oracle?).
+- Address anything at
+ http://rt.cpan.org/NoAuth/Bugs.html?Dist=Apache-Session
+- Address anything in http://cpanratings.perl.org/d/Apache-Session
+ appropriately.
+- Review and apply suggestions and patches from contributors.
+- Form a secret cabal to get the cpanrating up to 4.5 stars.
+- Work with any testing monkeys that the Phalanx project brings me,
+ http://qa.perl.org/phalanx/distros.html
+- Always precede a release with as many dev releases as necessary
+ (is this getting too detailed?).
+- Generally treat the distribution with great care because it is
+ widely used.
Modified: packages/libapache-session-perl/trunk/debian/changelog
===================================================================
--- packages/libapache-session-perl/trunk/debian/changelog 2005-10-24 16:43:35 UTC (rev 1441)
+++ packages/libapache-session-perl/trunk/debian/changelog 2005-10-24 16:44:44 UTC (rev 1442)
@@ -1,3 +1,9 @@
+libapache-session-perl (1.80-1) unstable; urgency=low
+
+ * New upstream release
+
+ -- Gunnar Wolf <gwolf at debian.org> Mon, 24 Oct 2005 11:40:00 -0500
+
libapache-session-perl (1.60-3) unstable; urgency=low
* Added the 'make test' target at build time
Modified: packages/libapache-session-perl/trunk/t/99base64.t
===================================================================
--- packages/libapache-session-perl/trunk/t/99base64.t 2005-10-24 16:43:35 UTC (rev 1441)
+++ packages/libapache-session-perl/trunk/t/99base64.t 2005-10-24 16:44:44 UTC (rev 1442)
@@ -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;
+plan skip_all => "Optional modules (MIME::Base64,Storable) not installed"
+ unless eval {
+ require MIME::Base64;
+ require Storable;
+ };
-print "1..1\n";
+plan tests => 3;
-my $s = \&Apache::Session::Serialize::Base64::serialize;
-my $u = \&Apache::Session::Serialize::Base64::unserialize;
+my $package = 'Apache::Session::Serialize::Base64';
+use_ok $package;
+can_ok $package, qw[serialize unserialize];
-my $session = {serialized => undef, data => undef};
-my $simple = {foo => 1, bar => 2, baz => 'quux', quux => ['foo', 'bar']};
+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";
Modified: packages/libapache-session-perl/trunk/t/99dbfile.t
===================================================================
--- packages/libapache-session-perl/trunk/t/99dbfile.t 2005-10-24 16:43:35 UTC (rev 1441)
+++ packages/libapache-session-perl/trunk/t/99dbfile.t 2005-10-24 16:44:44 UTC (rev 1442)
@@ -1,78 +1,56 @@
-eval {require DB_File;};
-if ($@) {
- print "1..0\n";
- exit;
-}
+use Test::More;
+use Test::Deep;
+use File::Temp qw[tempdir];
+use Cwd qw[getcwd];
-use Apache::Session::DB_File;
+plan skip_all => "Optional module (DB_File) not installed"
+ unless eval {
+ require DB_File;
+ };
-my $mydir = int(rand(1000));
-mkdir "./$mydir", 0777;
-chdir $mydir;
+my $package = 'Apache::Session::DB_File';
-print "1..5\n";
+plan tests => 8;
-my $s = {};
+use_ok $package;
-tie %$s, 'Apache::Session::DB_File', undef, {
- FileName => './test.db',
- LockDirectory => '.'
-};
+my $origdir = getcwd;
+my $tempdir = tempdir( DIR => '.', CLEANUP => 1 );
+chdir( $tempdir );
-if (tied %$s) {
- print "ok 1\n";
-}
-else {
- print "not ok 1\n";
-}
+my %session;
+my %tie_params = (
+ FileName => './text.db',
+ LockDirectory => '.',
+);
-if (exists $s->{_session_id}) {
- print "ok 2\n";
-}
-else {
- print "not ok 2\n";
-}
+tie %session, $package, undef, { %tie_params };
-my $id = $s->{_session_id};
+ok( tied(%session), "The session is tied" );
-$s->{foo} = 'bar';
-$s->{baz} = ['tom', 'dick', 'harry'];
+ok( exists($session{_session_id}), "Session id exists" );
+ok( defined($session{_session_id}), "Session id is defined" );
-untie %$s;
-undef $s;
-$s = {};
+my $id = $session{_session_id};
-tie %$s, 'Apache::Session::DB_File', $id, {
- FileName => './test.db',
- LockDirectory => '.'
-};
+my $foo = 'bar';
+my $baz = [ qw[tom dick harry] ];
-if (tied %$s) {
- print "ok 3\n";
-}
-else {
- print "not ok 3\n";
-}
+$session{foo} = $foo;
+$session{baz} = $baz;
-if ($s->{_session_id} eq $id) {
- print "ok 4\n";
-}
-else {
- print "not ok 4\n";
-}
+untie %session;
+undef %session;
-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";
-}
+tie %session, $package, $id, { %tie_params };
-tied(%$s)->delete;
+ok( tied(%session), "The session is tied again" );
+is( $session{_session_id}, $id, "Session IDs match" );
-unlink "./Apache-Session-$id.lock" || die $!;
-unlink "./test.db" || die $!;
-chdir "..";
-rmdir $mydir || die $!;
+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
Modified: packages/libapache-session-perl/trunk/t/99dbfilestore.t
===================================================================
--- packages/libapache-session-perl/trunk/t/99dbfilestore.t 2005-10-24 16:43:35 UTC (rev 1441)
+++ packages/libapache-session-perl/trunk/t/99dbfilestore.t 2005-10-24 16:44:44 UTC (rev 1442)
@@ -1,73 +1,78 @@
-eval {require DB_File};
-if ($@) {
- print "1..0\n";
- exit;
-}
+use Test::More;
+use Test::Deep;
+use Test::Exception;
+use File::Temp qw[tempdir];
+use Cwd qw[getcwd];
-use Apache::Session::Store::DB_File;
-use DB_File;
+plan skip_all => "Optional module (DB_File) not installed"
+ unless eval {
+ require DB_File;
+ };
-my $mydir = int(rand(1000));
-mkdir "./$mydir", 0777;
-chdir $mydir;
+my $package = 'Apache::Session::Store::DB_File';
-print "1..4\n";
+my $origdir = getcwd;
+my $tempdir = tempdir( DIR => '.', CLEANUP => 1 );
+chdir( $tempdir );
-my $session = {serialized => '12345', data => {_session_id => 'test1'}, args => {FileName => 'foo.dbm'}};
+my $serial = '12345';
+my $id = 'test1';
+my $dbfile = 'foo.dbm';
+my $session = {
+ serialized => $serial,
+ data => {
+ _session_id => $id,
+ },
+ args => {
+ FileName => $dbfile,
+ },
+};
-my $store = new Apache::Session::Store::DB_File;
+plan tests => 13;
-$store->insert($session);
+use_ok $package;
+use_ok 'DB_File';
+can_ok $package, qw[new insert materialize remove];
-if (-e "./foo.dbm") {
- print "ok 1\n";
-}
-else {
- print "not ok 1\n";
-}
+my $store = $package->new;
+isa_ok $store, $package;
+my $i_ret = $store->insert($session);
+is( $i_ret, $serial, "insert() returned value of serialized" );
+
+ok( -e $dbfile, 'dbm file exists' );
+
undef $store;
-$store = new Apache::Session::Store::DB_File;
-$session->{serialized} = '';
-$store->materialize($session);
+$store = $package->new;
+isa_ok $store, $package;
-if ($session->{serialized} eq '12345') {
- print "ok 2\n";
-}
-else {
- print "not ok 2\n";
-}
+$session->{serialized} = undef;
+lives_ok {
+ $store->materialize($session)
+} 'materialize did not die';
+is( $session->{serialized}, $serial, "materialized session is correct" );
-$session->{serialized} = 'hi';
-$store->update($session);
+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" );
+
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 );
Modified: packages/libapache-session-perl/trunk/t/99file.t
===================================================================
--- packages/libapache-session-perl/trunk/t/99file.t 2005-10-24 16:43:35 UTC (rev 1441)
+++ packages/libapache-session-perl/trunk/t/99file.t 2005-10-24 16:44:44 UTC (rev 1442)
@@ -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];
-use Apache::Session::File;
+plan skip_all => "Optional module (Fcntl) not installed"
+ unless eval {
+ require Fcntl;
+ };
-my $mydir = int(rand(1000));
-mkdir "./$mydir", 0777;
-chdir $mydir;
+my $origdir = getcwd;
+my $tempdir = tempdir( DIR => '.', CLEANUP => 1 );
+chdir( $tempdir );
-print "1..6\n";
+plan tests => 9;
-my $s = {};
+my $package = 'Apache::Session::File';
+use_ok $package;
-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";
-}
+tie %session, $package, undef, { %tie_params };
-if (exists $s->{_session_id}) {
- print "ok 2\n";
-}
-else {
- print "not ok 2\n";
-}
+ok( tied(%session), "session is tied" );
-my $id = $s->{_session_id};
+ok( exists($session{_session_id}), "session id exists" );
+ok( defined($session{_session_id}), "session id is defined" );
-$s->{foo} = 'bar';
-$s->{baz} = ['tom', 'dick', 'harry'];
+my $id = $session{_session_id};
-untie %$s;
-undef $s;
-$s = {};
+my $foo = 'bar';
+my $baz = [ qw[tom dick harry] ];
-tie %$s, 'Apache::Session::File', $id, {
- Directory => '.',
- LockDirectory => '.'
-};
+$session{foo} = $foo;
+$session{baz} = $baz;
-if (tied %$s) {
- print "ok 3\n";
-}
-else {
- print "not ok 3\n";
-}
+untie %session;
+undef %session;
-if ($s->{_session_id} eq $id) {
- print "ok 4\n";
-}
-else {
- print "not ok 4\n";
-}
+tie %session, $package, $id, { %tie_params };
-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";
-}
+ok( tied(%session), "The session is tied again" );
-tied(%$s)->delete;
-untie %$s;
+is( $session{_session_id}, $id, "Session IDs match" );
-eval {
- tie %$s, 'Apache::Session::File', '../../../../../../../../foo', {
- Directory => '.',
- LockDirectory => '.'
- };
-};
-if ($@) {
- print "ok 6\n";
-}
-else {
- print "not ok 6\n";
- untie %$s
-}
+cmp_deeply $session{foo}, $foo, "Foo matches";
+cmp_deeply $session{baz}, $baz, "Baz matches";
-unlink "./Apache-Session-$id.lock" || die $!;
-chdir "..";
-rmdir $mydir || die $!;
+tied(%session)->delete;
+untie %session;
+undef %session;
+dies_ok {
+ tie %session, $package, '../../../../../../../../foo', { %tie_params };
+} "unsafe tie detected correctly";
+
+chdir( $origdir );
Modified: packages/libapache-session-perl/trunk/t/99filelock.t
===================================================================
--- packages/libapache-session-perl/trunk/t/99filelock.t 2005-10-24 16:43:35 UTC (rev 1441)
+++ packages/libapache-session-perl/trunk/t/99filelock.t 2005-10-24 16:44:44 UTC (rev 1442)
@@ -1,3 +1,9 @@
+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";
@@ -4,52 +10,45 @@
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);
-undef $l;
+ok -e './Apache-Session-foo.lock', 'lock file exists';
+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 );
Modified: packages/libapache-session-perl/trunk/t/99filestore.t
===================================================================
--- packages/libapache-session-perl/trunk/t/99filestore.t 2005-10-24 16:43:35 UTC (rev 1441)
+++ packages/libapache-session-perl/trunk/t/99filestore.t 2005-10-24 16:44:44 UTC (rev 1442)
@@ -1,98 +1,76 @@
-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];
-use Apache::Session::Store::File;
+plan skip_all => "Optional module (Fcntl) not installed"
+ unless eval {
+ require Fcntl;
+ };
-my $mydir = int(rand(1000));
-mkdir "./$mydir", 0777;
-chdir $mydir;
+my $origdir = getcwd;
+my $tempdir = tempdir( DIR => '.', CLEANUP => 1 );
+chdir( $tempdir );
-print "1..6\n";
+plan tests => 7;
-my $session = {serialized => '12345', data => {_session_id => 'test1'}};
+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";
-}
+} "could not materialize nonexistent session";
-unlink "./test1";
-
-chdir "..";
-rmdir $mydir || die $!;
+chdir( $origdir );
Modified: packages/libapache-session-perl/trunk/t/99flex.t
===================================================================
--- packages/libapache-session-perl/trunk/t/99flex.t 2005-10-24 16:43:35 UTC (rev 1441)
+++ packages/libapache-session-perl/trunk/t/99flex.t 2005-10-24 16:44:44 UTC (rev 1442)
@@ -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];
-use Apache::Session::Flex;
+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;
+ };
-print "1..2\n";
+my $origdir = getcwd;
+my $tempdir = tempdir( DIR => '.', CLEANUP => 1 );
+chdir( $tempdir );
-my (%s, $s);
+plan tests => 11;
-$s = tie %s, 'Apache::Session::Flex', undef, {Store => 'File', Lock => 'File', Generate => 'MD5', Serialize => 'Storable'};
+my $package = 'Apache::Session::Flex';
+use_ok $package;
-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";
+{
+ 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';
}
-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 );
Modified: packages/libapache-session-perl/trunk/t/99md5gen.t
===================================================================
--- packages/libapache-session-perl/trunk/t/99md5gen.t 2005-10-24 16:43:35 UTC (rev 1441)
+++ packages/libapache-session-perl/trunk/t/99md5gen.t 2005-10-24 16:44:44 UTC (rev 1442)
@@ -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];
-use Apache::Session::Generate::MD5;
+plan skip_all => "Optional module (Digest::MD5) not installed"
+ unless eval {
+ require Digest::MD5;
+ };
-print "1..36\n";
+my $origdir = getcwd;
+my $tempdir = tempdir( DIR => '.', CLEANUP => 1 );
+chdir( $tempdir );
+plan tests => 33;
+
+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 );
Modified: packages/libapache-session-perl/trunk/t/99moduniqgen.t
===================================================================
--- packages/libapache-session-perl/trunk/t/99moduniqgen.t 2005-10-24 16:43:35 UTC (rev 1441)
+++ packages/libapache-session-perl/trunk/t/99moduniqgen.t 2005-10-24 16:44:44 UTC (rev 1442)
@@ -1,30 +1,29 @@
-use Apache::Session::Generate::ModUniqueId;
+use Test::More;
+use Test::Deep;
+use Test::Exception;
+use File::Temp qw[tempdir];
+use Cwd qw[getcwd];
-print "1..3\n";
+my $origdir = getcwd;
+my $tempdir = tempdir( DIR => '.', CLEANUP => 1 );
+chdir( $tempdir );
+plan tests => 4;
+
+my $package = 'Apache::Session::Generate::ModUniqueId';
+use_ok $package;
+
$ENV{UNIQUE_ID} = '12345678790abcdef';
my $session = {};
Apache::Session::Generate::ModUniqueId::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} eq $ENV{UNIQUE_ID}) {
- print "ok 3\n";
-}
-else {
- print "not ok 3\n";
-}
+is $session->{data}->{_session_id}, $ENV{UNIQUE_ID},
+ 'id matches UNIQUE_ID env param';
+
+chdir( $origdir );
Modified: packages/libapache-session-perl/trunk/t/99mysql.t
===================================================================
--- packages/libapache-session-perl/trunk/t/99mysql.t 2005-10-24 16:43:35 UTC (rev 1441)
+++ packages/libapache-session-perl/trunk/t/99mysql.t 2005-10-24 16:44:44 UTC (rev 1442)
@@ -1,135 +1,104 @@
-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];
-use Apache::Session::MySQL;
-use DBI;
+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};
-print "1..10\n";
+my $origdir = getcwd;
+my $tempdir = tempdir( DIR => '.', CLEANUP => 1 );
+chdir( $tempdir );
-my $s = {};
+plan tests => 13;
-tie %$s, 'Apache::Session::MySQL', undef, {
- DataSource => 'dbi:mysql:sessions',
- UserName => 'test',
- Password => '',
+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";
-}
+ok tied(%{$session}), 'session tied';
-if (exists $s->{_session_id}) {
- print "ok 2\n";
-}
-else {
- print "not ok 2\n";
-}
+ok exists($session->{_session_id}), 'session id exists';
-my $id = $s->{_session_id};
+my $id = $session->{_session_id};
-$s->{foo} = 'bar';
-$s->{baz} = ['tom', 'dick', 'harry'];
+my $foo = $session->{foo} = 'bar';
+my $baz = $session->{baz} = ['tom', 'dick', 'harry'];
-untie %$s;
-undef $s;
-$s = {};
+untie %{$session};
+undef $session;
+$session = {};
-tie %$s, 'Apache::Session::MySQL', $id, {
- DataSource => 'dbi:mysql:sessions',
- UserName => 'test',
- Password => '',
+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";
-}
+ok tied(%{$session}), 'session tied';
-if ($s->{_session_id} eq $id) {
- print "ok 4\n";
-}
-else {
- print "not ok 4\n";
-}
+is $session->{_session_id}, $id, 'id retrieved matches one stored';
-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";
-}
+cmp_deeply $session->{foo}, $foo, "Foo matches";
+cmp_deeply $session->{baz}, $baz, "Baz matches";
-untie %$s;
-undef $s;
-$s = {};
+untie %{$session};
+undef $session;
+$session = {};
-tie %$s, 'Apache::Session::MySQL', undef, {
- DataSource => 'dbi:mysql:sessions',
- UserName => 'test',
- Password => '',
- TableName => 's',
+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";
-}
+ok tied(%{$session}), 'session tied';
-if (exists $s->{_session_id}) {
- print "ok 7\n";
-}
-else {
- print "not ok 7\n";
-}
+ok exists($session->{_session_id}), 'session id exists';
-untie %$s;
-undef $s;
-$s = {};
+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,
+};
-if (tied %$s) {
- print "ok 8\n";
-}
-else {
- print "not ok 8\n";
-}
+ok tied(%{$session}), 'session tied';
-if ($s->{_session_id} eq $id) {
- print "ok 9\n";
-}
-else {
- print "not ok 9\n";
-}
+is $session->{_session_id}, $id, 'id retrieved matches one stored';
-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";
-}
+cmp_deeply $session->{foo}, $foo, "Foo matches";
+cmp_deeply $session->{baz}, $baz, "Baz matches";
-tied(%$s)->delete;
-
+tied(%{$session})->delete;
+untie %{$session};
$dbh->disconnect;
+
+chdir( $origdir );
Modified: packages/libapache-session-perl/trunk/t/99mysqllock.t
===================================================================
--- packages/libapache-session-perl/trunk/t/99mysqllock.t 2005-10-24 16:43:35 UTC (rev 1441)
+++ packages/libapache-session-perl/trunk/t/99mysqllock.t 2005-10-24 16:44:44 UTC (rev 1442)
@@ -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];
-use Apache::Session::Lock::MySQL;
-use DBI;
+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};
-print "1..3\n";
+my $origdir = getcwd;
+my $tempdir = tempdir( DIR => '.', CLEANUP => 1 );
+chdir( $tempdir );
-my $s = {
+plan tests => 4;
+
+my $package = 'Apache::Session::Lock::MySQL';
+use_ok $package;
+
+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";
-}
+$lock->release_write_lock($session);
-$l->release_write_lock($s);
-
$sth->execute();
- at array = $sth->fetchrow_array;
+is +($sth->fetchrow_array)[0], 1, 'could get lock';
-if ($array[0] == 1) {
- print "ok 2\n";
-}
-else {
- print "not ok 2\n";
-}
-
$sth2->execute;
+undef $lock;
-undef $l;
+$session->{args}->{LockHandle} = $dbh;
-$s->{args}->{LockHandle} = $dbh;
+$lock = $package->new;
-$l = new Apache::Session::Lock::MySQL;
+$lock->acquire_read_lock($session);
-$l->acquire_read_lock($s);
-
$sth->execute();
- at array = $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 );
Modified: packages/libapache-session-perl/trunk/t/99mysqlstore.t
===================================================================
--- packages/libapache-session-perl/trunk/t/99mysqlstore.t 2005-10-24 16:43:35 UTC (rev 1441)
+++ packages/libapache-session-perl/trunk/t/99mysqlstore.t 2005-10-24 16:44:44 UTC (rev 1442)
@@ -1,22 +1,28 @@
-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];
-use Apache::Session::Store::MySQL;
-use DBI;
+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};
-use strict;
+my $origdir = getcwd;
+my $tempdir = tempdir( DIR => '.', CLEANUP => 1 );
+chdir( $tempdir );
-print "1..1\n";
+plan tests => 2;
-my $foo = new Apache::Session::Store::MySQL;
+my $package = 'Apache::Session::Store::MySQL';
+use_ok $package;
-if (ref $foo) {
- print "ok 1\n";
-}
-else {
- print "not ok 1\n";
-}
+my $foo = $package->new;
+isa_ok $foo, $package;
+
+chdir( $origdir );
Modified: packages/libapache-session-perl/trunk/t/99nulllock.t
===================================================================
--- packages/libapache-session-perl/trunk/t/99nulllock.t 2005-10-24 16:43:35 UTC (rev 1441)
+++ packages/libapache-session-perl/trunk/t/99nulllock.t 2005-10-24 16:44:44 UTC (rev 1442)
@@ -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;
+undef $lock;
-print "ok 4\n";
-
+chdir( $origdir );
Modified: packages/libapache-session-perl/trunk/t/99oracle.t
===================================================================
--- packages/libapache-session-perl/trunk/t/99oracle.t 2005-10-24 16:43:35 UTC (rev 1441)
+++ packages/libapache-session-perl/trunk/t/99oracle.t 2005-10-24 16:44:44 UTC (rev 1442)
@@ -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];
-use Apache::Session::Oracle;
+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};
-print "1..10\n";
+my $origdir = getcwd;
+my $tempdir = tempdir( DIR => '.', CLEANUP => 1 );
+chdir( $tempdir );
-my $s = {};
+plan tests => 13;
-tie %$s, 'Apache::Session::Oracle', undef, {
+my $package = 'Apache::Session::Oracle';
+use_ok $package;
+
+my $session = {};
+
+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";
-}
+ok tied(%{$session}), 'session tied';
-if (exists $s->{_session_id}) {
- print "ok 2\n";
-}
-else {
- print "not ok 2\n";
-}
+ok exists($session->{_session_id}), 'session id exists';
-my $id = $s->{_session_id};
+my $id = $session->{_session_id};
-$s->{foo} = 'bar';
-$s->{baz} = ['tom', 'dick', 'harry'];
+my $foo = $session->{foo} = 'bar';
+my $baz = $session->{baz} = ['tom', 'dick', 'harry'];
-untie %$s;
-undef $s;
-$s = {};
+untie %{$session};
+undef $session;
+$session = {};
-tie %$s, 'Apache::Session::Oracle', $id, {
+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";
-}
+ok tied(%{$session}), 'session tied';
-if ($s->{_session_id} eq $id) {
- print "ok 4\n";
-}
-else {
- print "not ok 4\n";
-}
+is $session->{_session_id}, $id, 'id retrieved matches one stored';
-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";
-}
+cmp_deeply $session->{foo}, $foo, "Foo matches";
+cmp_deeply $session->{baz}, $baz, "Baz matches";
-$s->{long} = 'A'x(10*2**10);
+$session->{long} = 'A'x(10*2**10);
-untie %$s;
-undef $s;
-$s = {};
+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,
+};
-if (tied %$s) {
- print "ok 6\n";
-}
-else {
- print "not ok 6\n";
-}
+ok tied(%{$session}), 'session tied';
-if ($s->{long} eq 'A'x(10*2**10)) {
- print "ok 7\n";
-}
-else {
- print "not ok 7\n";
-}
+is $session->{long}, 'A'x(10*2**10), 'long read worked';
-delete $s->{long};
+delete $session->{long};
-untie %$s;
-undef $s;
-$s = {};
+untie %{$session};
+undef $session;
+$session = {};
-tie %$s, 'Apache::Session::Oracle', $id, {Handle => $dbh, Commit => 0};
+tie %{$session}, $package, $id, {
+ Handle => $dbh,
+ Commit => 0,
+};
-if (tied %$s) {
- print "ok 8\n";
-}
-else {
- print "not ok 8\n";
-}
+ok tied(%{$session}), 'session tied';
-if ($s->{_session_id} eq $id) {
- print "ok 9\n";
-}
-else {
- print "not ok 9\n";
-}
+is $session->{_session_id}, $id, 'id retrieved matches one stored';
-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";
-}
+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 );
Modified: packages/libapache-session-perl/trunk/t/99postgres.t
===================================================================
--- packages/libapache-session-perl/trunk/t/99postgres.t 2005-10-24 16:43:35 UTC (rev 1441)
+++ packages/libapache-session-perl/trunk/t/99postgres.t 2005-10-24 16:44:44 UTC (rev 1442)
@@ -1,129 +1,101 @@
-eval {require DBI; require DBD::Pg;};
-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];
-use Apache::Session::Postgres;
+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};
-print "1..10\n";
+my $origdir = getcwd;
+my $tempdir = tempdir( DIR => '.', CLEANUP => 1 );
+chdir( $tempdir );
-my $s = {};
+plan tests => 13;
-tie %$s, 'Apache::Session::Postgres', undef, {
- DataSource => 'dbi:Pg:dbname=sessions',
- UserName => 'postgres',
- Password => '',
- Commit => 1
+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";
-}
+ok tied(%{$session}), 'session tied';
-if (exists $s->{_session_id}) {
- print "ok 2\n";
-}
-else {
- print "not ok 2\n";
-}
+ok exists($session->{_session_id}), 'session id exists';
-my $id = $s->{_session_id};
+my $id = $session->{_session_id};
-$s->{foo} = 'bar';
-$s->{baz} = ['tom', 'dick', 'harry'];
+my $foo = $session->{foo} = 'bar';
+my $baz = $session->{baz} = ['tom', 'dick', 'harry'];
-untie %$s;
-undef $s;
-$s = {};
+untie %{$session};
+undef $session;
+$session = {};
-tie %$s, 'Apache::Session::Postgres', $id, {
- DataSource => 'dbi:Pg:dbname=sessions',
- UserName => 'postgres',
- Password => '',
+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";
-}
+ok tied(%{$session}), 'session tied';
-if ($s->{_session_id} eq $id) {
- print "ok 4\n";
-}
-else {
- print "not ok 4\n";
-}
+is $session->{_session_id}, $id, 'id retrieved matches one stored';
-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";
-}
+cmp_deeply $session->{foo}, $foo, "Foo matches";
+cmp_deeply $session->{baz}, $baz, "Baz matches";
-untie %$s;
-undef $s;
-$s = {};
+untie %{$session};
+undef $session;
+$session = {};
-tie %$s, 'Apache::Session::Postgres', undef, {
- DataSource => 'dbi:Pg:dbname=sessions',
- UserName => 'postgres',
- Password => '',
+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";
-}
+ok tied(%{$session}), 'session tied';
-if (exists($s->{_session_id})) {
- print "ok 7\n";
-}
-else {
- print "not ok 7\n";
-}
+ok exists($session->{_session_id}), 'session id exists';
-untie %$s;
-undef $s;
-$s = {};
+untie %{$session};
+undef $session;
+$session = {};
-my $dbh = DBI->connect('dbi:Pg:dbname=sessions', 'postgres', '', {RaiseError => 1, AutoCommit => 0});
+my $dbh = DBI->connect("dbi:Pg:dbname=$dbname", $user, $pass, {RaiseError => 1, AutoCommit => 0});
-tie %$s, 'Apache::Session::Postgres', $id, {Handle => $dbh, Commit => 0};
+tie %{$session}, $package, $id, {
+ Handle => $dbh,
+ Commit => 0,
+};
-if (tied %$s) {
- print "ok 8\n";
-}
-else {
- print "not ok 8\n";
-}
+ok tied(%{$session}), 'session tied';
-if ($s->{_session_id} eq $id) {
- print "ok 9\n";
-}
-else {
- print "not ok 9\n";
-}
+is $session->{_session_id}, $id, 'id retrieved matches one stored';
-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";
-}
+cmp_deeply $session->{foo}, $foo, "Foo matches";
+cmp_deeply $session->{baz}, $baz, "Baz matches";
-tied(%$s)->delete;
-
+tied(%{$session})->delete;
+untie %{$session};
$dbh->commit;
$dbh->disconnect;
+
+chdir( $origdir );
Modified: packages/libapache-session-perl/trunk/t/99semaphore.t
===================================================================
--- packages/libapache-session-perl/trunk/t/99semaphore.t 2005-10-24 16:43:35 UTC (rev 1441)
+++ packages/libapache-session-perl/trunk/t/99semaphore.t 2005-10-24 16:44:44 UTC (rev 1442)
@@ -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];
-use Apache::Session::Lock::Semaphore;
+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;
+
+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;
+my $number = 1;
+for my $iter (2,4,6,8) {
+ $session->{args}->{NSems} = $iter;
+ my $locker = $package->new($session);
+
+ isa_ok $locker, $package;
-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++;
-
$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);
- if (ref $sem) {
- print "ok $n\n";
- }
- else {
- print "not ok $n\n";
- exit;
- }
- $n++;
-
+ isa_ok $sem, 'IPC::Semaphore';
+
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 );
Modified: packages/libapache-session-perl/trunk/t/99storable.t
===================================================================
--- packages/libapache-session-perl/trunk/t/99storable.t 2005-10-24 16:43:35 UTC (rev 1441)
+++ packages/libapache-session-perl/trunk/t/99storable.t 2005-10-24 16:44:44 UTC (rev 1442)
@@ -1,35 +1,46 @@
-eval {require Storable;};
-if ($@) {
- print "1..0\n";
- exit;
-}
+use Test::More;
+use Test::Deep;
+use Test::Exception;
+use File::Temp qw[tempdir];
+use Cwd qw[getcwd];
-use Apache::Session::Serialize::Storable;
+plan skip_all => "Optional module (Storable) not installed"
+ unless eval {
+ require Storable;
+ };
-print "1..1\n";
+my $origdir = getcwd;
+my $tempdir = tempdir( DIR => '.', CLEANUP => 1 );
+chdir( $tempdir );
-my $s = \&Apache::Session::Serialize::Storable::serialize;
-my $u = \&Apache::Session::Serialize::Storable::unserialize;
+plan tests => 2;
-my $session = {serialized => undef, data => undef};
-my $simple = {foo => 1, bar => 2, baz => 'quux', quux => ['foo', 'bar']};
+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);
-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($simple, $session->{data}, 'session data is correct');
+
+chdir( $origdir );
Modified: packages/libapache-session-perl/trunk/t/99uue.t
===================================================================
--- packages/libapache-session-perl/trunk/t/99uue.t 2005-10-24 16:43:35 UTC (rev 1441)
+++ packages/libapache-session-perl/trunk/t/99uue.t 2005-10-24 16:44:44 UTC (rev 1442)
@@ -1,35 +1,45 @@
-eval {require Storable;};
-if ($@) {
- print "1..0\n";
- exit;
-}
+use Test::More;
+use Test::Deep;
+use Test::Exception;
+use File::Temp qw[tempdir];
+use Cwd qw[getcwd];
-use Apache::Session::Serialize::UUEncode;
+plan skip_all => "Optional module (Storable) not installed"
+ unless eval {
+ require Storable;
+ };
-print "1..1\n";
+my $origdir = getcwd;
+my $tempdir = tempdir( DIR => '.', CLEANUP => 1 );
+chdir( $tempdir );
-my $s = \&Apache::Session::Serialize::UUEncode::serialize;
-my $u = \&Apache::Session::Serialize::UUEncode::unserialize;
+plan tests => 2;
-my $session = {serialized => undef, data => undef};
-my $simple = {foo => 1, bar => 2, baz => 'quux', quux => ['foo', 'bar']};
+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);
-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($simple, $session->{data}, 'session data is correct');
+
+chdir( $origdir );
More information about the Pkg-perl-cvs-commits
mailing list