"Fossies" - the Fresh Open Source Software Archive

Member "Apache-Session-1.93/t/99oracle.t" (18 Dec 2012, 2740 Bytes) of package /linux/www/Apache-Session-1.93.tar.gz:


As a special service "Fossies" has tried to format the requested text file into HTML format (style: standard) with prefixed line numbers. Alternatively you can here view or download the uninterpreted source code file.

    1 use Test::More;
    2 use Test::Deep;
    3 
    4 plan skip_all => "Not running RDBM tests without APACHE_SESSION_MAINTAINER=1"
    5   unless $ENV{APACHE_SESSION_MAINTAINER};
    6 plan skip_all => "Optional modules (DBD::Oracle, DBI) not installed"
    7   unless eval {
    8                require DBD::Oracle;
    9                require DBI;
   10               };
   11 
   12 plan tests => 13;
   13 
   14 my $package = 'Apache::Session::Oracle';
   15 use_ok $package;
   16 
   17 my $session = {};
   18 #$ENV{ORACLE_SID}='';$ENV{AS_ORACLE_USER}='test/test';
   19 my $dsn = "dbi:Oracle:$ENV{ORACLE_SID}";
   20 my $user = $ENV{AS_ORACLE_USER};
   21 my $pass = $ENV{AS_ORACLE_PASS};
   22 {
   23     my $dbh = DBI->connect($dsn, $user, $pass, {RaiseError => 1, AutoCommit => 1, PrintError=>0, });
   24     foreach my $table (qw/sessions_perl/) {
   25         eval { $dbh->do("DROP TABLE $table", {RaiseError => 0, PrintError=>0, });};
   26         $dbh->do(<<"EOT");
   27  CREATE TABLE $table (
   28     id varchar2(32) not null primary key,
   29     a_session long
   30  )
   31 EOT
   32     }
   33 }
   34 
   35 tie %{$session}, $package, undef, {
   36     DataSource => $dsn,
   37     UserName => $user,
   38     Password => $pass,
   39     Commit   => 1,
   40     TableName => 'sessions_perl',
   41 };
   42 
   43 ok tied(%{$session}), 'session tied';
   44 
   45 ok exists($session->{_session_id}), 'session id exists';
   46 
   47 my $id = $session->{_session_id};
   48 
   49 my $foo = $session->{foo} = 'bar';
   50 my $baz = $session->{baz} = ['tom', 'dick', 'harry'];
   51 
   52 untie %{$session};
   53 undef $session;
   54 $session = {};
   55 
   56 tie %{$session}, $package, $id, {
   57     DataSource => $dsn, 
   58     UserName => $user, 
   59     Password => $pass,
   60     Commit   => 1,
   61     TableName => 'sessions_perl',
   62 };
   63 
   64 ok tied(%{$session}), 'session tied';
   65 
   66 is $session->{_session_id}, $id, 'id retrieved matches one stored';
   67 
   68 cmp_deeply $session->{foo}, $foo, "Foo matches";
   69 cmp_deeply $session->{baz}, $baz, "Baz matches";
   70 
   71 $session->{long} = 'A'x(10*2**10);
   72 
   73 untie %{$session};
   74 undef $session;
   75 $session = {};
   76 
   77 my $dbh = DBI->connect($dsn, $user, $pass, {RaiseError => 1, AutoCommit => 0});
   78 
   79 tie %{$session}, $package, $id, {
   80     Handle      => $dbh,
   81     Commit      => 0,
   82     LongReadLen => 20*2**10,
   83     TableName => 'sessions_perl',
   84 };
   85 
   86 ok tied(%{$session}), 'session tied';
   87 
   88 is $session->{long}, 'A'x(10*2**10), 'long read worked';
   89 
   90 delete $session->{long};
   91 
   92 untie %{$session};
   93 undef $session;
   94 $session = {};
   95 
   96 tie %{$session}, $package, $id, {
   97     Handle => $dbh,
   98     Commit => 0,
   99     TableName => 'sessions_perl',
  100 };
  101 
  102 ok tied(%{$session}), 'session tied';
  103 
  104 is $session->{_session_id}, $id, 'id retrieved matches one stored';
  105 
  106 cmp_deeply $session->{foo}, $foo, "Foo matches";
  107 cmp_deeply $session->{baz}, $baz, "Baz matches";
  108 
  109 tied(%{$session})->delete;
  110 untie %{$session};
  111 
  112 $dbh->commit;
  113 $dbh->disconnect;