use Test::More; use lib qw( ../lib ./lib ); use Egg::Helper; # $ENV{EGG_DBI_DSN} = 'dbi:Pg;:dbname=DATABASE'; # $ENV{EGG_DBI_USER} = 'db_user'; # $ENV{EGG_DBI_PASSWORD} = 'db_password'; # $ENV{EGG_DBI_TEST_TABLE}= 'egg_release_dbi_test'; eval{ require Egg::Release::DBIC }; if ($@) { plan skip_all=> "Egg::Release::DBIC is not installed."; } else { my $env= Egg::Helper->helper_get_dbi_attr; unless ($env->{dsn}) { plan skip_all=> "I want setup of environment variable."; } else { test($env); } } sub test { plan tests=> 66; my($attr)= @_; my $project = 'Vtest'; my $tool = Egg::Helper->helper_tools; my $root = $tool->helper_tempdir. "/$project"; my $table = $attr->{table}; $tool->helper_create_files( [ $tool->helper_yaml_load(join '', ) ], { root => $root, dbi => $attr } ); require DBI; $attr->{options}{AutoCommit}= 1; $attr->{options}{RaiseError}= 1; $attr->{options}{PrintError}= 0; my $dbh= DBI->connect(@{$attr}{qw/ dsn user password options /}); eval { $dbh->do(<run( Vtest => { # vtest_plugins=> [qw/ -Debug /], vtest_root=> $root, vtest_config=> { MODEL=> [qw/ DBIC Session /] }, }); can_ok 'Vtest::Model::Session::Test', 'config'; my $c= Vtest::Model::Session::Test->config; ok $c->{dbic}, q{$c->{dbic}}; ok my $s= $e->model('session_test'), q{my $s= $e->model('session_test')}; isa_ok $s, 'HASH'; isa_ok $s, 'Vtest::Model::Session::Test'; isa_ok $s, 'Egg::Model::Session::Manager::Base'; can_ok $s, 'label_name'; is $s->label_name, 'session_test', q{$s->label_name, 'session_test'}; my $t_class= "Vtest::Model::Session::Test::TieHash"; can_ok $s, 'context'; ok my $t= $s->context, q{my $t= $s->context}; is tied(%$s), $t, q{tied(%$s), $t}; isa_ok $t, 'ARRAY'; isa_ok $t, $t_class; isa_ok $t, 'Egg::Model::Session::ID::SHA1'; isa_ok $t, 'Egg::Model::Session::Bind::Cookie'; isa_ok $t, 'Egg::Model::Session::Store::Base64'; isa_ok $t, 'Egg::Model::Session::Base::DBIC'; isa_ok $t, 'Egg::Model::Session::Manager::TieHash'; { no strict 'refs'; ## no critic. my $isa= \@{"${t_class}::ISA"}; is $isa->[-1], 'Egg::Component::Base', q{$isa->[-1], 'Egg::Component::Base'}; is $isa->[-2], 'Egg::Model::Session::Manager::TieHash', q{$isa->[-2], 'Egg::Model::Session::Manager::TieHash'}; }; can_ok $t, 'moniker'; like $t->moniker, qr{^\d+$}, q{$t->moniker, qr{^\d+$}}; can_ok $t, 'id_col'; is $t->id_col, 'id', q{$t->id_col, 'id'}; can_ok $t, 'data_col'; is $t->data_col, 'a_session', q{$t->data_col, 'a_session'}; can_ok $t, 'time_col'; is $t->time_col, 'lastmod', q{$t->time_col, 'lastmod'}; can_ok $t, '_begin'; can_ok $t, '_commit'; can_ok $t, 'data'; isa_ok $t->data, 'HASH'; is $s->{___session_id}, $t->data->{___session_id}, q{$s->{___session_id}, $t->data->{___session_id}}; is $s->{create_time}, $t->data->{create_time}, q{$s->{create_time}, $t->data->{create_time}}; is $s->{now_time}, $t->data->{now_time}, q{$s->{now_time}, $t->data->{now_time}}; can_ok $t, 'attr'; isa_ok $t->attr, 'HASH'; can_ok $t, 'session_id'; is $t->session_id, $t->data->{___session_id}, q{$t->session_id, $t->data->{___session_id}}; can_ok $t, 'e'; is $e, $t->e, q{$e, $t->e}; can_ok $t, 'is_new'; ok $t->is_new, q{$t->is_new}; can_ok $t, 'is_update'; ok ! $t->is_update, q{! $t->is_update}; ok $s->{test}= 1, q{$s->{test}= 1}; ok $t->is_update, q{$t->is_update}; can_ok $t, 'change'; ok my $session_id= $t->session_id, q{my $session_id= $t->session_id}; ok $t->change, q{$t->change}; ok $session_id ne $t->session_id, q{$session_id ne $t->session_id}; can_ok $t, 'clear'; ok $s->{test}, q{$s->{test}}; ok $s->{test2}= 1, q{$s->{test2}= 1}; ok $t->clear, q{$t->clear}; ok ! $s->{test}, q{! $s->{test}}; ok ! $s->{test2}, q{! $s->{test2}}; can_ok $s, 'close_session'; $session_id= $s->session_id; ok $s->{restore_ok}= 1, q{$s->{restore_ok}= 1}; ok $s->close_session, q{$s->close_session}; my $s2= $e->model('session_test', $session_id); is $s2->session_id, $session_id, q{$s2->session_id, $session_id}; ok $s2->{restore_ok}, q{$s->{restore_ok}}; ok $s2->{end}= 1, q{$s2->{end}= 1}; can_ok $t, '_finish'; can_ok $t, '_finalize_error'; ok $s2->close_session, q{$s->close_session}; $e->debug_end; }; $@ and warn $@; $dbh->do(qq{DROP TABLE $table}); $dbh->disconnect; } __DATA__ filename: /lib/Vtest/Model/Session/Test.pm value: | package Vtest::Model::Session::Test; use strict; use warnings; use base qw/ Egg::Model::Session::Manager::Base /; __PACKAGE__->config( label_name => 'session_test', dbic=> { label_schema => 'dbic::schema', label_source => 'dbic::schema::moniker', }, ); __PACKAGE__->startup qw/ ID::SHA1 Bind::Cookie Store::Base64 Base::DBIC /; package Vtest::Model::Session::Test::TieHash; use strict; use warnings; use base qw/ Egg::Model::Session::Manager::TieHash /; 1; --- filename: /lib/Vtest/Model/DBIC/Schema.pm value: | package Vtest::Model::DBIC::Schema; use strict; use warnings; use base qw/ Egg::Model::DBIC::Schema /; our $VERSION = '0.01'; __PACKAGE__->config( dsn => '', user => '', password => '', options => { AutoCommit => 1, RaiseError=> 1 }, ); __PACKAGE__->load_classes; 1; --- filename: /lib/Vtest/Model/DBIC/Schema/Moniker.pm value: | package Vtest::Model::DBIC::Schema::Moniker; use strict; use warnings; use base qw/ DBIx::Class /; our $VERSION = '0.01'; __PACKAGE__->load_components("PK::Auto", "Core"); __PACKAGE__->table(""); __PACKAGE__->add_columns( "id", { data_type => "character", default_value => undef, is_nullable => 0, size => 32, }, "lastmod", { data_type => "timestamp without time zone", default_value => undef, is_nullable => 1, size => 8, }, "a_session", { data_type => "text", default_value => undef, is_nullable => 1, size => undef, }, ); __PACKAGE__->set_primary_key("id"); 1;