#!perl use lib 't/tlib'; use Test::More; use Test::Exception; use DBIx::Migration::Directories; use DBIx::Migration::Directories::Test; use DBIx::Transaction; use Schema::RDBMS::AUS; use Schema::RDBMS::AUS::User; use t::dbh; local %ENV = %ENV; delete @ENV{qw(DBI_DSN DBI_USER DBI_PASS AUS_DB_DSN AUS_DB_USER AUS_DB_PASS)}; my(@db_opts) = test_db() or plan skip_all => 'Schema DSN was not set'; my $dbh = DBIx::Transaction->connect_cached(@db_opts) or die "Failed to connect to database"; my $plan = DBIx::Migration::Directories::Test->new_test( dbh => $dbh, schema_dir => 'schema', schema => 'Schema::RDBMS::AUS', tests => [ sub { my $self = shift; ok( $self->{_session} = CGI::Session::AUS->new( undef, undef, { Handle => $dbh, TableName => "aus_session" } ), "Get a new session" ); }, sub { my $self = shift; ok( $self->{_session}->param("foo", "bar"), "Assign a value to the sesion" ); }, sub { my $self = shift; ok( $self->{_session}->flush, "Flush session to database" ); }, sub { my $self = shift; $self->{_session_id} = $self->{_session}->id; delete $self->{_session}; ok( $self->{_session} = CGI::Session::AUS->new( undef, $self->{_session_id}, { Handle => $dbh } ), "Load previous session" ); }, sub { my $self = shift; is( $self->{_session_id}, $self->{_session}->id, "Session ID matches" ); }, sub { my $self = shift; is($self->{_session}->param("foo"), "bar", "Values persisted"); }, sub { my $self = shift; ok( $self->{_newuser} = Schema::RDBMS::AUS::User->create( name => "inhaler", _password => "eggo", _dbh => $dbh ), "created a user" ); }, sub { my $self = shift; throws_ok { $self->{_session}->login("gee", "whiz") } qr{\QUser not found.\E}, "Login fails on nonexistant user" }, sub { my $self = shift; throws_ok { $self->{_session}->login("inhaler", "cookie") } qr{\QBad password for user\E}, "Login fails on bad password" }, sub { my $self = shift; ok( $self->{_user} = $self->{_session}->login("inhaler", "eggo"), "Session can log a user in" ); }, sub { my $self = shift; isnt( scalar($self->{_newuser}), scalar($self->{_user}), "User object isn't the same as the one we used to create" ); }, sub { my $self = shift; is( scalar($self->{_session}->user), scalar($self->{_user}), "User object is the same as the one stored on session" ); }, sub { my $self = shift; ok( !$self->{_session}->flush, "No flush: session has not changed" ); }, sub { my $self = shift; ok( $self->{_session}->param("foo", "oof"), "Change a param in session" ); }, sub { my $self = shift; ok($self->{_session}->flush, "Flush happens after param change"); }, sub { my $self = shift; $self->{_session_id} = $self->{_session}->id; delete $self->{_session}; ok( $self->{_session} = CGI::Session::AUS->new( undef, $self->{_session_id}, { Handle => $dbh, } ), "Session loads ok" ); }, sub { my $self = shift; is( $self->{_session_id}, $self->{_session}->id, "Session ID matches" ); }, sub { my $self = shift; is( $self->{_session}->{_user}->{id}, $self->{_user}->{id}, "User is placed back into session properly." ); }, sub { my $self = shift; throws_ok { $self->{_session}->_driver->session_method("bollocks"); } qr/^\S+ can not do bollocks/, "AUS catches invalid session methods"; }, ] ); plan tests => $plan->num_tests + 1; use_ok('CGI::Session::AUS') or die "Faile to use CGI::Session::AUS: $@"; $plan->run_tests;