view release on metacpan or  search on metacpan

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

is( $CGI::Simple::HEADERS_ONCE,         0, '_initialize_globals(), 6' );
is( $CGI::Simple::NPH,                  0, '_initialize_globals(), 7' );
is( $CGI::Simple::DEBUG,                0, '_initialize_globals(), 8' );
is( $CGI::Simple::NO_NULL,              1, '_initialize_globals(), 9' );
is( $CGI::Simple::FATAL, -1, '_initialize_globals(), 10' );
undef_globals();

# _use_cgi_pm_global_settings()
$q->_use_cgi_pm_global_settings();
is( $CGI::Simple::DISABLE_UPLOADS, 0,
  '_use_cgi_pm_global_settings(), 1' );
is( $CGI::Simple::POST_MAX, -1, '_use_cgi_pm_global_settings(), 2' );
is( $CGI::Simple::NO_UNDEF_PARAMS, 0,
  '_use_cgi_pm_global_settings(), 3' );
is( $CGI::Simple::USE_PARAM_SEMICOLONS,
  1, '_use_cgi_pm_global_settings(), 4' );
is( $CGI::Simple::HEADERS_ONCE, 0, '_use_cgi_pm_global_settings(), 5' );
is( $CGI::Simple::NPH,          0, '_use_cgi_pm_global_settings(), 6' );
is( $CGI::Simple::DEBUG,        1, '_use_cgi_pm_global_settings(), 7' );
is( $CGI::Simple::NO_NULL,      0, '_use_cgi_pm_global_settings(), 8' );
is( $CGI::Simple::FATAL, -1, '_use_cgi_pm_global_settings(), 9' );

# _store_globals()
undef %{$q};

ok( !defined $q->{'.globals'}->{'DISABLE_UPLOADS'},
  '_store_globals(), 1' );
ok( !defined $q->{'.globals'}->{'POST_MAX'}, '_store_globals(), 2' );
ok( !defined $q->{'.globals'}->{'NO_UNDEF_PARAMS'},
  '_store_globals(), 3' );
ok( !defined $q->{'.globals'}->{'USE_PARAM_SEMICOLONS'},
  '_store_globals(), 4' );
ok( !defined $q->{'.globals'}->{'HEADERS_ONCE'},
  '_store_globals(), 5' );
ok( !defined $q->{'.globals'}->{'NPH'},     '_store_globals(), 6' );
ok( !defined $q->{'.globals'}->{'DEBUG'},   '_store_globals(), 7' );
ok( !defined $q->{'.globals'}->{'NO_NULL'}, '_store_globals(), 8' );
ok( !defined $q->{'.globals'}->{'FATAL'},   '_store_globals(), 9' );
ok( !defined $q->{'.globals'}->{'USE_CGI_PM_DEFAULTS'},
  '_store_globals(), 10' );
$q->_store_globals();

ok( defined $q->{'.globals'}->{'DISABLE_UPLOADS'},
  '_store_globals(), 11' );
ok( defined $q->{'.globals'}->{'POST_MAX'}, '_store_globals(), 12' );
ok( defined $q->{'.globals'}->{'NO_UNDEF_PARAMS'},
  '_store_globals(), 13' );
ok( defined $q->{'.globals'}->{'USE_PARAM_SEMICOLONS'},
  '_store_globals(), 14' );
ok( defined $q->{'.globals'}->{'HEADERS_ONCE'},
  '_store_globals(), 15' );
ok( defined $q->{'.globals'}->{'NPH'},     '_store_globals(), 16' );
ok( defined $q->{'.globals'}->{'DEBUG'},   '_store_globals(), 17' );
ok( defined $q->{'.globals'}->{'NO_NULL'}, '_store_globals(), 18' );
ok( defined $q->{'.globals'}->{'FATAL'},   '_store_globals(), 19' );
ok( defined $q->{'.globals'}->{'USE_CGI_PM_DEFAULTS'},
  '_store_globals(), 20' );

# import() - used to set paragmas
my @args
 = qw( -default -no_upload -unique_header -nph -no_debug -newstyle_url -no_undef_param );

undef_globals();

$q->import( @args );

is( $CGI::Simple::USE_CGI_PM_DEFAULTS,  1, 'import(), 1' );
is( $CGI::Simple::DISABLE_UPLOADS,      1, 'import(), 2' );
is( $CGI::Simple::NO_UNDEF_PARAMS,      1, 'import(), 3' );
is( $CGI::Simple::USE_PARAM_SEMICOLONS, 1, 'import(), 4' );
is( $CGI::Simple::HEADERS_ONCE,         1, 'import(), 5' );
is( $CGI::Simple::NPH,                  1, 'import(), 6' );
is( $CGI::Simple::DEBUG,                0, 'import(), 7' );
undef_globals();

