t/006_basic_w_dbi_store.t

   1 #!/usr/bin/perl
   2
   3 use strict;
   4 use warnings;
   5 use File::Spec;
   6 use File::Temp qw(tempdir);
   7
   8 use Test::Requires qw(DBI DBD::SQLite MIME::Base64 Storable);
   9 use Test::More;
  10
  11 use Plack::Request;
  12 use Plack::Session;
  13 use Plack::Session::State::Cookie;
  14 use Plack::Session::Store::DBI;
  15
  16 use t::lib::TestSession;
  17
  18 my $tmp  = tempdir(CLEANUP => 1);
  19 my $file = File::Spec->catfile($tmp, "006_basic_w_dbi_store.db");
  20 my $dbh  = DBI->connect( "dbi:SQLite:$file", undef, undef, {RaiseError => 1, AutoCommit => 1} );
  21 $dbh->do(<<EOSQL);
  22 CREATE TABLE sessions (
  23     id CHAR(72) PRIMARY KEY,
  24     session_data TEXT
  25 );
  26 EOSQL
  27
  28 t::lib::TestSession::run_all_tests(
  29     store  => Plack::Session::Store::DBI->new( dbh => $dbh ),
  30     state  => Plack::Session::State->new,
  31     env_cb => sub {
  32         open my $in, '<', \do { my $d };
  33         my $env = {
  34             'psgi.version'    => [ 1, 0 ],
  35             'psgi.input'      => $in,
  36             'psgi.errors'     => *STDERR,
  37             'psgi.url_scheme' => 'http',
  38             SERVER_PORT       => 80,
  39             REQUEST_METHOD    => 'GET',
  40             QUERY_STRING      => join "&" => map { $_ . "=" . $_[0]->{ $_ } } keys %{$_[0] || +{}},
  41         };
  42     },
  43 );
  44
  45 t::lib::TestSession::run_all_tests(
  46     store  => Plack::Session::Store::DBI->new( get_dbh => sub { $dbh }  ),
  47     state  => Plack::Session::State->new,
  48     env_cb => sub {
  49         open my $in, '<', \do { my $d };
  50         my $env = {
  51             'psgi.version'    => [ 1, 0 ],
  52             'psgi.input'      => $in,
  53             'psgi.errors'     => *STDERR,
  54             'psgi.url_scheme' => 'http',
  55             SERVER_PORT       => 80,
  56             REQUEST_METHOD    => 'GET',
  57             QUERY_STRING      => join "&" => map { $_ . "=" . $_[0]->{ $_ } } keys %{$_[0] || +{}},
  58         };
  59     },
  60 );
  61
  62
  63 $dbh->disconnect;
  64
  65 done_testing;