view release on metacpan or  search on metacpan

t/070.standard.t  view on Meta::CPAN

  'parse_query_string(), 2'
);
$ENV{'REQUEST_METHOD'} = 'GET';

# parse_keywordlist() - scalar and array context

$sv = parse_keywordlist( 'Just+another++Perl%20hacker%2C' );
@av = 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 ################

restore_parameters();

# escapeHTML()

$sv = escapeHTML();
is( $sv, undef, 'escapeHTML(), 1' );
$sv = escapeHTML( "<>&\"\012\015<>&\"\012\015", 0 );
is(
  $sv,
  "&lt;&gt;&amp;&quot;\012\015&lt;&gt;&amp;&quot;\012\015",
  'escapeHTML(), 2'
);
$sv = 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 = unescapeHTML();
is( $sv, undef, 'unescapeHTML(), 1' );
$sv = unescapeHTML(
  "&lt;&gt;&amp;&quot;&#10;&#13;&lt;&gt;&amp;&quot;&#10;&#13;" );
is( $sv, "<>&\"\012\015<>&\"\012\015", 'unescapeHTML(), 2' );

# put()

is( put( '' ), 1, 'put(), 1' );

# print()

is( print( '' ), 1, 'print(), 1' );

################# Cookie Methods ################

restore_parameters();

# raw_cookie() - scalar and array context, void argument

$sv = raw_cookie();
@av = 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 = raw_cookie( 'foo' );
@av = 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 = raw_cookie( 'invalid' );
@av = 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 = cookie();
@av = 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 = cookie( 'foo' );
@av = 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 = cookie( 'bar' );
@av = 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 = cookie( 'invalid' );
@av = cookie( 'invalid' );
is( $sv, undef, 'cookie(\'invalid\'), 1' );

t/070.standard.t  view on Meta::CPAN

# cookie() - scalar and array context, partial argument set

$sv = cookie( -name => 'foo', -value => 'bar' );
@av = 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 = crlf();

# header() - scalar and array context, void argument

$sv = header();
@av = 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 = 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 = 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 = cache();
is( $sv, undef, 'cache(), 1' );

# cache() - scalar and array context, true argument, sets no cache paragma

$sv = cache( 1 );
is( $sv, 1, 'cache(1), 1' );
$sv = header();
is( $sv =~ /Pragma: no-cache/, 1, 'cache(1), 2' );

# no_cache() - scalar and array context, void argument

$sv = no_cache();
is( $sv, undef, 'cache(), 1' );

# no_cache() - scalar and array context, true argument, sets no cache paragma

$sv = no_cache( 1 );
is( $sv, 1, 'cache(1), 1' );
$sv = header();
is(
  (
         $sv =~ /Pragma: no-cache/
     and $sv =~ /Expires:(.*?)GMT/
     and $sv =~ /Date:$1GMT/
  ),
  1,
  'cache(1), 2'
);

# redirect() - scalar and array context, void argument

$sv     = 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' );