view release on metacpan or  search on metacpan

t/cgi.t  view on Meta::CPAN

#!/usr/bin/perl

use strict;
use warnings;
use lib "t/tlib";
use t::dbh;
use Apache::Test qw(:withtestmore);
use Apache::TestRequest qw(GET_BODY POST_BODY GET);
use Apache::TestUtil;
use DBIx::Migration::Directories::Test;
use DBIx::Transaction;
use Test::More qw(no_plan);
use Schema::RDBMS::AUS::User;

my(@db_opts) = test_db()
    or plan skip_all => 'Schema DSN was not set';

my $config   = Apache::Test::config();
my $hostport = Apache::TestRequest::hostport($config) || '';
my $dbh = DBIx::Transaction->connect(@db_opts)
    or die "Failed to connect to database";

my $path = "/test/apache2-aus-cgi";

my @go = (go => "$path/env.cgi", go_error => "$path/login.cgi");

my $self = {dbh => $dbh};

t_debug("connecting to $hostport");
my $test = "Got a session id";
my $received;
$received = GET_BODY "$path/env.cgi";
if($received =~ m{AUS_SESSION_ID\' \=\> \'(.+?)\'}) {
    $self->{_session} = $1;
    pass($test);
} else {
    fail($test);
}

Apache::TestRequest::user_agent(reset=> 1, cookie_jar => {});
$received = GET_BODY "$path/env.cgi";
unlike(
    $received, qr{AUS_SESSION_ID\' \=\> \'\Q$self->{_session}\E\'},
    "Session ID on second request doesn't match without a cookie"
);
$self->{_received} = $received;

$received = delete $self->{_received};
delete $self->{_session};
$test = "Got a new session id";
if($received =~ m{AUS_SESSION_ID\' \=\> \'(.+?)\'}) {
    $self->{_session} = $1;
    pass($test);
} else {
    fail($test);
}

$received = GET_BODY "$path/env.cgi";
$self->{_received} = $received;
like(
    $received, qr{AUS_SESSION_ID\' \=\> \'\Q$self->{_session}\E\'},
    "Session ID on second request matches with a cookie"
);

unlike(