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 ('<&>'), '&#60;&#38;&#62;', '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