use strict; use warnings FATAL => 'all'; use Test::More tests => 25; use CGI::Cookie; use Package::Alias 'Apache2::Cookie' => 'CGI::Cookie' , 'Apache2::Const::OK' => sub { 200; }; use_ok('Apache::SWIT::Session'); use Data::Dumper; use Storable qw(thaw); package Obj; sub retrieve { return bless({}, shift()); } sub id { return 17; } sub value { return "hi"; } package MySession; use base 'Apache::SWIT::Session'; __PACKAGE__->add_var('hello'); __PACKAGE__->add_var('bye', depends_on => [ 'hello' ]); __PACKAGE__->add_var('bye_bye', depends_on => [ 'bye' ]); __PACKAGE__->add_var('infdef', depends_on => [ 'bye' ], inflate => sub { shift() . '_foooooo'; }, deflate => sub { $_[0] =~ s/_foooooo//; return $_[0]; }); __PACKAGE__->add_class_dbi_var('obj', 'Obj'); package main; HTML::Tested::Seal->instance('aaa'); my $s = MySession->new(_stash => { hello => 'world' }); is($s->get_hello, 'world'); is($s->delete_hello, 'world'); is_deeply($s->{_stash}, {}); $s->set_hello('life'); is_deeply($s->{_stash}, { hello => 'life' }); $s->set_bye('world'); is_deeply($s->{_stash}, { hello => 'life', bye => 'world' }); $s->set_hello('planet'); is_deeply($s->{_stash}, { hello => 'planet' }); $s->set_bye('world'); $s->set_bye_bye('earth'); is_deeply($s->{_stash}, { hello => 'planet', bye => 'world', bye_bye => 'earth', }); is($s->delete_hello, 'planet'); is_deeply($s->{_stash}, {}); $s->set_hello('planet'); $s->set_bye('world'); $s->set_infdef('defme_foooooo'); $s->set_obj(Obj->retrieve); is_deeply($s->{_stash}, { hello => 'planet', bye => 'world', infdef => 'defme_foooooo', obj => {} }); is($s->get_infdef, 'defme_foooooo'); $s->write_stash; isnt($s->session_value, undef); unlike($s->session_value, qr/[^\w]/); eval { thaw($s->session_value); }; isnt($@, ''); my $s2 = MySession->new(session_value => $s->session_value); is($s2->session_value, $s->session_value); is_deeply($s->_thaw, { hello => 'planet', bye => 'world', infdef => 'defme', obj => '17' }); $s->{_stash} = {}; is($s->get_obj, undef); is($s->get_infdef, undef); $s->read_stash; is($s->get_infdef, 'defme_foooooo'); isa_ok($s->get_obj, 'Obj'); is($s->get_obj->value, "hi"); my @msg = map { rand(1023) } 1 .. 5000; $s->set_bye_bye([ @msg ]); is_deeply($s->get_bye_bye, \@msg); $s->write_stash; my %stash = %{ $s->{_stash} }; $s->read_stash; is_deeply($s->{_stash}, \%stash) or diag(Dumper($s->{_stash})); my @children; for my $i (1 .. 5) { my $pid = fork; if ($pid) { push @children, $pid; next; } else { for (1 .. 10) { $s->read_stash; $s->write_stash; $s->read_stash; } exit; } } waitpid($_, 0) for @children; $s->read_stash; is_deeply($s->{_stash}, \%stash) or diag(Dumper($s->{_stash}));