1# 2#=============================================================================== 3# 4# FILE: basic.t 5# 6# DESCRIPTION: Test of the most basic functionality 7# 8# FILES: --- 9# BUGS: --- 10# NOTES: --- 11# AUTHOR: Pete Houston (cpan@openstrike.co.uk) 12# COMPANY: Openstrike 13# CREATED: 13/05/14 21:36:53 14# 15# Updates: 16# 21/08/2014 Now tests set_platform, wrap_textarea and get_error_message. 17# 25/08/2014 Now tests get_multiple values. 18#=============================================================================== 19 20use strict; 21use warnings; 22 23use Test::More tests => 322; 24 25use lib './lib'; 26 27# Test exits and outputs; 28my $have_test_trap; 29our $trap; # Imported 30BEGIN { 31 eval { 32 require Test::Trap; 33 Test::Trap->import (qw/trap $trap :flow 34 :stderr(systemsafe) 35 :stdout(systemsafe) 36 :warn/); 37 $have_test_trap = 1; 38 }; 39 use_ok ('CGI::Lite'); 40} 41 42is ($CGI::Lite::VERSION, '3.03', 'Version test'); 43is (CGI::Lite::Version (), $CGI::Lite::VERSION, 'Version subroutine test'); 44 45my $cgi = CGI::Lite->new (); 46 47is (ref $cgi, 'CGI::Lite', 'New'); 48 49is ($cgi->browser_escape ('<&>'), '<&>', 'browser_escape'); 50 51{ 52 my @from = split (/ /, q/! " # $ % ^ & * ( ) _ + - =/); 53 my @to = qw/%21 %22 %23 %24 %25 %5E %26 %2A %28 %29 _ %2B - %3D/; 54 55 for my $i (0..$#from) { 56 is ($cgi->url_encode($from[$i]), $to[$i], "url_encode $from[$i]"); 57 is ($cgi->url_decode($to[$i]), $from[$i], "url_decode $to[$i]"); 58 } 59} 60 61my $dangerous = ';<>*|`&$!#()[]{}:\'"'; 62 63for my $i(0..255) { 64 my $chr = chr($i); 65 if (index ($dangerous, $chr) eq -1) { 66 # Not 67 is ($cgi->is_dangerous ($chr), 0, "Dangerous $i (not)"); 68 } else { 69 is ($cgi->is_dangerous ($chr), 1, "Dangerous $i"); 70 } 71} 72 73for my $platform (qw/WINdows WINdows95 dos nt pc/) { 74 $cgi->set_platform ($platform); 75 is ($cgi->{platform}, 'PC', "Set platform ($platform)"); 76} 77for my $platform (qw/mac MacIntosh/) { 78 $cgi->set_platform ($platform); 79 is ($cgi->{platform}, 'Mac', "Set platform ($platform)"); 80} 81 82is ($cgi->set_platform(), undef, 'Set platform (undef) returns undef'); 83is ($cgi->{platform}, 'Mac', "Set platform (undef) - platform unchanged"); 84 85# Unix is default 86$cgi->set_platform ('foo'); 87is ($cgi->{platform}, 'Unix', "Set default platform"); 88 89is ($cgi->wrap_textarea (), undef, 'No text to wrap'); 90my $longstr = '123 456 789 0123456 7 89 0'; 91is ($cgi->wrap_textarea ($longstr, 5), "123\n456\n789\n0123456\n7 89\n0", 92 "wrap_textarea Unix"); 93$cgi->set_platform ("DOS"); 94is ($cgi->wrap_textarea ($longstr, 5), "123\r\n456\r\n789\r\n0123456\r\n7 89\r\n0", 95 "wrap_textarea DOS"); 96$cgi->set_platform ("Mac"); 97is ($cgi->wrap_textarea ($longstr, 5), "123\r456\r789\r0123456\r7 89\r0", 98 "wrap_textarea Mac"); 99 100is ($cgi->is_error(), 0, 'No errors'); 101is ($cgi->get_error_message, undef, 'No error message'); 102 103is ($cgi->get_multiple_values (), undef, 104 'get_multiple_values (no argument)'); 105is ($cgi->get_multiple_values ('foo'), 'foo', 106 'get_multiple_values (scalar argument)'); 107is ($cgi->get_multiple_values ('foo', 'bar'), 'foo', 108 'get_multiple_values (array argument)'); 109my $foobar = ['foo', 'bar']; 110my @res = $cgi->get_multiple_values ($foobar); 111is_deeply (\@res, $foobar, 'get_multiple_values (array ref argument)'); 112 113like ($cgi->_get_file_name ('Unix', '/tmp', ''), qr/^\d+__/, 114 'Missing filename'); 115 116{ 117 no strict 'vars'; # Makes the whole thing pointless 118 no warnings 'once'; 119 $cgi->create_variables ({foo => 'bar', boing => 'quux'}); 120 is ($foo, 'bar', 'Create variables 1'); 121 is ($boing, 'quux', 'Create variables 2'); 122} 123 124# Use Test::Trap where available to test wanrings and terminating 125# functions. 126SKIP: { 127 skip "Test::Trap not available", 10 unless $have_test_trap; 128 my @r = trap { browser_escape ('a') }; 129 like ($trap->stderr, 130 qr/Non-method use of browser_escape is deprecated/, 131 'Warning calling browser_escape as non-method'); 132 @r = trap { url_encode ('a') }; 133 like ($trap->stderr, 134 qr/Non-method use of url_encode is deprecated/, 135 'Warning calling url_encode as non-method'); 136 @r = trap { url_decode ('a') }; 137 like ($trap->stderr, 138 qr/Non-method use of url_decode is deprecated/, 139 'Warning calling url_decode as non-method'); 140 @r = trap { is_dangerous ('a') }; 141 like ($trap->stderr, 142 qr/Non-method use of is_dangerous is deprecated/, 143 'Warning calling is_dangerous as non-method'); 144 @r = trap { $cgi->return_error ('Hello', 'World!') }; 145 is ($trap->exit, 1, 'return_error exits'); 146 is ($trap->stdout, "Hello World!\n", 'return_error prints'); 147 148 # Same, but use child class 149 { 150 package MyChild; 151 use base 'CGI::Lite'; 152 } 153 my $child = MyChild->new; 154 155 @r = trap { $child->browser_escape ('a') }; 156 unlike ($trap->stderr, 157 qr/Non-method use of browser_escape is deprecated/, 158 'No warning calling browser_escape as child method'); 159 @r = trap { $child->url_encode ('a') }; 160 unlike ($trap->stderr, 161 qr/Non-method use of url_encode is deprecated/, 162 'No warning calling url_encode as child method'); 163 @r = trap { $child->url_decode ('a') }; 164 unlike ($trap->stderr, 165 qr/Non-method use of url_decode is deprecated/, 166 'No warning calling url_decode as child method'); 167 @r = trap { $child->is_dangerous ('a') }; 168 unlike ($trap->stderr, 169 qr/Non-method use of is_dangerous is deprecated/, 170 'No warning calling is_dangerous as child method'); 171} 172