CGI-Application-Plugin-Header

 view release on metacpan or  search on metacpan

README  view on Meta::CPAN

              my ( $self, $body_ref ) = @_;
              $self->header->set( 'Content-Length' => length $$body_ref );
          }

    $header = $cgiapp->header( CGI::Header->new(...) )
        You can also define your "header" class which inherits from
        "CGI::Header". For example,

          package MyApp::Header;
          use parent 'CGI::Header';
          use CGI::Cookie;

          sub cookies {
              my $self    = shift;
              my $cookies = $self->header->{cookies} ||= [];

              return $cookies unless @_;

              if ( ref $_[0] eq 'HASH' ) {
                  push @$cookies, map { CGI::Cookie->new($_) } @_;
              }
              else {
                  push @$cookies, CGI::Cookie->new( @_ );
              }

              $self;
          }

        You can set "header" as follows:

          # using new()

          my $query  = CGI->new;

lib/CGI/Application/Plugin/Header.pm  view on Meta::CPAN

      $self->header->set( 'Content-Length' => length $$body_ref );
  }

=item $header = $cgiapp->header( CGI::Header->new(...) )

You can also define your C<header> class which inherits from C<CGI::Header>.
For example,

  package MyApp::Header;
  use parent 'CGI::Header';
  use CGI::Cookie;

  sub cookies {
      my $self    = shift;
      my $cookies = $self->header->{cookies} ||= [];

      return $cookies unless @_;

      if ( ref $_[0] eq 'HASH' ) {
          push @$cookies, map { CGI::Cookie->new($_) } @_;
      }
      else {
          push @$cookies, CGI::Cookie->new( @_ );
      }

      $self;
  }

You can set C<header> as follows:

  # using new()

  my $query  = CGI->new;

t/32_session_cookie.t  view on Meta::CPAN

use Test::More tests => 16;
use File::Spec;
#BEGIN { use_ok('CGI::Application::Plugin::Session') };

#use lib './t';
use strict;

$ENV{CGI_APP_RETURN_ONLY} = 1;

use CGI;
#use TestAppSessionCookie;
my $t1_obj = TestAppSessionCookie->new(QUERY=>CGI->new());
my $t1_output = $t1_obj->run();

like($t1_output, qr/session created/, 'session created');
like($t1_output, qr/Set-Cookie: CGISESSID=[a-zA-Z0-9]+/, 'session cookie set');

my ($id1) = $t1_output =~ /id=([a-zA-Z0-9]+)/s;
ok($id1, 'found session id');

# check domain
like($t1_output, qr/domain=mydomain.com;/, 'domain found in cookie');

# check path
like($t1_output, qr/path=\/testpath/, 'path found in cookie');

t/32_session_cookie.t  view on Meta::CPAN

unlike($t1_output, qr/expires=/, 'expires not found in cookie');

# Session object will not disappear and be written
# to disk until it is DESTROYed
undef $t1_obj;

unlink File::Spec->catdir('t', 'cgisess_'.$id1);


my $query = new CGI({ rm => 'existing_session_cookie' });
$t1_obj = TestAppSessionCookie->new( QUERY => $query );
$t1_output = $t1_obj->run();

unlike($t1_output, qr/Set-Cookie: CGISESSID=test/, 'existing session cookie was deleted');
like($t1_output, qr/Set-Cookie: CGISESSID=[a-zA-Z0-9]+/, 'new session cookie set');

($id1) = $t1_output =~ /id=([a-zA-Z0-9]+)/s;
ok($id1, 'found session id');

undef $t1_obj;
unlink File::Spec->catdir('t', 'cgisess_'.$id1);


$query = new CGI({ rm => 'existing_session_cookie_plus_extra_cookie' });
$t1_obj = TestAppSessionCookie->new( QUERY => $query );
$t1_output = $t1_obj->run();

unlike($t1_output, qr/Set-Cookie: CGISESSID=test/, 'existing session cookie was deleted');
like($t1_output, qr/Set-Cookie: CGISESSID=[a-zA-Z0-9]+/, 'new session cookie set');
like($t1_output, qr/Set-Cookie: TESTCOOKIE=testvalue/, 'existing cookie was not deleted');

($id1) = $t1_output =~ /id=([a-zA-Z0-9]+)/s;
ok($id1, 'found session id');

undef $t1_obj;
unlink File::Spec->catdir('t', 'cgisess_'.$id1);


$query = new CGI({ rm => 'existing_extra_cookie' });
$t1_obj = TestAppSessionCookie->new( QUERY => $query );
$t1_output = $t1_obj->run();

like($t1_output, qr/Set-Cookie: CGISESSID=[a-zA-Z0-9]+/, 'new session cookie set');
like($t1_output, qr/Set-Cookie: TESTCOOKIE=testvalue/, 'existing cookie was not deleted');

($id1) = $t1_output =~ /id=([a-zA-Z0-9]+)/s;
ok($id1, 'found session id');

undef $t1_obj;
unlink File::Spec->catdir('t', 'cgisess_'.$id1);

# copied and rearranged from CGI-Application-Plugin-Session's t/TestAppSessionCookie.pm

package TestAppSessionCookie;

use strict;

use parent 'CGI::Application';
use CGI::Application::Plugin::Session;
use CGI::Application::Plugin::Header;

sub cgiapp_init {
  my $self = shift;

t/32_session_cookie.t  view on Meta::CPAN

                        COOKIE_PARAMS       => {
                                                 -name    => CGI::Session->name,
                                                 -value   => '1111',
                                                 -path    => '/testpath',
                                                 -domain  => 'mydomain.com',
                                                 -expires => '',
                                               },
  });

  $self->header(
      TestAppSessionCookie::Header->new(
          query => $self->query,
      )
  );
}

