view release on metacpan or  search on metacpan

t/050.simple.t  view on Meta::CPAN

);
$ENV{'REQUEST_METHOD'} = 'GET';

# parse_keywordlist() - scalar and array context
$sv = $q->parse_keywordlist( 'Just+another++Perl%20hacker%2C' );
@av = $q->parse_keywordlist( 'Just+another++Perl%20hacker%2C' );
is( $sv, '4', 'parse_keywordlist(), 1' );
is(
  join( ' ', @av ),
  'Just another Perl hacker,',
  'parse_keywordlist(), 2'
);

################ Save and Restore params from file ###############

# _init_from_file()
# save() - scalar and array context, void/invalid/valid argument
# save_parameters() - scalar and array context, void/invalid/valid argument

# all tested in constructor section

################ Miscelaneous Methods ################

$q = CGI::Simple->new;

# escapeHTML()
$sv = $q->escapeHTML();
is( $sv, undef, 'escapeHTML(), 1' );
$sv = $q->escapeHTML( "<>&\"\012\015<>&\"\012\015", 0 );
is(
  $sv,
  "&lt;&gt;&amp;&quot;\012\015&lt;&gt;&amp;&quot;\012\015",
  'escapeHTML(), 2'
);
$sv = $q->escapeHTML( "<>&\"\012\015<>&\"\012\015", 'newlines too' );
is(
  $sv,
  "&lt;&gt;&amp;&quot;&#10;&#13;&lt;&gt;&amp;&quot;&#10;&#13;",
  'escapeHTML(), 3'
);

# unescapeHTML()
$sv = $q->unescapeHTML();
is( $sv, undef, 'unescapeHTML(), 1' );
$sv = $q->unescapeHTML(
  "&lt;&gt;&amp;&quot;&#10;&#13;&lt;&gt;&amp;&quot;&#10;&#13;" );
is( $sv, "<>&\"\012\015<>&\"\012\015", 'unescapeHTML(), 2' );
$sv = $q->unescapeHTML(
  'Jack & Jill went up the hill; to get a pail of water' );
is(
  $sv,
  'Jack & Jill went up the hill; to get a pail of water',
  'unescapeHTML(), 3 '
);

# put()
is( $q->put( '' ), 1, 'put(), 1' );

# print()
is( $q->print( '' ), 1, 'print(), 1' );
################# Cookie Methods ################

$q = CGI::Simple->new;

# raw_cookie() - scalar and array context, void argument
$sv = $q->raw_cookie();
@av = $q->raw_cookie();
is(
  $sv,
  'foo=a%20phrase; bar=yes%2C%20a%20phrase&I%20say;',
  'raw_cookie(), 1'
);
is(
  join( '', @av ),
  'foo=a%20phrase; bar=yes%2C%20a%20phrase&I%20say;',
  'raw_cookie(), 2'
);

# raw_cookie() - scalar and array context, valid argument
$sv = $q->raw_cookie( 'foo' );
@av = $q->raw_cookie( 'foo' );
is( $sv, 'a%20phrase', 'raw_cookie(\'foo\'), 1' );
is( join( '', @av ), 'a%20phrase', 'raw_cookie(\'foo\'), 2' );

# raw_cookie() - scalar and array context, invalid argument
$sv = $q->raw_cookie( 'invalid' );
@av = $q->raw_cookie( 'invalid' );
is( $sv, undef, 'raw_cookie(\'invalid\'), 1' );
is( join( '', @av ), '', 'raw_cookie(\'invalid\'), 2' );

# cookie() - scalar and array context, void argument
$sv = $q->cookie();
@av = $q->cookie();
is( $sv, '2', 'cookie(), 1' );

# fix OS perl version test bug
is( join( ' ', sort @av ), 'bar foo', 'cookie(), 2' );

# cookie() - scalar and array context, valid argument, single value
$sv = $q->cookie( 'foo' );
@av = $q->cookie( 'foo' );
is( $sv, 'a phrase', 'cookie(\'foo\'), 1' );
is( join( '', @av ), 'a phrase', 'cookie(\'foo\'), 2' );

# cookie() - scalar and array context, valid argument, multiple values
$sv = $q->cookie( 'bar' );
@av = $q->cookie( 'bar' );
is( $sv, 'yes, a phrase', 'cookie(\'foo\'), 1' );
is( join( ' ', @av ), 'yes, a phrase I say', 'cookie(\'foo\'), 2' );

# cookie() - scalar and array context, invalid argument
$sv = $q->cookie( 'invalid' );
@av = $q->cookie( 'invalid' );
is( $sv, undef, 'cookie(\'invalid\'), 1' );
is( join( '', @av ), '', 'cookie(\'invalid\'), 2' );
my @vals = (
  -name     => 'Password',
  -value    => [ 'superuser', 'god', 'open sesame', 'mydog woofie' ],
  -expires  => 'Mon, 11-Nov-2018 11:00:00 GMT',
  -domain   => '.nowhere.com',
  -path     => '/cgi-bin/database',

t/050.simple.t  view on Meta::CPAN

  join( '', @av ),
  'Password=superuser&god&open%20sesame&mydog%20woofie; domain=.nowhere.com; path=/cgi-bin/database; expires=Mon, 11-Nov-2018 11:00:00 GMT; secure; HttpOnly',
  'cookie(\@vals) incorrect order, 2'
);
my $cookie = $sv;    # save a cookie for header testing