$q->import( qw ( -upload -oldstyle_url  -debug  ) );

is( $CGI::Simple::DISABLE_UPLOADS,      0, 'import(), 8' );
is( $CGI::Simple::USE_PARAM_SEMICOLONS, 0, 'import(), 9' );
is( $CGI::Simple::DEBUG,                2, 'import(), 10' );
undef_globals();

# _reset_globals()
$q->_reset_globals();
is( $CGI::Simple::DISABLE_UPLOADS,      0,  '_reset_globals(), 1' );
is( $CGI::Simple::POST_MAX,             -1, '_reset_globals(), 2' );
is( $CGI::Simple::NO_UNDEF_PARAMS,      0,  '_reset_globals(), 3' );
is( $CGI::Simple::USE_PARAM_SEMICOLONS, 1,  '_reset_globals(), 4' );
is( $CGI::Simple::HEADERS_ONCE,         0,  '_reset_globals(), 5' );
is( $CGI::Simple::NPH,                  0,  '_reset_globals(), 6' );
is( $CGI::Simple::DEBUG,                1,  '_reset_globals(), 7' );
is( $CGI::Simple::NO_NULL,              0,  '_reset_globals(), 8' );
is( $CGI::Simple::FATAL,                -1, '_reset_globals(), 9' );
undef_globals();

$q = CGI::Simple->new;

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

# url_decode() - scalar context, valid argument
my ( $string, $enc_string );
for ( 32 .. 255 ) {
  $string .= chr;
  $enc_string .= uc sprintf "%%%02x", ord chr;
}
is( $q->url_decode( $enc_string ),
  $string, 'url_decode(\$enc_string), 1' );

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

# url_encode() - scalar context, valid argument
$sv = $q->url_encode( $string );
$sv =~ tr/+/ /;
$sv =~ s/%([a-fA-F0-9]{2})/ pack "C", hex $1 /eg;
is( $sv, $string, 'url_encode(\$string), 1' );

# url encoding - circular test
is( $q->url_decode( $q->url_encode( $string ) ),
  $string, 'url encoding via circular test, 1' );

# new() plain constructor
$q = CGI::Simple->new;
like( $q, qr/CGI::Simple/, 'new() plain constructor, 1' );

# new('') empty constructor
$q = CGI::Simple->new( '' );
like( $q, qr/CGI::Simple/, 'new() empty constructor, 1' );
$q = CGI::Simple->new( {} );
like( $q, qr/CGI::Simple/, 'new() empty constructor, 2' );

# new() hash constructor
$q = CGI::Simple->new( { 'foo' => '1', 'bar' => [ 2, 3, 4 ] } );

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

);

# append() - scalar and array context, set values
$sv = $q->append( 'foo', 'some', 'new',  'values' );
@av = $q->append( 'foo', 'even', 'more', 'stuff' );
is( $sv, 'bar',
  'append( \'foo\', \'some\', \'new\', \'values\' ) set values, 1' );
is(
  join( ' ', @av ),
  'bar some some-more some new values even more stuff',
  'append( \'foo\', \'some\', \'new\', \'values\' ) set values, 2'
);

# append() - scalar and array context
$sv = $q->append( -name => 'foo', -value => 'baz' );
@av = $q->append( -name => 'foo', -value => 'xyz' );
is( $sv, 'bar',
  'append( -name=>\'foo\', -value=>\'bar\' ) set values, 1' );
is(
  join( ' ', @av ),
  'bar some some-more some new values even more stuff baz xyz',
  'append( -name=>\'foo\', -value=>\'bar\' ) set values, 2'
);

# append() - scalar and array context
$sv = $q->append( -name => 'foo', -value => [ 1, 2 ] );
@av = $q->append( -name => 'foo', -value => [ 3, 4 ] );
is( $sv, 'bar',
  'append(-name=>\'foo\',-value=>[\'bar\',\'baz\']) set values, 1' );
is(
  join( ' ', @av ),
  'bar some some-more some new values even more stuff baz xyz 1 2 3 4',
  'append(-name=>\'foo\',-value=>[\'bar\',\'baz\']) set values, 2'
);

