"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 ('<&>'), '&#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 
   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 }