"Fossies" - the Fresh Open Source Software Archive 
Member "CGI-Lite-3.02/t/basic.t" (19 May 2018, 5399 Bytes) of package /linux/www/CGI-Lite-3.02.tar.gz:
As a special service "Fossies" has tried to format the requested text file into HTML format (style:
standard) with prefixed line numbers.
Alternatively you can here
view or
download the uninterpreted source code file.
See also the latest
Fossies "Diffs" side-by-side code changes report for "basic.t":
3.01_vs_3.02.
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
20 use strict;
21 use warnings;
22
23 use Test::More tests => 322;
24
25 use lib './lib';
26
27 # Test exits and outputs;
28 my $have_test_trap;
29 our $trap; # Imported
30 BEGIN {
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
42 is ($CGI::Lite::VERSION, '3.02', 'Version test');
43 is (CGI::Lite::Version (), $CGI::Lite::VERSION, 'Version subroutine test');
44
45 my $cgi = CGI::Lite->new ();
46
47 is (ref $cgi, 'CGI::Lite', 'New');
48
49 is ($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
61 my $dangerous = ';<>*|`&$!#()[]{}:\'"';
62
63 for 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
73 for my $platform (qw/WINdows WINdows95 dos nt pc/) {
74 $cgi->set_platform ($platform);
75 is ($cgi->{platform}, 'PC', "Set platform ($platform)");
76 }
77 for my $platform (qw/mac MacIntosh/) {
78 $cgi->set_platform ($platform);
79 is ($cgi->{platform}, 'Mac', "Set platform ($platform)");
80 }
81
82 is ($cgi->set_platform(), undef, 'Set platform (undef) returns undef');
83 is ($cgi->{platform}, 'Mac', "Set platform (undef) - platform unchanged");
84
85 # Unix is default
86 $cgi->set_platform ('foo');
87 is ($cgi->{platform}, 'Unix', "Set default platform");
88
89 is ($cgi->wrap_textarea (), undef, 'No text to wrap');
90 my $longstr = '123 456 789 0123456 7 89 0';
91 is ($cgi->wrap_textarea ($longstr, 5), "123\n456\n789\n0123456\n7 89\n0",
92 "wrap_textarea Unix");
93 $cgi->set_platform ("DOS");
94 is ($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");
97 is ($cgi->wrap_textarea ($longstr, 5), "123\r456\r789\r0123456\r7 89\r0",
98 "wrap_textarea Mac");
99
100 is ($cgi->is_error(), 0, 'No errors');
101 is ($cgi->get_error_message, undef, 'No error message');
102
103 is ($cgi->get_multiple_values (), undef,
104 'get_multiple_values (no argument)');
105 is ($cgi->get_multiple_values ('foo'), 'foo',
106 'get_multiple_values (scalar argument)');
107 is ($cgi->get_multiple_values ('foo', 'bar'), 'foo',
108 'get_multiple_values (array argument)');
109 my $foobar = ['foo', 'bar'];
110 my @res = $cgi->get_multiple_values ($foobar);
111 is_deeply (\@res, $foobar, 'get_multiple_values (array ref argument)');
112
113 like ($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.
126 SKIP: {
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 }