# delete() - void/valid argument
$q->delete();
is( join( ' ', $q->param ), 'name color foo invalid', 'delete(), 1' );
$q->delete( 'foo' );
is( join( ' ', $q->param ), 'name color invalid', 'delete(), 2' );

# Delete() - void/valid argument
$q->Delete();
is( join( ' ', $q->param ), 'name color invalid', 'Delete(), 1' );
$q->Delete( 'invalid' );
is( join( ' ', $q->param ), 'name color', 'Delete(), 2' );

# delete_all() - scalar and array context, void/invalid/valid argument
$q->delete_all();
is( join( '', $q->param ), '', 'delete_all(), 1' );
is( $q->globals, '11', 'delete_all(), 2' );
$ENV{'CONTENT_TYPE'} = 'NOT multipart/form-data';
$q = CGI::Simple->new;

# delete_all() - scalar and array context, void/invalid/valid argument
is( join( ' ', $q->param ), 'name color', 'Delete_all(), 1' );
$q->Delete_all();
is( join( '', $q->param ), '', 'Delete_all(), 2' );
$ENV{'CONTENT_TYPE'} = 'application/x-www-form-urlencoded';

# upload() - invalid CONTENT_TYPE
$sv = $q->upload( 'foo' );
is( $sv, undef, 'upload() - invalid CONTENT_TYPE, 1' );
is(
  $q->cgi_error(),
  'Oops! File uploads only work if you specify ENCTYPE="multipart/form-data" in your <FORM> tag',
  'upload() - invalid CONTENT_TYPE, 2'
);
$ENV{'CONTENT_TYPE'} = 'multipart/form-data';

# upload() - scalar and array context, void/invalid/valid argument
$sv = $q->upload();
@av = $q->upload();
is( $sv, undef, 'upload() - no files available, 1' );
is( join( ' ', @av ), '', 'upload() - no files available, 2' );

# upload() - scalar and array context, files available, void arg
$q->{'.filehandles'}->{$_} = $_ for qw( File1 File2 File3 );
$sv                        = $q->upload();
@av                        = $q->upload();
is( $sv, 3, 'upload() - files available, 1' );
is(
  join( ' ', sort @av ),
  'File1 File2 File3',
  'upload() - files available, 2'
);
$q->{'.filehandles'} = {};

# upload() - scalar context, valid argument
open FH, $tmpfile or carp "Can't read $tmpfile $!\n";
my $data = join '', <FH>;
is( $data && 1, 1, 'upload(\'/some/path/to/myfile\') - real files, 1' );
seek FH, 0, 0;
$q->{'.filehandles'}->{'/some/path/to/myfile'} = \*FH;
my $handle = $q->upload( '/some/path/to/myfile' );
my $upload = join '', <$handle>;
is( $upload, $data,
  'upload(\'/some/path/to/myfile\') - real files, 2' );

# upload() - scalar context, invalid argument
$sv = $q->upload( 'invalid' );
is( $sv, undef, 'upload(\'invalid\'), 1' );
is(
  $q->cgi_error,
  "No filehandle for 'invalid'. Are uploads enabled (\$DISABLE_UPLOADS = 0)? Is \$POST_MAX big enough?",
  'upload(\'invalid\'), 2'
);
my $ok = $q->upload( '/some/path/to/myfile', "$tmpfile.bak" );
is( $ok, 1, 'upload(\'invalid\'), 3' );
open $handle, "$tmpfile.bak" or carp "Can't read $tmpfile.bak $!\n";
$upload = join '', <$handle>;
is( $upload, $data, 'upload(\'invalid\'), 4' );
$sv = $q->upload( '/some/path/to/myfile', "$tmpfile.bak" );
is( $sv, undef, 'upload(\'invalid\'), 5' );
close($handle);
unlink $tmpfile, "$tmpfile.bak";

$ENV{'CONTENT_TYPE'} = 'application/x-www-form-urlencoded';
$q = CGI::Simple->new;

# query_string() - scalar and array context, void/invalid/valid argument
$sv = $q->query_string();
is(
  $sv,
  'name=JaPh%2C&color=red&color=green&color=blue',
  'query_string(), 1'
);

# parse_query_string()
$q->delete_all;
is( $q->param, 0, 'parse_query_string(), 1' );
$ENV{'REQUEST_METHOD'} = 'POST';
$q->parse_query_string();
$sv = $q->query_string();
is(
  $sv,
  'name=JaPh%2C&color=red&color=green&color=blue',
  'parse_query_string(), 2'
);
$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(