license => 'perl',
module_name => 'Catalyst::Plugin::Session',
requires => {
- 'perl' => '5.8.1',
- 'Catalyst' => '5.50',
+ 'perl' => '5.8.1',
+ 'Catalyst' => '5.50',
},
- reccomends => {
- # for live_app.t
- 'Test::WWW::Mechanize::Catalyst' => 0,
- 'Catalyst::Plugin::Session::Cookie' => 0,
- },
- create_readme => 1,
- sign => 1,
+ reccomends => {
+
+ # for live_app.t
+ 'Test::WWW::Mechanize::Catalyst' => 0,
+ 'Catalyst::Plugin::Session::Cookie' => 0,
+ },
+ create_readme => 1,
+ sign => 1,
);
$build->create_build_script;
=head1 SYNOPSIS
- package Catalyst::Plugin::Session::State::MyBackend;
- use base qw/Catalyst::Plugin::Session::State/;
+ package Catalyst::Plugin::Session::State::MyBackend;
+ use base qw/Catalyst::Plugin::Session::State/;
=head1 DESCRIPTION
=head1 SYNOPSIS
- package Catalyst::Plugin::Session::Store::MyBackend;
- use base qw/Catalyst::Plugin::Session::Store/;
+ package Catalyst::Plugin::Session::Store::MyBackend;
+ use base qw/Catalyst::Plugin::Session::Store/;
=head1 DESCRIPTION
use Catalyst ();
sub import {
- shift;
- my %args = @_;
+ shift;
+ my %args = @_;
- my $backend = $args{backend};
- my $cfg = $args{config};
+ my $backend = $args{backend};
+ my $cfg = $args{config};
- my $p = "Session::Store::$backend";
- use_ok(my $m = "Catalyst::Plugin::$p");
+ my $p = "Session::Store::$backend";
+ use_ok( my $m = "Catalyst::Plugin::$p" );
- isa_ok(bless({}, $m), "Catalyst::Plugin::Session::Store");
+ isa_ok( bless( {}, $m ), "Catalyst::Plugin::Session::Store" );
- our $restored_session_id;
+ our $restored_session_id;
- {
- package SessionStoreTest;
- use Catalyst qw/-Engine=Test Session Session::State/;
- push our(@ISA), $m;
+ {
- our $VERSION = "0.01";
+ package SessionStoreTest;
+ use Catalyst qw/-Engine=Test Session Session::State/;
+ push our (@ISA), $m;
- use Test::More;
+ our $VERSION = "0.01";
- sub prepare_cookies {
- my $c = shift;
- $c->sessionid($restored_session_id) if defined $restored_session_id;
- $c->NEXT::prepare_cookies(@_);
- }
+ use Test::More;
- sub create_session : Global {
- my ( $self, $c ) = @_;
- ok(!$c->sessionid, "no session id yet");
- ok($c->session, "session created");
- ok($c->sessionid, "with a session id");
+ sub prepare_cookies {
+ my $c = shift;
+ $c->sessionid($restored_session_id) if defined $restored_session_id;
+ $c->NEXT::prepare_cookies(@_);
+ }
- $restored_session_id = $c->sessionid;
+ sub create_session : Global {
+ my ( $self, $c ) = @_;
+ ok( !$c->sessionid, "no session id yet" );
+ ok( $c->session, "session created" );
+ ok( $c->sessionid, "with a session id" );
- $c->session->{magic} = "møøse";
- }
+ $restored_session_id = $c->sessionid;
- sub recover_session : Global {
- my ( $self, $c ) = @_;
- ok($c->sessionid, "session id exists");
- is($c->sessionid, $restored_session_id, "and is the one we saved in the last action");
- ok($c->session, "a session exists");
- is($c->session->{magic}, "møøse", "and it contains what we put in on the last attempt");
- $c->delete_session("user logout");
- $restored_session_id = undef;
- }
+ $c->session->{magic} = "møøse";
+ }
- sub after_session : Global {
- my ( $self, $c ) = @_;
- ok(!$c->sessionid, "no session id");
- ok(!$c->session->{magic}, "session data not restored");
- ok(!$c->session_delete_reason, "no reason for deletion");
- }
+ sub recover_session : Global {
+ my ( $self, $c ) = @_;
+ ok( $c->sessionid, "session id exists" );
+ is( $c->sessionid, $restored_session_id,
+ "and is the one we saved in the last action" );
+ ok( $c->session, "a session exists" );
+ is( $c->session->{magic},
+ "møøse",
+ "and it contains what we put in on the last attempt" );
+ $c->delete_session("user logout");
+ $restored_session_id = undef;
+ }
- @{ __PACKAGE__->config->{session} }{ keys %$cfg } = values %$cfg;
-
- __PACKAGE__->setup;
- }
+ sub after_session : Global {
+ my ( $self, $c ) = @_;
+ ok( !$c->sessionid, "no session id" );
+ ok( !$c->session->{magic}, "session data not restored" );
+ ok( !$c->session_delete_reason, "no reason for deletion" );
+ }
- {
- package SessionStoreTest2;
- use Catalyst qw/-Engine=Test Session Session::State/;
- push our(@ISA), $m;
+ @{ __PACKAGE__->config->{session} }{ keys %$cfg } = values %$cfg;
- our $VERSION = "123";
+ __PACKAGE__->setup;
+ }
- use Test::More;
+ {
- sub prepare_cookies {
- my $c = shift;
- $c->sessionid($restored_session_id) if defined $restored_session_id;
- $c->NEXT::prepare_cookies(@_);
- }
+ package SessionStoreTest2;
+ use Catalyst qw/-Engine=Test Session Session::State/;
+ push our (@ISA), $m;
- sub create_session : Global {
- my ( $self, $c ) = @_;
+ our $VERSION = "123";
- $c->session->{magic} = "møøse";
+ use Test::More;
- $restored_session_id = $c->sessionid;
- }
+ sub prepare_cookies {
+ my $c = shift;
+ $c->sessionid($restored_session_id) if defined $restored_session_id;
+ $c->NEXT::prepare_cookies(@_);
+ }
- sub recover_session : Global {
- my ( $self, $c ) = @_;
+ sub create_session : Global {
+ my ( $self, $c ) = @_;
- ok(!$c->sessionid, "no session id");
+ $c->session->{magic} = "møøse";
- is($c->session_delete_reason, "session expired", "reason is that the session expired");
+ $restored_session_id = $c->sessionid;
+ }
- ok(!$c->session->{magic}, "no saved data");
- }
+ sub recover_session : Global {
+ my ( $self, $c ) = @_;
- __PACKAGE__->config->{session}{expires} = 0;
+ ok( !$c->sessionid, "no session id" );
- @{ __PACKAGE__->config->{session} }{ keys %$cfg } = values %$cfg;
+ is(
+ $c->session_delete_reason,
+ "session expired",
+ "reason is that the session expired"
+ );
- __PACKAGE__->setup;
- }
+ ok( !$c->session->{magic}, "no saved data" );
+ }
- use Test::More;
+ __PACKAGE__->config->{session}{expires} = 0;
- can_ok($m, "get_session_data");
- can_ok($m, "store_session_data");
- can_ok($m, "delete_session_data");
- can_ok($m, "delete_expired_sessions");
+ @{ __PACKAGE__->config->{session} }{ keys %$cfg } = values %$cfg;
- {
- package t1;
- use Catalyst::Test "SessionStoreTest";
+ __PACKAGE__->setup;
+ }
- get("/create_session");
- get("/recover_session");
- get("/after_session");
- }
+ use Test::More;
- {
- package t2;
- use Catalyst::Test "SessionStoreTest2";
+ can_ok( $m, "get_session_data" );
+ can_ok( $m, "store_session_data" );
+ can_ok( $m, "delete_session_data" );
+ can_ok( $m, "delete_expired_sessions" );
- get("/create_session");
- sleep 1; # let the session expire
- get("/recover_session");
- }
+ {
+
+ package t1;
+ use Catalyst::Test "SessionStoreTest";
+
+ get("/create_session");
+ get("/recover_session");
+ get("/after_session");
+ }
+
+ {
+
+ package t2;
+ use Catalyst::Test "SessionStoreTest2";
+
+ get("/create_session");
+ sleep 1; # let the session expire
+ get("/recover_session");
+ }
}
__PACKAGE__;
=head1 SYNOPSIS
- #!/usr/bin/perl
+ #!/usr/bin/perl
- use Catalyst::Plugin::Session::Test::Store (
- backend => "FastMmap",
- config => {
- storage => "/tmp/foo",
- },
- );
+ use Catalyst::Plugin::Session::Test::Store (
+ backend => "FastMmap",
+ config => {
+ storage => "/tmp/foo",
+ },
+ );
=head1 DESCRIPTION
use Test::MockObject;
use Test::Deep;
-my $m; BEGIN { use_ok($m = "Catalyst::Plugin::Session") }
+my $m;
+BEGIN { use_ok( $m = "Catalyst::Plugin::Session" ) }
my %config;
-my $log = Test::MockObject->new;
+my $log = Test::MockObject->new;
my @mock_isa = ();
$log->set_true("fatal");
{
- package MockCxt;
- use base $m;
- sub new { bless {}, $_[0] }
- sub config { \%config };
- sub log { $log }
- sub isa {
- my $self = shift;
- my $class = shift;
- grep { $_ eq $class } @mock_isa or $self->SUPER::isa($class);
- }
+
+ package MockCxt;
+ use base $m;
+ sub new { bless {}, $_[0] }
+ sub config { \%config }
+ sub log { $log }
+
+ sub isa {
+ my $self = shift;
+ my $class = shift;
+ grep { $_ eq $class } @mock_isa or $self->SUPER::isa($class);
+ }
}
-can_ok($m, "setup");
+can_ok( $m, "setup" );
-eval { MockCxt->new->setup }; # throws OK is not working with NEXT
-like($@, qr/requires.*((?:State|Store).*){2}/i, "can't setup an object that doesn't use state/store plugins");
+eval { MockCxt->new->setup }; # throws OK is not working with NEXT
+like(
+ $@,
+ qr/requires.*((?:State|Store).*){2}/i,
+ "can't setup an object that doesn't use state/store plugins"
+);
-$log->called_ok("fatal", "fatal error logged");
+$log->called_ok( "fatal", "fatal error logged" );
@mock_isa = qw/Catalyst::Plugin::Session::State/;
eval { MockCxt->new->setup };
-like($@, qr/requires.*(?:Store)/i, "can't setup an object that doesn't use state/store plugins");
+like( $@, qr/requires.*(?:Store)/i,
+ "can't setup an object that doesn't use state/store plugins" );
@mock_isa = qw/Catalyst::Plugin::Session::Store/;
eval { MockCxt->new->setup };
-like($@, qr/requires.*(?:State)/i, "can't setup an object that doesn't use state/store plugins");
+like( $@, qr/requires.*(?:State)/i,
+ "can't setup an object that doesn't use state/store plugins" );
$log->clear;
-@mock_isa = qw/Catalyst::Plugin::Session::State Catalyst::Plugin::Session::Store/;
+@mock_isa =
+ qw/Catalyst::Plugin::Session::State Catalyst::Plugin::Session::Store/;
eval { MockCxt->new->setup };
-ok(!$@, "setup() lives with state/store plugins in use");
-ok(!$log->called("fatal"), "no fatal error logged either");
+ok( !$@, "setup() lives with state/store plugins in use" );
+ok( !$log->called("fatal"), "no fatal error logged either" );
cmp_deeply(
- [ keys %{ $config{session} } ],
- bag(qw/expires verify_address/),
- "default values for config were populated in successful setup",
+ [ keys %{ $config{session} } ],
+ bag(qw/expires verify_address/),
+ "default values for config were populated in successful setup",
);
-%config = (session => { expires => 1234 });
+%config = ( session => { expires => 1234 } );
MockCxt->new->setup;
-is($config{session}{expires}, 1234, "user values are not overwritten in config");
+is( $config{session}{expires},
+ 1234, "user values are not overwritten in config" );
use Test::MockObject;
use Test::Deep;
-my $m; BEGIN { use_ok($m = "Catalyst::Plugin::Session") }
+my $m;
+BEGIN { use_ok( $m = "Catalyst::Plugin::Session" ) }
my %config;
-my $log = Test::MockObject->new;
-my $req = Test::MockObject->new;
+my $log = Test::MockObject->new;
+my $req = Test::MockObject->new;
my @mock_isa = ();
my %session;
$log->set_true(qw/fatal warn/);
-$req->set_always(address => "127.0.0.1");
+$req->set_always( address => "127.0.0.1" );
{
- package MockCxt;
- use base $m;
- sub new { bless {}, $_[0] }
- sub config { \%config };
- sub log { $log }
- sub request { $req }
- sub debug { 0 }
- sub isa { 1 } # subvert the plugin tests, we're faking them
- sub get_session_data { \%session }
- sub store_session_data { }
- sub delete_session_data { }
+
+ package MockCxt;
+ use base $m;
+ sub new { bless {}, $_[0] }
+ sub config { \%config }
+ sub log { $log }
+ sub request { $req }
+ sub debug { 0 }
+ sub isa { 1 } # subvert the plugin tests, we're faking them
+ sub get_session_data { \%session }
+ sub store_session_data { }
+ sub delete_session_data { }
}
{
- my $c = MockCxt->new;
- $c->setup;
+ my $c = MockCxt->new;
+ $c->setup;
- $c->prepare_action;
- ok(!$c->{session}, "without a session ID prepare doesn't load a session");
+ $c->prepare_action;
+ ok( !$c->{session}, "without a session ID prepare doesn't load a session" );
}
{
- %config = (session => { expires => 100 });
+ %config = ( session => { expires => 100 } );
- %session = (
- __expires => time() + 1000,
- __created => time(),
- __updated => time(),
- __address => "127.0.0.1",
- );
+ %session = (
+ __expires => time() + 1000,
+ __created => time(),
+ __updated => time(),
+ __address => "127.0.0.1",
+ );
- my $c = MockCxt->new;
- $c->setup;
+ my $c = MockCxt->new;
+ $c->setup;
- $c->sessionid("the_session");
- $c->prepare_action;
+ $c->sessionid("the_session");
+ $c->prepare_action;
- ok($c->{session}, 'session "restored" with session id');
+ ok( $c->{session}, 'session "restored" with session id' );
}
{
- %session = (
- __expires => time() - 100, # a while ago
- __created => time() - 1000,
- __udpated => time() - 1000,
- __address => "127.0.0.1",
- );
-
- my $c = MockCxt->new;
- $c->setup;
-
- $c->sessionid("the_session");
- $c->prepare_action;
-
- ok(!$c->{session}, "expired sessions are deleted");
- like($c->session_delete_reason, qr/expire/i, "with appropriate reason");
- ok(!$c->sessionid, "sessionid is also cleared");
+ %session = (
+ __expires => time() - 100, # a while ago
+ __created => time() - 1000,
+ __udpated => time() - 1000,
+ __address => "127.0.0.1",
+ );
+
+ my $c = MockCxt->new;
+ $c->setup;
+
+ $c->sessionid("the_session");
+ $c->prepare_action;
+
+ ok( !$c->{session}, "expired sessions are deleted" );
+ like( $c->session_delete_reason, qr/expire/i, "with appropriate reason" );
+ ok( !$c->sessionid, "sessionid is also cleared" );
}
{
- %session = (
- __expires => time() + 1000,
- __created => time(),
- __updated => time(),
- __address => "unlocalhost",
- );
-
- my $c = MockCxt->new;
- $c->setup;
-
- $c->sessionid("the_session");
- $c->prepare_action;
-
- ok(!$c->{session}, "hijacked sessions are deleted");
- like($c->session_delete_reason, qr/mismatch/, "with appropriate reason");
- ok(!$c->sessionid, "sessionid is also cleared");
+ %session = (
+ __expires => time() + 1000,
+ __created => time(),
+ __updated => time(),
+ __address => "unlocalhost",
+ );
+
+ my $c = MockCxt->new;
+ $c->setup;
+
+ $c->sessionid("the_session");
+ $c->prepare_action;
+
+ ok( !$c->{session}, "hijacked sessions are deleted" );
+ like( $c->session_delete_reason, qr/mismatch/, "with appropriate reason" );
+ ok( !$c->sessionid, "sessionid is also cleared" );
}
{
- %session = (
- __expires => time() + 1000,
- __created => time(),
- __updated => time(),
- __address => "unlocalhost",
- );
+ %session = (
+ __expires => time() + 1000,
+ __created => time(),
+ __updated => time(),
+ __address => "unlocalhost",
+ );
- $config{session}{verify_address} = 0;
+ $config{session}{verify_address} = 0;
- my $c = MockCxt->new;
- $c->setup;
+ my $c = MockCxt->new;
+ $c->setup;
- $c->sessionid("the_session");
- $c->prepare_action;
+ $c->sessionid("the_session");
+ $c->prepare_action;
- ok($c->{session}, "address mismatch is OK if verify_address is disabled");
+ ok( $c->{session}, "address mismatch is OK if verify_address is disabled" );
}
{
- %session = ();
- %config = ();
-
- my $now = time;
-
- my $c = MockCxt->new;
- $c->setup;
- $c->prepare_action;
-
- ok($c->session, "creating a session works");
- ok($c->sessionid, "session id generated");
-
- cmp_ok($c->session->{__created}, ">=", $now, "__created time is logical");
- cmp_ok($c->session->{__updated}, ">=", $now, "__updated time is logical");
- cmp_ok($c->session->{__expires}, ">=", ($now + $config{session}{expires}), "__expires time is logical");
- is($c->session->{__address}, $c->request->address, "address is also correct");
-
- cmp_deeply(
- [ keys %{ $c->{session} } ],
- bag(qw/__expires __created __updated __address/),
- "initial keys in session are all there",
- );
+ %session = ();
+ %config = ();
+
+ my $now = time;
+
+ my $c = MockCxt->new;
+ $c->setup;
+ $c->prepare_action;
+
+ ok( $c->session, "creating a session works" );
+ ok( $c->sessionid, "session id generated" );
+
+ cmp_ok( $c->session->{__created}, ">=", $now, "__created time is logical" );
+ cmp_ok( $c->session->{__updated}, ">=", $now, "__updated time is logical" );
+ cmp_ok(
+ $c->session->{__expires},
+ ">=",
+ ( $now + $config{session}{expires} ),
+ "__expires time is logical"
+ );
+ is( $c->session->{__address},
+ $c->request->address, "address is also correct" );
+
+ cmp_deeply(
+ [ keys %{ $c->{session} } ],
+ bag(qw/__expires __created __updated __address/),
+ "initial keys in session are all there",
+ );
}
-
-
{
- %session = (
- __expires => time() + 1000,
- __created => time(),
- __updated => time(),
- __address => "127.0.0.1",
- );
+ %session = (
+ __expires => time() + 1000,
+ __created => time(),
+ __updated => time(),
+ __address => "127.0.0.1",
+ );
+
+ $config{session}{expires} = 2000;
- $config{session}{expires} = 2000;
+ my $c = MockCxt->new;
+ $c->setup;
- my $c = MockCxt->new;
- $c->setup;
+ my $now = time();
- my $now = time();
-
- $c->sessionid("the_session");
- $c->prepare_action;
- $c->finalize;
+ $c->sessionid("the_session");
+ $c->prepare_action;
+ $c->finalize;
- ok($c->{session}, "session is still alive after 1/2 expired and finalized");
+ ok( $c->{session},
+ "session is still alive after 1/2 expired and finalized" );
- cmp_ok($c->session->{__expires}, ">=", $now + 2000, "session expires time extended");
+ cmp_ok(
+ $c->session->{__expires},
+ ">=",
+ $now + 2000,
+ "session expires time extended"
+ );
}
--- /dev/null
+use Test::More;
+
+eval "use Test::Pod 1.14";
+plan skip_all => 'Test::Pod 1.14 required' if $@;
+plan skip_all => 'set TEST_POD to enable this test' unless $ENV{TEST_POD};
+
+all_pod_files_ok();
--- /dev/null
+use Test::More;
+
+eval "use Test::Pod::Coverage 1.04";
+plan skip_all => 'Test::Pod::Coverage 1.04 required' if $@;
+plan skip_all => 'set TEST_POD to enable this test' unless $ENV{TEST_POD};
+
+all_pod_coverage_ok();
=head1 SYNOPSIS
- use Catalyst::Plugin::Session::Store::Dummy;
+ use Catalyst::Plugin::Session::Store::Dummy;
=head1 DESCRIPTION
my ( $self, $c ) = @_;
if ( $c->sessionid ) {
$c->res->output("you are logged in");
- $c->session->{counter}++;
+ $c->session->{counter}++;
}
else {
$c->res->output("please login");
eval { require Test::WWW::Mechanize::Catalyst }
or plan skip_all =>
"Test::WWW::Mechanize::Catalyst is required for this test";
-
+
plan tests => 30;
}
my $ua1 = Test::WWW::Mechanize::Catalyst->new;
my $ua2 = Test::WWW::Mechanize::Catalyst->new;
-$_->get_ok("http://localhost/page", "initial get") for $ua1, $ua2;
+$_->get_ok( "http://localhost/page", "initial get" ) for $ua1, $ua2;
$ua1->content_contains( "please login", "ua1 not logged in" );
$ua2->content_contains( "please login", "ua2 not logged in" );
-$ua1->get_ok("http://localhost/login", "log ua1 in");
+$ua1->get_ok( "http://localhost/login", "log ua1 in" );
$ua1->content_contains( "logged in", "ua1 logged in" );
-$_->get_ok("http://localhost/page", "get main page") for $ua1, $ua2;
+$_->get_ok( "http://localhost/page", "get main page" ) for $ua1, $ua2;
$ua1->content_contains( "you are logged in", "ua1 logged in" );
$ua2->content_contains( "please login", "ua2 not logged in" );
-$ua2->get_ok("http://localhost/login", "get main page");
+$ua2->get_ok( "http://localhost/login", "get main page" );
$ua2->content_contains( "logged in", "log ua2 in" );
-$_->get_ok("http://localhost/page", "get main page") for $ua1, $ua2;
+$_->get_ok( "http://localhost/page", "get main page" ) for $ua1, $ua2;
$ua1->content_contains( "you are logged in", "ua1 logged in" );
$ua2->content_contains( "you are logged in", "ua2 logged in" );
-$ua2->get_ok("http://localhost/logout", "log ua2 out");
+$ua2->get_ok( "http://localhost/logout", "log ua2 out" );
$ua2->content_like( qr/logged out/, "ua2 logged out" );
-$ua2->content_like( qr/after 1 request/, "ua2 made 1 request for page in the session" );
+$ua2->content_like( qr/after 1 request/,
+ "ua2 made 1 request for page in the session" );
-$_->get_ok("http://localhost/page", "get main page") for $ua1, $ua2;
+$_->get_ok( "http://localhost/page", "get main page" ) for $ua1, $ua2;
$ua1->content_contains( "you are logged in", "ua1 logged in" );
$ua2->content_contains( "please login", "ua2 not logged in" );
-$ua1->get_ok("http://localhost/logout", "log ua1 out");
+$ua1->get_ok( "http://localhost/logout", "log ua1 out" );
$ua1->content_like( qr/logged out/, "ua1 logged out" );
-$ua1->content_like( qr/after 3 requests/, "ua1 made 3 request for page in the session" );
+$ua1->content_like( qr/after 3 requests/,
+ "ua1 made 3 request for page in the session" );
-$_->get_ok("http://localhost/page", "get main page") for $ua1, $ua2;
+$_->get_ok( "http://localhost/page", "get main page" ) for $ua1, $ua2;
$ua1->content_contains( "please login", "ua1 not logged in" );
$ua2->content_contains( "please login", "ua2 not logged in" );
-
projects / catagits/Catalyst-Plugin-Session.git / commitdiff