sub setup {
    my $self = shift;

    $self->start_mode('test_mode');

t/32_session_cookie.t  view on Meta::CPAN

  );

  my $session = $self->session;

  $output .= $session->is_new ? "session created\n" : "session found\n";
  $output .= "id=".$session->id."\n";

  return $output;
}

package TestAppSessionCookie::Header;
use parent 'CGI::Header';

sub _build_alias {
    +{
        'cookies'      => 'cookie',
        'content-type' => 'type',
    };
}

sub cookies {

t/33_session_delete.t  view on Meta::CPAN

use strict;

$ENV{CGI_APP_RETURN_ONLY} = 1;

use CGI;
#use TestAppSessionDelete;
my $t1_obj = TestAppSessionDelete->new(QUERY=>CGI->new());
my $t1_output = $t1_obj->run();

like($t1_output, qr/session created/, 'session created');
like($t1_output, qr/Set-Cookie: CGISESSID=[a-zA-Z0-9]+/, 'session cookie set');

my ($id1) = $t1_output =~ /id=([a-zA-Z0-9]+)/s;
ok($id1, 'found session id');

my ( $original_expiry ) = $t1_output =~ /expires=(.+)\s+Date/;

# Test Plan ... create a session ... not going to test that, b/c there are
# other tests for that.  What we're going to do is now create a new CGI query
# object and call the 'logout' runmode, which will call the new session_delete
# method, which should remove the flat file as well as send a cookie header

t/33_session_delete.t  view on Meta::CPAN

$ENV{HTTP_COOKIE} = "CGISESSID=$id1";
my $query = new CGI({ rm => 'logout' });
$t1_obj = TestAppSessionDelete->new( QUERY => $query );
$t1_output = $t1_obj->run();

# vanilla output came through ok?
ok( $t1_output =~ /logout finished/, 'vanilla output came through ok' );
# If that didn't pass, then I'm guessing the session wasn't injected properly

# Was the session create cookie in the output?  It shouldn't be
unlike($t1_output, qr/Set-Cookie: CGISESSID=[a-zA-Z0-9]+/, 'new session cookie not in output');

# Was the session delete cookie in the output?  It should be
like($t1_output, qr/Set-Cookie: CGISESSID=;/, 'delete session cookie in output');

my ( $new_expiry ) = $t1_output =~ /expires=(.+)\s+Date/;

ok( $original_expiry ne $new_expiry, 'expirations are different' );

# Need to figure out if $new_expiry < $original_expiry and $new_expiry < NOW()
SKIP: {
    eval { require Date::Parse; };
    skip "Date::Parse not installed", 2 if $@;
    Date::Parse->import();

t/33_session_delete.t  view on Meta::CPAN

undef $t1_obj;
# Is the file gone?
ok( !-e 't/cgisess_'.$id1, 'session_delete wiped the flat file ok' );


# We do the cookie tests again, this time we set some extra custom cookies
# and make sure they don't get clobbered
$ENV{HTTP_COOKIE} = "CGISESSID=$id1";
$query = new CGI({ rm => 'logout' });
$t1_obj = TestAppSessionDelete->new( QUERY => $query );
$t1_obj->header_add( -cookie => [ CGI::Cookie->new( -name => 'test', -value => 'testing' ) ]);
$t1_obj->header_add( -cookie => [ 'test2=testing2; path=/' ]);

$t1_output = $t1_obj->run();

# vanilla output came through ok?
ok( $t1_output =~ /logout finished/, 'vanilla output came through ok' );
# If that didn't pass, then I'm guessing the session wasn't injected properly

# Was the session create cookie in the output?  It shouldn't be
unlike($t1_output, qr/Set-Cookie: CGISESSID=[a-zA-Z0-9]+/, 'new session cookie not in output');

# Was the session delete cookie in the output?  It should be
like($t1_output, qr/Set-Cookie: CGISESSID=;/, 'delete session cookie in output');

# Was the test cookie in the output?  It should be
like($t1_output, qr/Set-Cookie: test=testing/, 'test cookie in output');

# Was the test cookie in the output?  It should be
like($t1_output, qr/Set-Cookie: test2=testing2/, 'second test cookie in output');


# We do the cookie tests one last time, this time we clobber the session cookie
# and set a single new cookie
$ENV{HTTP_COOKIE} = "CGISESSID=$id1";
$query = new CGI({ rm => 'logout' });
$t1_obj = TestAppSessionDelete->new( QUERY => $query );
$t1_obj->session; # this sets the session cookie
$t1_obj->header_add( -cookie => 'test2=testing2; path=/');  # this clobbers the session cookie

$t1_output = $t1_obj->run();

# vanilla output came through ok?
ok( $t1_output =~ /logout finished/, 'vanilla output came through ok' );
# If that didn't pass, then I'm guessing the session wasn't injected properly

# Was the session create cookie in the output?  It shouldn't be
unlike($t1_output, qr/Set-Cookie: CGISESSID=[a-zA-Z0-9]+/, 'new session cookie not in output');

# Was the session delete cookie in the output?  It should be
like($t1_output, qr/Set-Cookie: CGISESSID=;/, 'delete session cookie in output');


# Was the test cookie in the output?  It should be
like($t1_output, qr/Set-Cookie: test2=testing2/, 'test cookie in output');

# copied and rearranged from CGI-Application-Plugin-Session's t/TestAppSessionDelete.pm

package TestAppSessionDelete;

use strict;

use parent 'CGI::Application';
use CGI::Application::Plugin::Session;
use CGI::Application::Plugin::Header;