cvs commit: modperl-2.0/t/response/TestApache cookie2.pm cookie.pm

[stas]

stas        2003/08/22 19:39:10

  Added:       t/apache cookie2.t cookie.t
               t/response/TestApache cookie2.pm cookie.pm
  Log:
  cookie tests, really testing when env vars are setup
  
  Revision  Changes    Path
  1.1                  modperl-2.0/t/apache/cookie2.t
  
  Index: cookie2.t
  ===================================================================
  use strict;
  use warnings FATAL => 'all';
  
  use Apache::Test;
  use Apache::TestUtil;
  use Apache::TestRequest;
  
  plan tests => 2;
  
  my $module = 'TestApache::cookie2';
  my $location = Apache::TestRequest::module2path($module);
  my $cookie = 'foo=bar';
  
  t_debug("Testing cookie in PerlResponseHandler");
  
  for (qw/header env/) {
      t_debug("-- testing cookie from $_");
      my $res = GET "$location?$_", Cookie => $cookie;
  
      ok t_cmp('bar', $res->content,
               "content is 'bar'");
  }
  
  
  
  
  1.1                  modperl-2.0/t/apache/cookie.t
  
  Index: cookie.t
  ===================================================================
  use strict;
  use warnings FATAL => 'all';
  
  use Apache::Test;
  use Apache::TestUtil;
  use Apache::TestRequest qw(GET_BODY);
  
  plan tests => 2;
  
  my $module = 'TestApache::cookie';
  my $location = Apache::TestRequest::module2path($module);
  my $val = "bar";
  my $cookie = "key=$val";
  
  my %expected = 
  (
      header => $val,
      env    => '',
  );
  
  for (qw/header env/) {
      my $received = GET_BODY "$location?$_", Cookie => $cookie;
      ok t_cmp($expected{$_}, $received);
  }
  
  
  
  
  1.1                  modperl-2.0/t/response/TestApache/cookie2.pm
  
  Index: cookie2.pm
  ===================================================================
  package TestApache::cookie2;
  
  use strict;
  use warnings FATAL => 'all';
  
  use Apache::Test;
  use Apache::Const -compile => 'OK';
  
  use Apache::RequestRec ();
  use Apache::RequestIO ();
  
  sub access {
      my $r = shift;
  
      my($key, $val) = cookie($r);
      die "Can't get the cookie" unless defined $val;
      return Apache::OK;
  }
  
  sub handler {
      my $r = shift;
      my($key, $val) = cookie($r);
      $r->print($val) if defined $val;
      return Apache::OK;
  }
  
  sub cookie {
      my $r = shift;
      my $header = $r->headers_in->{Cookie} || '';
      my $env    = $ENV{HTTP_COOKIE} || $ENV{COOKIE} || ''; # from CGI::Cookie
  
      return split '=', $r->args eq 'header' ? $header : $env;
  }
  
  1;
  
  __DATA__
  SetHandler perl-script
  PerlModule          TestApache::cookie2
  PerlResponseHandler TestApache::cookie2
  PerlAccessHandler   TestApache::cookie2::access
  # XXX: the test fails if +SetupEnv is not explicitly set
  # because of the timing differences (+SetupEnv sets the env during the
  # header phase, without it perl-script sets it for the response phase)
  PerlOptions +SetupEnv
  
  
  
  1.1                  modperl-2.0/t/response/TestApache/cookie.pm
  
  Index: cookie.pm
  ===================================================================
  package TestApache::cookie;
  
  use strict;
  use warnings FATAL => 'all';
  
  use Apache::Test;
  use Apache::Const -compile => 'OK';
  
  use Apache::RequestRec ();
  use Apache::RequestIO ();
  
  sub access {
      my $r = shift;
  
      my($key, $val) = cookie($r);
      die "I shouldn't get the cookie" if $r->args eq 'env' && defined $val;
      return Apache::OK;
  }
  
  sub handler {
      my $r = shift;
      my($key, $val) = cookie($r);
      $r->print($val) if defined $val;
      return Apache::OK;
  }
  
  sub cookie {
      my $r = shift;
      my $header = $r->headers_in->{Cookie} || '';
      my $env    = $ENV{HTTP_COOKIE} || $ENV{COOKIE} || ''; # from CGI::Cookie
  
      return split '=', $r->args eq 'header' ? $header : $env;
  }
  
  1;
  
  __DATA__
  PerlOptions -SetupEnv
  SetHandler modperl
  PerlModule          TestApache::cookie
  PerlResponseHandler TestApache::cookie
  PerlAccessHandler   TestApache::cookie::access