# cookie() - scalar and array context, partial argument set
$sv = $q->cookie( -name => 'foo', -value => 'bar' );
@av = $q->cookie( -name => 'foo', -value => 'bar' );
is(
  $sv,
  'foo=bar; path=/',
  'cookie( -name=>\'foo\', -value=>\'bar\' ), 1'
);
is(
  join( '', @av ),
  'foo=bar; path=/',
  'cookie( -name=>\'foo\', -value=>\'bar\' ), 2'
);
################# Header Methods ################

$q = CGI::Simple->new;

 my $CRLF = $q->crlf;

# header() - scalar and array context, void argument
$sv = $q->header();
@av = $q->header();
is( $sv, "Content-Type: text/html; charset=ISO-8859-1$CRLF$CRLF",
  'header(), 1' );
is(
  join( '', @av ),
  "Content-Type: text/html; charset=ISO-8859-1$CRLF$CRLF",
  'header(), 2'
);

# header() - scalar context, single argument
$sv = $q->header( 'image/gif' );
is(
  $sv,
  "Content-Type: image/gif$CRLF$CRLF",
  'header(\'image/gif\'), 1'
);
@vals = (
  -type       => 'image/gif',
  -nph        => 1,
  -status     => '402 Payment required',
  -expires    => 'Mon, 11-Nov-2018 11:00:00 GMT',
  -cookie     => $cookie,
  -charset    => 'utf-7',
  -attachment => 'foo.gif',
  -Cost       => '$2.00'
);

# header() - scalar context, complex header
$sv = $q->header( @vals );
my $header = <<'HEADER';
HTTP/1.0 402 Payment required
Server: Apache - accept no substitutes
Status: 402 Payment required
Set-Cookie: Password=superuser&god&open%20sesame&mydog%20woofie; domain=.nowhere.com; path=/cgi-bin/database; expires=Mon, 11-Nov-2018 11:00:00 GMT; secure; HttpOnly
Expires: Mon, 11-Nov-2018 11:00:00 GMT
Date: Tue, 11-Nov-2018 11:00:00 GMT
Content-Disposition: attachment; filename="foo.gif"
Cost: $2.00
Content-Type: image/gif
HEADER
$sv     =~ s/[\012\015]//g;
$header =~ s/[\012\015]//g;
$sv     =~ s/(?:Expires|Date).*?GMT//g;    # strip the time elements
$header =~ s/(?:Expires|Date).*?GMT//g;    # strip the time elements
is( $sv, $header, 'header(\@vals) - complex header, 1' );

# cache() - scalar and array context, void argument
$sv = $q->cache();
is( $sv, undef, 'cache(), 1' );

# cache() - scalar and array context, true argument, sets no cache paragma
$sv = $q->cache( 1 );
is( $sv, 1, 'cache(1), 1' );
$sv = $q->header();
is( $sv =~ /Pragma: no-cache/, 1, 'cache(1), 2' );

# no_cache() - scalar and array context, void argument
$sv = $q->no_cache();
is( $sv, undef, 'cache(), 1' );

# no_cache() - scalar and array context, true argument, sets no cache paragma
$sv = $q->no_cache( 1 );
is( $sv, 1, 'cache(1), 1' );
$sv = $q->header();
like( $sv, qr/Pragma: no-cache/, 'cache(1), 2' );
ok( $sv =~ /Expires:(.*?)GMT/, 'cache(1), 3' );
ok( $sv =~ /Date:$1GMT/ . 'cache(1), 4' );

# redirect() - scalar and array context, void argument
$sv     = $q->redirect( 'http://a.galaxy.far.away.gov' );
$header = <<'HEADER';
Status: 302 Found
Expires: Tue, 13 Nov 2001 06:45:15 GMT
Date: Tue, 13 Nov 2001 06:45:15 GMT
Pragma: no-cache
Location: http://a.galaxy.far.away.gov
HEADER
$sv     =~ s/[\012\015]//g;
$header =~ s/[\012\015]//g;
$sv     =~ s/(?:Expires|Date).*?GMT//g;    # strip the time elements
$header =~ s/(?:Expires|Date).*?GMT//g;    # strip the time elements
is( $sv, $header, 'redirect(), 1' );

# redirect() - scalar and array context, void argument
$sv = $q->redirect( -uri => 'http://a.galaxy.far.away.gov', -nph => 1 );
$header = <<'HEADER';
HTTP/1.0 302 Found
Server: Apache - accept no substitutes
Status: 302 Found
Expires: Tue, 13 Nov 2001 06:49:24 GMT
Date: Tue, 13 Nov 2001 06:49:24 GMT
Pragma: no-cache
Location: http://a.galaxy.far.away.gov
HEADER