summaryrefslogtreecommitdiff
path: root/cpan/CGI/t
diff options
context:
space:
mode:
Diffstat (limited to 'cpan/CGI/t')
-rw-r--r--cpan/CGI/t/Dump.t5
-rw-r--r--cpan/CGI/t/apache.t13
-rw-r--r--cpan/CGI/t/can.t12
-rw-r--r--cpan/CGI/t/carp.t280
-rw-r--r--cpan/CGI/t/cookie.t375
-rw-r--r--cpan/CGI/t/fast.t37
-rw-r--r--cpan/CGI/t/form.t177
-rw-r--r--cpan/CGI/t/function.t117
-rw-r--r--cpan/CGI/t/html.t113
-rw-r--r--cpan/CGI/t/no_tabindex.t126
-rw-r--r--cpan/CGI/t/popup_menu.t15
-rw-r--r--cpan/CGI/t/pretty.t121
-rw-r--r--cpan/CGI/t/push.t85
-rw-r--r--cpan/CGI/t/query_string.t16
-rw-r--r--cpan/CGI/t/request.t99
-rw-r--r--cpan/CGI/t/start_end_asterisk.t72
-rw-r--r--cpan/CGI/t/start_end_end.t72
-rw-r--r--cpan/CGI/t/start_end_start.t72
-rw-r--r--cpan/CGI/t/switch.t13
-rw-r--r--cpan/CGI/t/unescapeHTML.t11
-rw-r--r--cpan/CGI/t/upload.t151
-rw-r--r--cpan/CGI/t/uploadInfo.t90
-rw-r--r--cpan/CGI/t/upload_post_text.txtbin0 -> 3286 bytes
-rw-r--r--cpan/CGI/t/user_agent.t15
-rw-r--r--cpan/CGI/t/util-58.t29
-rw-r--r--cpan/CGI/t/util.t51
26 files changed, 2167 insertions, 0 deletions
diff --git a/cpan/CGI/t/Dump.t b/cpan/CGI/t/Dump.t
new file mode 100644
index 0000000000..fafb5b22eb
--- /dev/null
+++ b/cpan/CGI/t/Dump.t
@@ -0,0 +1,5 @@
+use Test::More 'no_plan';
+use CGI;
+my $cgi = CGI->new('<a>=<b>');
+like($cgi->Dump, qr/\Q&lt;a&gt;/, 'param names are HTML escaped by Dump()');
+like($cgi->Dump, qr/\Q&lt;b&gt;/, 'param values are HTML escaped by Dump()');
diff --git a/cpan/CGI/t/apache.t b/cpan/CGI/t/apache.t
new file mode 100644
index 0000000000..7f92155c3f
--- /dev/null
+++ b/cpan/CGI/t/apache.t
@@ -0,0 +1,13 @@
+#!/usr/local/bin/perl -w
+
+use lib qw(t/lib);
+
+# Due to a bug in older versions of MakeMaker & Test::Harness, we must
+# ensure the blib's are in @INC, else we might use the core CGI.pm
+use lib qw(blib/lib blib/arch);
+
+use strict;
+use Test::More tests => 1;
+
+# Can't do much with this other than make sure it loads properly
+BEGIN { use_ok('CGI::Apache') };
diff --git a/cpan/CGI/t/can.t b/cpan/CGI/t/can.t
new file mode 100644
index 0000000000..720eb493e8
--- /dev/null
+++ b/cpan/CGI/t/can.t
@@ -0,0 +1,12 @@
+#!/usr/local/bin/perl -w
+
+# Due to a bug in older versions of MakeMaker & Test::Harness, we must
+# ensure the blib's are in @INC, else we might use the core CGI.pm
+
+use lib qw(blib/lib blib/arch);
+
+use Test::More tests => 2;
+
+BEGIN{ use_ok('CGI'); }
+
+can_ok('CGI', qw/cookie param/); \ No newline at end of file
diff --git a/cpan/CGI/t/carp.t b/cpan/CGI/t/carp.t
new file mode 100644
index 0000000000..6d20a4fe9d
--- /dev/null
+++ b/cpan/CGI/t/carp.t
@@ -0,0 +1,280 @@
+# -*- Mode: cperl; coding: utf-8; cperl-indent-level: 2 -*-
+#!/usr/local/bin/perl -w
+
+use strict;
+use lib qw(t/lib);
+
+# Due to a bug in older versions of MakeMaker & Test::Harness, we must
+# ensure the blib's are in @INC, else we might use the core CGI.pm
+use lib qw(blib/lib blib/arch);
+
+use Test::More tests => 41;
+use IO::Handle;
+
+BEGIN { use_ok('CGI::Carp') };
+
+#-----------------------------------------------------------------------------
+# Test id
+#-----------------------------------------------------------------------------
+
+# directly invoked
+my $expect_f = __FILE__;
+my $expect_l = __LINE__ + 1;
+my ($file, $line, $id) = CGI::Carp::id(0);
+is($file, $expect_f, "file");
+is($line, $expect_l, "line");
+is($id, "carp.t", "id");
+
+# one level of indirection
+sub id1 { my $level = shift; return CGI::Carp::id($level); };
+
+$expect_l = __LINE__ + 1;
+($file, $line, $id) = id1(1);
+is($file, $expect_f, "file");
+is($line, $expect_l, "line");
+is($id, "carp.t", "id");
+
+# two levels of indirection
+sub id2 { my $level = shift; return id1($level); };
+
+$expect_l = __LINE__ + 1;
+($file, $line, $id) = id2(2);
+is($file, $expect_f, "file");
+is($line, $expect_l, "line");
+is($id, "carp.t", "id");
+
+#-----------------------------------------------------------------------------
+# Test stamp
+#-----------------------------------------------------------------------------
+
+my $stamp = "/^\\[
+ ([a-z]{3}\\s){2}\\s?
+ [\\s\\d:]+
+ \\]\\s$id:/ix";
+
+like(CGI::Carp::stamp(),
+ $stamp,
+ "Time in correct format");
+
+sub stamp1 {return CGI::Carp::stamp()};
+sub stamp2 {return stamp1()};
+
+like(stamp2(), $stamp, "Time in correct format");
+
+#-----------------------------------------------------------------------------
+# Test warn and _warn
+#-----------------------------------------------------------------------------
+
+# set some variables to control what's going on.
+$CGI::Carp::WARN = 0;
+$CGI::Carp::EMIT_WARNINGS = 0;
+my $q_file = quotemeta($file);
+
+
+# Test that realwarn is called
+{
+ local $^W = 0;
+ eval "sub CGI::Carp::realwarn {return 'Called realwarn'};";
+}
+
+$expect_l = __LINE__ + 1;
+is(CGI::Carp::warn("There is a problem"),
+ "Called realwarn",
+ "CGI::Carp::warn calls CORE::warn");
+
+# Test that message is constructed correctly
+eval 'sub CGI::Carp::realwarn {my $mess = shift; return $mess};';
+
+$expect_l = __LINE__ + 1;
+like(CGI::Carp::warn("There is a problem"),
+ "/] $id: There is a problem at $q_file line $expect_l.".'$/',
+ "CGI::Carp::warn builds correct message");
+
+# Test that _warn is called at the correct time
+$CGI::Carp::WARN = 1;
+
+my $warn_expect_l = $expect_l = __LINE__ + 1;
+like(CGI::Carp::warn("There is a problem"),
+ "/] $id: There is a problem at $q_file line $expect_l.".'$/',
+ "CGI::Carp::warn builds correct message");
+
+#-----------------------------------------------------------------------------
+# Test ineval
+#-----------------------------------------------------------------------------
+
+ok(!CGI::Carp::ineval, 'ineval returns false when not in eval');
+eval {ok(CGI::Carp::ineval, 'ineval returns true when in eval');};
+
+#-----------------------------------------------------------------------------
+# Test die
+#-----------------------------------------------------------------------------
+
+# set some variables to control what's going on.
+$CGI::Carp::WRAP = 0;
+
+$expect_l = __LINE__ + 1;
+eval { CGI::Carp::die('There is a problem'); };
+like($@,
+ '/^There is a problem/',
+ 'CGI::Carp::die calls CORE::die without altering argument in eval');
+
+# Test that realwarn is called
+{
+ local $^W = 0;
+ eval 'sub CGI::Carp::realdie {my $mess = shift; return $mess};';
+}
+
+like(CGI::Carp::die('There is a problem'),
+ $stamp,
+ 'CGI::Carp::die calls CORE::die, but adds stamp');
+
+#-----------------------------------------------------------------------------
+# Test set_message
+#-----------------------------------------------------------------------------
+
+is(CGI::Carp::set_message('My new Message'),
+ 'My new Message',
+ 'CGI::Carp::set_message returns new message');
+
+is($CGI::Carp::CUSTOM_MSG,
+ 'My new Message',
+ 'CGI::Carp::set_message message set correctly');
+
+# set the message back to the empty string so that the tests later
+# work properly.
+CGI::Carp::set_message(''),
+
+#-----------------------------------------------------------------------------
+# Test set_progname
+#-----------------------------------------------------------------------------
+
+import CGI::Carp qw(name=new_progname);
+is($CGI::Carp::PROGNAME,
+ 'new_progname',
+ 'CGI::Carp::import set program name correctly');
+
+is(CGI::Carp::set_progname('newer_progname'),
+ 'newer_progname',
+ 'CGI::Carp::set_progname returns new program name');
+
+is($CGI::Carp::PROGNAME,
+ 'newer_progname',
+ 'CGI::Carp::set_progname program name set correctly');
+
+# set the message back to the empty string so that the tests later
+# work properly.
+is (CGI::Carp::set_progname(undef),undef,"CGI::Carp::set_progname returns unset name correctly");
+is ($CGI::Carp::PROGNAME,undef,"CGI::Carp::set_progname program name unset correctly");
+
+#-----------------------------------------------------------------------------
+# Test warnings_to_browser
+#-----------------------------------------------------------------------------
+
+CGI::Carp::warningsToBrowser(0);
+is($CGI::Carp::EMIT_WARNINGS, 0, "Warnings turned off");
+
+# turn off STDOUT (prevents spurious warnings to screen
+tie *STDOUT, 'StoreStuff' or die "Can't tie STDOUT";
+CGI::Carp::warningsToBrowser(1);
+my $fake_out = join '', <STDOUT>;
+untie *STDOUT;
+
+open(STDOUT, ">&REAL_STDOUT");
+my $fname = $0;
+$fname =~ tr/<>-/\253\273\255/; # _warn does this so we have to also
+is( $fake_out, "<!-- warning: There is a problem at $fname line $warn_expect_l. -->\n",
+ 'warningsToBrowser() on' );
+
+is($CGI::Carp::EMIT_WARNINGS, 1, "Warnings turned off");
+
+#-----------------------------------------------------------------------------
+# Test fatals_to_browser
+#-----------------------------------------------------------------------------
+
+package StoreStuff;
+
+sub TIEHANDLE {
+ my $class = shift;
+ bless [], $class;
+}
+
+sub PRINT {
+ my $self = shift;
+ push @$self, @_;
+}
+
+sub READLINE {
+ my $self = shift;
+ shift @$self;
+}
+
+package main;
+
+tie *STDOUT, "StoreStuff";
+
+# do tests
+my @result;
+
+CGI::Carp::fatalsToBrowser();
+$result[0] .= $_ while (<STDOUT>);
+
+CGI::Carp::fatalsToBrowser('Message to the world');
+$result[1] .= $_ while (<STDOUT>);
+
+$ENV{SERVER_ADMIN} = 'foo@bar.com';
+CGI::Carp::fatalsToBrowser();
+$result[2] .= $_ while (<STDOUT>);
+
+CGI::Carp::set_message('Override the message passed in'),
+
+CGI::Carp::fatalsToBrowser('Message to the world');
+$result[3] .= $_ while (<STDOUT>);
+CGI::Carp::set_message(''),
+delete $ENV{SERVER_ADMIN};
+
+# now restore STDOUT
+untie *STDOUT;
+
+
+like($result[0],
+ '/Content-type: text/html/',
+ "Default string has header");
+
+ok($result[0] !~ /Message to the world/, "Custom message not in default string");
+
+like($result[1],
+ '/Message to the world/',
+ "Custom Message appears in output");
+
+ok($result[0] !~ /foo\@bar.com/, "Server Admin does not appear in default message");
+
+like($result[2],
+ '/foo@bar.com/',
+ "Server Admin appears in output");
+
+like($result[3],
+ '/Message to the world/',
+ "Custom message not in result");
+
+like($result[3],
+ '/Override the message passed in/',
+ "Correct message in string");
+
+#-----------------------------------------------------------------------------
+# Test to_filehandle
+#-----------------------------------------------------------------------------
+
+sub buffer {
+ CGI::Carp::to_filehandle (@_);
+}
+
+tie *STORE, "StoreStuff";
+
+require FileHandle;
+my $fh = FileHandle->new;
+
+ok( defined buffer(\*STORE), '\*STORE returns proper filehandle');
+ok( defined buffer( $fh ), '$fh returns proper filehandle');
+ok( defined buffer('::STDOUT'), 'STDIN returns proper filehandle');
+ok( defined buffer(*main::STDOUT), 'STDIN returns proper filehandle');
+ok(!defined buffer("WIBBLE"), '"WIBBLE" doesn\'t returns proper filehandle');
diff --git a/cpan/CGI/t/cookie.t b/cpan/CGI/t/cookie.t
new file mode 100644
index 0000000000..539ac7a26e
--- /dev/null
+++ b/cpan/CGI/t/cookie.t
@@ -0,0 +1,375 @@
+#!/usr/local/bin/perl -w
+
+use lib qw(t/lib);
+use strict;
+
+# Due to a bug in older versions of MakeMaker & Test::Harness, we must
+# ensure the blib's are in @INC, else we might use the core CGI.pm
+use lib qw(blib/lib blib/arch);
+
+use Test::More tests => 96;
+use CGI::Util qw(escape unescape);
+use POSIX qw(strftime);
+
+#-----------------------------------------------------------------------------
+# make sure module loaded
+#-----------------------------------------------------------------------------
+
+BEGIN {use_ok('CGI::Cookie');}
+
+my @test_cookie = (
+ 'foo=123; bar=qwerty; baz=wibble; qux=a1',
+ 'foo=123; bar=qwerty; baz=wibble;',
+ 'foo=vixen; bar=cow; baz=bitch; qux=politician',
+ 'foo=a%20phrase; bar=yes%2C%20a%20phrase; baz=%5Ewibble; qux=%27',
+ );
+
+#-----------------------------------------------------------------------------
+# Test parse
+#-----------------------------------------------------------------------------
+
+{
+ my $result = CGI::Cookie->parse($test_cookie[0]);
+
+ is(ref($result), 'HASH', "Hash ref returned in scalar context");
+
+ my @result = CGI::Cookie->parse($test_cookie[0]);
+
+ is(@result, 8, "returns correct number of fields");
+
+ @result = CGI::Cookie->parse($test_cookie[1]);
+
+ is(@result, 6, "returns correct number of fields");
+
+ my %result = CGI::Cookie->parse($test_cookie[0]);
+
+ is($result{foo}->value, '123', "cookie foo is correct");
+ is($result{bar}->value, 'qwerty', "cookie bar is correct");
+ is($result{baz}->value, 'wibble', "cookie baz is correct");
+ is($result{qux}->value, 'a1', "cookie qux is correct");
+}
+
+#-----------------------------------------------------------------------------
+# Test fetch
+#-----------------------------------------------------------------------------
+
+{
+ # make sure there are no cookies in the environment
+ delete $ENV{HTTP_COOKIE};
+ delete $ENV{COOKIE};
+
+ my %result = CGI::Cookie->fetch();
+ ok(keys %result == 0, "No cookies in environment, returns empty list");
+
+ # now set a cookie in the environment and try again
+ $ENV{HTTP_COOKIE} = $test_cookie[2];
+ %result = CGI::Cookie->fetch();
+ ok(eq_set([keys %result], [qw(foo bar baz qux)]),
+ "expected cookies extracted");
+
+ is(ref($result{foo}), 'CGI::Cookie', 'Type of objects returned is correct');
+ is($result{foo}->value, 'vixen', "cookie foo is correct");
+ is($result{bar}->value, 'cow', "cookie bar is correct");
+ is($result{baz}->value, 'bitch', "cookie baz is correct");
+ is($result{qux}->value, 'politician', "cookie qux is correct");
+
+ # Delete that and make sure it goes away
+ delete $ENV{HTTP_COOKIE};
+ %result = CGI::Cookie->fetch();
+ ok(keys %result == 0, "No cookies in environment, returns empty list");
+
+ # try another cookie in the other environment variable thats supposed to work
+ $ENV{COOKIE} = $test_cookie[3];
+ %result = CGI::Cookie->fetch();
+ ok(eq_set([keys %result], [qw(foo bar baz qux)]),
+ "expected cookies extracted");
+
+ is(ref($result{foo}), 'CGI::Cookie', 'Type of objects returned is correct');
+ is($result{foo}->value, 'a phrase', "cookie foo is correct");
+ is($result{bar}->value, 'yes, a phrase', "cookie bar is correct");
+ is($result{baz}->value, '^wibble', "cookie baz is correct");
+ is($result{qux}->value, "'", "cookie qux is correct");
+}
+
+#-----------------------------------------------------------------------------
+# Test raw_fetch
+#-----------------------------------------------------------------------------
+
+{
+ # make sure there are no cookies in the environment
+ delete $ENV{HTTP_COOKIE};
+ delete $ENV{COOKIE};
+
+ my %result = CGI::Cookie->raw_fetch();
+ ok(keys %result == 0, "No cookies in environment, returns empty list");
+
+ # now set a cookie in the environment and try again
+ $ENV{HTTP_COOKIE} = $test_cookie[2];
+ %result = CGI::Cookie->raw_fetch();
+ ok(eq_set([keys %result], [qw(foo bar baz qux)]),
+ "expected cookies extracted");
+
+ is(ref($result{foo}), '', 'Plain scalar returned');
+ is($result{foo}, 'vixen', "cookie foo is correct");
+ is($result{bar}, 'cow', "cookie bar is correct");
+ is($result{baz}, 'bitch', "cookie baz is correct");
+ is($result{qux}, 'politician', "cookie qux is correct");
+
+ # Delete that and make sure it goes away
+ delete $ENV{HTTP_COOKIE};
+ %result = CGI::Cookie->raw_fetch();
+ ok(keys %result == 0, "No cookies in environment, returns empty list");
+
+ # try another cookie in the other environment variable thats supposed to work
+ $ENV{COOKIE} = $test_cookie[3];
+ %result = CGI::Cookie->raw_fetch();
+ ok(eq_set([keys %result], [qw(foo bar baz qux)]),
+ "expected cookies extracted");
+
+ is(ref($result{foo}), '', 'Plain scalar returned');
+ is($result{foo}, 'a%20phrase', "cookie foo is correct");
+ is($result{bar}, 'yes%2C%20a%20phrase', "cookie bar is correct");
+ is($result{baz}, '%5Ewibble', "cookie baz is correct");
+ is($result{qux}, '%27', "cookie qux is correct");
+}
+
+#-----------------------------------------------------------------------------
+# Test new
+#-----------------------------------------------------------------------------
+
+{
+ # Try new with full information provided
+ my $c = CGI::Cookie->new(-name => 'foo',
+ -value => 'bar',
+ -expires => '+3M',
+ -domain => '.capricorn.com',
+ -path => '/cgi-bin/database',
+ -secure => 1
+ );
+ is(ref($c), 'CGI::Cookie', 'new returns objects of correct type');
+ is($c->name , 'foo', 'name is correct');
+ is($c->value , 'bar', 'value is correct');
+ like($c->expires, '/^[a-z]{3},\s*\d{2}-[a-z]{3}-\d{4}/i', 'expires in correct format');
+ is($c->domain , '.capricorn.com', 'domain is correct');
+ is($c->path , '/cgi-bin/database', 'path is correct');
+ ok($c->secure , 'secure attribute is set');
+
+ # now try it with the only two manditory values (should also set the default path)
+ $c = CGI::Cookie->new(-name => 'baz',
+ -value => 'qux',
+ );
+ is(ref($c), 'CGI::Cookie', 'new returns objects of correct type');
+ is($c->name , 'baz', 'name is correct');
+ is($c->value , 'qux', 'value is correct');
+ ok(!defined $c->expires, 'expires is not set');
+ ok(!defined $c->domain , 'domain attributeis not set');
+ is($c->path, '/', 'path atribute is set to default');
+ ok(!defined $c->secure , 'secure attribute is set');
+
+# I'm really not happy about the restults of this section. You pass
+# the new method invalid arguments and it just merilly creates a
+# broken object :-)
+# I've commented them out because they currently pass but I don't
+# think they should. I think this is testing broken behaviour :-(
+
+# # This shouldn't work
+# $c = CGI::Cookie->new(-name => 'baz' );
+#
+# is(ref($c), 'CGI::Cookie', 'new returns objects of correct type');
+# is($c->name , 'baz', 'name is correct');
+# ok(!defined $c->value, "Value is undefined ");
+# ok(!defined $c->expires, 'expires is not set');
+# ok(!defined $c->domain , 'domain attributeis not set');
+# is($c->path , '/', 'path atribute is set to default');
+# ok(!defined $c->secure , 'secure attribute is set');
+
+}
+
+#-----------------------------------------------------------------------------
+# Test as_string
+#-----------------------------------------------------------------------------
+
+{
+ my $c = CGI::Cookie->new(-name => 'Jam',
+ -value => 'Hamster',
+ -expires => '+3M',
+ -domain => '.pie-shop.com',
+ -path => '/',
+ -secure => 1
+ );
+
+ my $name = $c->name;
+ like($c->as_string, "/$name/", "Stringified cookie contains name");
+
+ my $value = $c->value;
+ like($c->as_string, "/$value/", "Stringified cookie contains value");
+
+ my $expires = $c->expires;
+ like($c->as_string, "/$expires/", "Stringified cookie contains expires");
+
+ my $domain = $c->domain;
+ like($c->as_string, "/$domain/", "Stringified cookie contains domain");
+
+ my $path = $c->path;
+ like($c->as_string, "/$path/", "Stringified cookie contains path");
+
+ like($c->as_string, '/secure/', "Stringified cookie contains secure");
+
+ $c = CGI::Cookie->new(-name => 'Hamster-Jam',
+ -value => 'Tulip',
+ );
+
+ $name = $c->name;
+ like($c->as_string, "/$name/", "Stringified cookie contains name");
+
+ $value = $c->value;
+ like($c->as_string, "/$value/", "Stringified cookie contains value");
+
+ ok($c->as_string !~ /expires/, "Stringified cookie has no expires field");
+
+ ok($c->as_string !~ /domain/, "Stringified cookie has no domain field");
+
+ $path = $c->path;
+ like($c->as_string, "/$path/", "Stringified cookie contains path");
+
+ ok($c->as_string !~ /secure/, "Stringified cookie does not contain secure");
+}
+
+#-----------------------------------------------------------------------------
+# Test compare
+#-----------------------------------------------------------------------------
+
+{
+ my $c1 = CGI::Cookie->new(-name => 'Jam',
+ -value => 'Hamster',
+ -expires => '+3M',
+ -domain => '.pie-shop.com',
+ -path => '/',
+ -secure => 1
+ );
+
+ # have to use $c1->expires because the time will occasionally be
+ # different between the two creates causing spurious failures.
+ my $c2 = CGI::Cookie->new(-name => 'Jam',
+ -value => 'Hamster',
+ -expires => $c1->expires,
+ -domain => '.pie-shop.com',
+ -path => '/',
+ -secure => 1
+ );
+
+ # This looks titally whacked, but it does the -1, 0, 1 comparison
+ # thing so 0 means they match
+ is($c1->compare("$c1"), 0, "Cookies are identical");
+ is($c1->compare("$c2"), 0, "Cookies are identical");
+
+ $c1 = CGI::Cookie->new(-name => 'Jam',
+ -value => 'Hamster',
+ -domain => '.foo.bar.com'
+ );
+
+ # have to use $c1->expires because the time will occasionally be
+ # different between the two creates causing spurious failures.
+ $c2 = CGI::Cookie->new(-name => 'Jam',
+ -value => 'Hamster',
+ );
+
+ # This looks titally whacked, but it does the -1, 0, 1 comparison
+ # thing so 0 (i.e. false) means they match
+ is($c1->compare("$c1"), 0, "Cookies are identical");
+ ok($c1->compare("$c2"), "Cookies are not identical");
+
+ $c2->domain('.foo.bar.com');
+ is($c1->compare("$c2"), 0, "Cookies are identical");
+}
+
+#-----------------------------------------------------------------------------
+# Test name, value, domain, secure, expires and path
+#-----------------------------------------------------------------------------
+
+{
+ my $c = CGI::Cookie->new(-name => 'Jam',
+ -value => 'Hamster',
+ -expires => '+3M',
+ -domain => '.pie-shop.com',
+ -path => '/',
+ -secure => 1
+ );
+
+ is($c->name, 'Jam', 'name is correct');
+ is($c->name('Clash'), 'Clash', 'name is set correctly');
+ is($c->name, 'Clash', 'name now returns updated value');
+
+ # this is insane! it returns a simple scalar but can't accept one as
+ # an argument, you have to give it an arrary ref. It's totally
+ # inconsitent with these other methods :-(
+ is($c->value, 'Hamster', 'value is correct');
+ is($c->value(['Gerbil']), 'Gerbil', 'value is set correctly');
+ is($c->value, 'Gerbil', 'value now returns updated value');
+
+ my $exp = $c->expires;
+ like($c->expires, '/^[a-z]{3},\s*\d{2}-[a-z]{3}-\d{4}/i', 'expires is correct');
+ like($c->expires('+12h'), '/^[a-z]{3},\s*\d{2}-[a-z]{3}-\d{4}/i', 'expires is set correctly');
+ like($c->expires, '/^[a-z]{3},\s*\d{2}-[a-z]{3}-\d{4}/i', 'expires now returns updated value');
+ isnt($c->expires, $exp, "Expiry time has changed");
+
+ is($c->domain, '.pie-shop.com', 'domain is correct');
+ is($c->domain('.wibble.co.uk'), '.wibble.co.uk', 'domain is set correctly');
+ is($c->domain, '.wibble.co.uk', 'domain now returns updated value');
+
+ is($c->path, '/', 'path is correct');
+ is($c->path('/basket/'), '/basket/', 'path is set correctly');
+ is($c->path, '/basket/', 'path now returns updated value');
+
+ ok($c->secure, 'secure attribute is set');
+ ok(!$c->secure(0), 'secure attribute is cleared');
+ ok(!$c->secure, 'secure attribute is cleared');
+}
+
+#-----------------------------------------------------------------------------
+# Apache2?::Cookie compatibility.
+#-----------------------------------------------------------------------------
+APACHEREQ: {
+ my $r = Apache::Faker->new;
+ isa_ok $r, 'Apache';
+ ok my $c = CGI::Cookie->new(
+ $r,
+ -name => 'Foo',
+ -value => 'Bar',
+ ), 'Pass an Apache object to the CGI::Cookie constructor';
+ isa_ok $c, 'CGI::Cookie';
+ ok $c->bake($r), 'Bake the cookie';
+ ok eq_array( $r->{check}, [ 'Set-Cookie', $c->as_string ]),
+ 'bake() should call headers_out->set()';
+
+ $r = Apache2::Faker->new;
+ isa_ok $r, 'Apache2::RequestReq';
+ ok $c = CGI::Cookie->new(
+ $r,
+ -name => 'Foo',
+ -value => 'Bar',
+ ), 'Pass an Apache::RequestReq object to the CGI::Cookie constructor';
+ isa_ok $c, 'CGI::Cookie';
+ ok $c->bake($r), 'Bake the cookie';
+ ok eq_array( $r->{check}, [ 'Set-Cookie', $c->as_string ]),
+ 'bake() should call headers_out->set()';
+}
+
+
+package Apache::Faker;
+sub new { bless {}, shift }
+sub isa {
+ my ($self, $pkg) = @_;
+ return $pkg eq 'Apache';
+}
+sub headers_out { shift }
+sub add { shift->{check} = \@_; }
+
+package Apache2::Faker;
+sub new { bless {}, shift }
+sub isa {
+ my ($self, $pkg) = @_;
+ return $pkg eq 'Apache2::RequestReq';
+}
+sub headers_out { shift }
+sub add { shift->{check} = \@_; }
diff --git a/cpan/CGI/t/fast.t b/cpan/CGI/t/fast.t
new file mode 100644
index 0000000000..45f8e1271c
--- /dev/null
+++ b/cpan/CGI/t/fast.t
@@ -0,0 +1,37 @@
+#!./perl -w
+
+use lib qw(t/lib);
+
+# Due to a bug in older versions of MakeMaker & Test::Harness, we must
+# ensure the blib's are in @INC, else we might use the core CGI.pm
+use lib qw(blib/lib blib/arch);
+
+my $fcgi;
+BEGIN {
+ local $@;
+ eval { require FCGI };
+ $fcgi = $@ ? 0 : 1;
+}
+
+use Test::More tests => 7;
+
+# Shut up "used only once" warnings.
+() = $CGI::Q;
+() = $CGI::Fast::Ext_Request;
+
+SKIP: {
+ skip( 'FCGI not installed, cannot continue', 7 ) unless $fcgi;
+
+ use_ok( CGI::Fast );
+ ok( my $q = CGI::Fast->new(), 'created new CGI::Fast object' );
+ is( $q, $CGI::Q, 'checking to see if the object was stored properly' );
+ is( $q->param(), (), 'no params' );
+
+ ok( $q = CGI::Fast->new({ foo => 'bar' }), 'creating obect with params' );
+ is( $q->param('foo'), 'bar', 'checking passed param' );
+
+ # if this is false, the package var will be empty
+ $ENV{FCGI_SOCKET_PATH} = 0;
+ is( $CGI::Fast::Ext_Request, '', 'checking no active request' );
+
+}
diff --git a/cpan/CGI/t/form.t b/cpan/CGI/t/form.t
new file mode 100644
index 0000000000..b532db9841
--- /dev/null
+++ b/cpan/CGI/t/form.t
@@ -0,0 +1,177 @@
+#!/usr/local/bin/perl -w
+
+use Test::More tests => 22;
+
+BEGIN { use_ok('CGI'); };
+use CGI (':standard','-no_debug','-tabindex');
+
+my $CRLF = "\015\012";
+if ($^O eq 'VMS') {
+ $CRLF = "\n"; # via web server carriage is inserted automatically
+}
+if (ord("\t") != 9) { # EBCDIC?
+ $CRLF = "\r\n";
+}
+
+
+# Set up a CGI environment
+$ENV{REQUEST_METHOD} = 'GET';
+$ENV{QUERY_STRING} = 'game=chess&game=checkers&weather=dull';
+$ENV{PATH_INFO} = '/somewhere/else';
+$ENV{PATH_TRANSLATED} = '/usr/local/somewhere/else';
+$ENV{SCRIPT_NAME} ='/cgi-bin/foo.cgi';
+$ENV{SERVER_PROTOCOL} = 'HTTP/1.0';
+$ENV{SERVER_PORT} = 8080;
+$ENV{SERVER_NAME} = 'the.good.ship.lollypop.com';
+
+is(start_form(-action=>'foobar',-method=>'get'),
+ qq(<form method="get" action="foobar" enctype="multipart/form-data">\n),
+ "start_form()");
+
+is(submit(),
+ qq(<input type="submit" tabindex="1" name=".submit" />),
+ "submit()");
+
+is(submit(-name => 'foo',
+ -value => 'bar'),
+ qq(<input type="submit" tabindex="2" name="foo" value="bar" />),
+ "submit(-name,-value)");
+
+is(submit({-name => 'foo',
+ -value => 'bar'}),
+ qq(<input type="submit" tabindex="3" name="foo" value="bar" />),
+ "submit({-name,-value})");
+
+is(textfield(-name => 'weather'),
+ qq(<input type="text" name="weather" tabindex="4" value="dull" />),
+ "textfield({-name})");
+
+is(textfield(-name => 'weather',
+ -value => 'nice'),
+ qq(<input type="text" name="weather" tabindex="5" value="dull" />),
+ "textfield({-name,-value})");
+
+is(textfield(-name => 'weather',
+ -value => 'nice',
+ -override => 1),
+ qq(<input type="text" name="weather" tabindex="6" value="nice" />),
+ "textfield({-name,-value,-override})");
+
+is(checkbox(-name => 'weather',
+ -value => 'nice'),
+ qq(<label><input type="checkbox" name="weather" value="nice" tabindex="7" />weather</label>),
+ "checkbox()");
+
+is(checkbox(-name => 'weather',
+ -value => 'nice',
+ -label => 'forecast'),
+ qq(<label><input type="checkbox" name="weather" value="nice" tabindex="8" />forecast</label>),
+ "checkbox()");
+
+is(checkbox(-name => 'weather',
+ -value => 'nice',
+ -label => 'forecast',
+ -checked => 1,
+ -override => 1),
+ qq(<label><input type="checkbox" name="weather" value="nice" tabindex="9" checked="checked" />forecast</label>),
+ "checkbox()");
+
+is(checkbox(-name => 'weather',
+ -value => 'dull',
+ -label => 'forecast'),
+ qq(<label><input type="checkbox" name="weather" value="dull" tabindex="10" checked="checked" />forecast</label>),
+ "checkbox()");
+
+is(radio_group(-name => 'game'),
+ qq(<label><input type="radio" name="game" value="chess" checked="checked" tabindex="11" />chess</label> <label><input type="radio" name="game" value="checkers" tabindex="12" />checkers</label>),
+ 'radio_group()');
+
+is(radio_group(-name => 'game',
+ -labels => {'chess' => 'ping pong'}),
+ qq(<label><input type="radio" name="game" value="chess" checked="checked" tabindex="13" />ping pong</label> <label><input type="radio" name="game" value="checkers" tabindex="14" />checkers</label>),
+ 'radio_group()');
+
+is(checkbox_group(-name => 'game',
+ -Values => [qw/checkers chess cribbage/]),
+ qq(<label><input type="checkbox" name="game" value="checkers" checked="checked" tabindex="15" />checkers</label> <label><input type="checkbox" name="game" value="chess" checked="checked" tabindex="16" />chess</label> <label><input type="checkbox" name="game" value="cribbage" tabindex="17" />cribbage</label>),
+ 'checkbox_group()');
+
+is(checkbox_group(-name => 'game',
+ '-values' => [qw/checkers chess cribbage/],
+ '-defaults' => ['cribbage'],
+ -override=>1),
+ qq(<label><input type="checkbox" name="game" value="checkers" tabindex="18" />checkers</label> <label><input type="checkbox" name="game" value="chess" tabindex="19" />chess</label> <label><input type="checkbox" name="game" value="cribbage" checked="checked" tabindex="20" />cribbage</label>),
+ 'checkbox_group()');
+
+is(popup_menu(-name => 'game',
+ '-values' => [qw/checkers chess cribbage/],
+ -default => 'cribbage',
+ -override => 1),
+ '<select name="game" tabindex="21" >
+<option value="checkers">checkers</option>
+<option value="chess">chess</option>
+<option selected="selected" value="cribbage">cribbage</option>
+</select>',
+ 'popup_menu()');
+is(scrolling_list(-name => 'game',
+ '-values' => [qw/checkers chess cribbage/],
+ -default => 'cribbage',
+ -override=>1),
+ '<select name="game" tabindex="22" size="3">
+<option value="checkers">checkers</option>
+<option value="chess">chess</option>
+<option selected="selected" value="cribbage">cribbage</option>
+</select>',
+ 'scrolling_list()');
+
+is(checkbox_group(-name => 'game',
+ -Values => [qw/checkers chess cribbage/],
+ -disabled => ['checkers']),
+ qq(<label><input type="checkbox" name="game" value="checkers" checked="checked" tabindex="23" disabled='1'/><span style="color:gray">checkers</span></label> <label><input type="checkbox" name="game" value="chess" checked="checked" tabindex="24" />chess</label> <label><input type="checkbox" name="game" value="cribbage" tabindex="25" />cribbage</label>),
+ 'checkbox_group()');
+
+my $optgroup = optgroup(-name=>'optgroup_name',
+ -Values => ['moe','catch'],
+ -attributes=>{'catch'=>{'class'=>'red'}});
+
+is($optgroup,
+ qq(<optgroup label="optgroup_name">
+<option value="moe">moe</option>
+<option class="red" value="catch">catch</option>
+</optgroup>),
+ 'optgroup()');
+
+is(popup_menu(-name=>'menu_name',
+ -Values=>[qw/eenie meenie minie/, $optgroup],
+ -labels=>{'eenie'=>'one',
+ 'meenie'=>'two',
+ 'minie'=>'three'},
+ -default=>'meenie'),
+ qq(<select name="menu_name" tabindex="26" >
+<option value="eenie">one</option>
+<option selected="selected" value="meenie">two</option>
+<option value="minie">three</option>
+<optgroup label="optgroup_name">
+<option value="moe">moe</option>
+<option class="red" value="catch">catch</option>
+</optgroup>
+</select>),
+ 'popup_menu() + optgroup()');
+
+is(scrolling_list(-name=>'menu_name',
+ -Values=>[qw/eenie meenie minie/, $optgroup],
+ -labels=>{'eenie'=>'one',
+ 'meenie'=>'two',
+ 'minie'=>'three'},
+ -default=>'meenie'),
+ qq(<select name="menu_name" tabindex="27" size="4">
+<option value="eenie">one</option>
+<option selected="selected" value="meenie">two</option>
+<option value="minie">three</option>
+<optgroup label="optgroup_name">
+<option value="moe">moe</option>
+<option class="red" value="catch">catch</option>
+</optgroup>
+</select>),
+ 'scrolling_list() + optgroup()');
+
diff --git a/cpan/CGI/t/function.t b/cpan/CGI/t/function.t
new file mode 100644
index 0000000000..4ff67d581b
--- /dev/null
+++ b/cpan/CGI/t/function.t
@@ -0,0 +1,117 @@
+#!/usr/local/bin/perl -w
+
+use lib qw(t/lib);
+
+# Test ability to retrieve HTTP request info
+######################### We start with some black magic to print on failure.
+use lib '.','..','../blib/lib','../blib/arch';
+
+BEGIN {$| = 1; print "1..32\n"; }
+END {print "not ok 1\n" unless $loaded;}
+use Config;
+use CGI (':standard','keywords');
+$loaded = 1;
+print "ok 1\n";
+
+######################### End of black magic.
+
+# util
+sub test {
+ local($^W) = 0;
+ my($num, $true,$msg) = @_;
+ print($true ? "ok $num\n" : "not ok $num $msg\n");
+}
+
+my $CRLF = "\015\012";
+
+# A peculiarity of sending "\n" through MBX|Socket|web-server on VMS
+# is that a CR character gets inserted automatically in the web server
+# case but not internal to perl's double quoted strings "\n". This
+# test would need to be modified to use the "\015\012" on VMS if it
+# were actually run through a web server.
+# Thanks to Peter Prymmer for this
+
+if ($^O eq 'VMS') { $CRLF = "\n"; }
+
+# Web servers on EBCDIC hosts are typically set up to do an EBCDIC -> ASCII
+# translation hence CRLF is used as \r\n within CGI.pm on such machines.
+
+if (ord("\t") != 9) { $CRLF = "\r\n"; }
+
+# Web servers on EBCDIC hosts are typically set up to do an EBCDIC -> ASCII
+# translation hence CRLF is used as \r\n within CGI.pm on such machines.
+
+if (ord("\t") != 9) { $CRLF = "\r\n"; }
+
+# Set up a CGI environment
+$ENV{REQUEST_METHOD}='GET';
+$ENV{QUERY_STRING} ='game=chess&game=checkers&weather=dull';
+$ENV{PATH_INFO} ='/somewhere/else';
+$ENV{PATH_TRANSLATED} ='/usr/local/somewhere/else';
+$ENV{SCRIPT_NAME} ='/cgi-bin/foo.cgi';
+$ENV{SERVER_PROTOCOL} = 'HTTP/1.0';
+$ENV{SERVER_PORT} = 8080;
+$ENV{SERVER_NAME} = 'the.good.ship.lollypop.com';
+$ENV{HTTP_LOVE} = 'true';
+
+test(2,request_method() eq 'GET',"CGI::request_method()");
+test(3,query_string() eq 'game=chess;game=checkers;weather=dull',"CGI::query_string()");
+test(4,param() == 2,"CGI::param()");
+test(5,join(' ',sort {$a cmp $b} param()) eq 'game weather',"CGI::param()");
+test(6,param('game') eq 'chess',"CGI::param()");
+test(7,param('weather') eq 'dull',"CGI::param()");
+test(8,join(' ',param('game')) eq 'chess checkers',"CGI::param()");
+test(9,param(-name=>'foo',-value=>'bar'),'CGI::param() put');
+test(10,param(-name=>'foo') eq 'bar','CGI::param() get');
+test(11,query_string() eq 'game=chess;game=checkers;weather=dull;foo=bar',"CGI::query_string() redux");
+test(12,http('love') eq 'true',"CGI::http()");
+test(13,script_name() eq '/cgi-bin/foo.cgi',"CGI::script_name()");
+test(14,url() eq 'http://the.good.ship.lollypop.com:8080/cgi-bin/foo.cgi',"CGI::url()");
+test(15,self_url() eq
+ 'http://the.good.ship.lollypop.com:8080/cgi-bin/foo.cgi/somewhere/else?game=chess;game=checkers;weather=dull;foo=bar',
+ "CGI::url()");
+test(16,url(-absolute=>1) eq '/cgi-bin/foo.cgi','CGI::url(-absolute=>1)');
+test(17,url(-relative=>1) eq 'foo.cgi','CGI::url(-relative=>1)');
+test(18,url(-relative=>1,-path=>1) eq 'foo.cgi/somewhere/else','CGI::url(-relative=>1,-path=>1)');
+test(19,url(-relative=>1,-path=>1,-query=>1) eq
+ 'foo.cgi/somewhere/else?game=chess;game=checkers;weather=dull;foo=bar',
+ 'CGI::url(-relative=>1,-path=>1,-query=>1)');
+Delete('foo');
+test(20,!param('foo'),'CGI::delete()');
+
+CGI::_reset_globals();
+$ENV{QUERY_STRING}='mary+had+a+little+lamb';
+test(21,join(' ',keywords()) eq 'mary had a little lamb','CGI::keywords');
+test(22,join(' ',param('keywords')) eq 'mary had a little lamb','CGI::keywords');
+
+CGI::_reset_globals;
+if ($Config{d_fork}) {
+ $test_string = 'game=soccer&game=baseball&weather=nice';
+ $ENV{REQUEST_METHOD}='POST';
+ $ENV{CONTENT_LENGTH}=length($test_string);
+ $ENV{QUERY_STRING}='big_balls=basketball&small_balls=golf';
+ if (open(CHILD,"|-")) { # cparent
+ print CHILD $test_string;
+ close CHILD;
+ exit 0;
+ }
+ # at this point, we're in a new (child) process
+ test(23,param('weather') eq 'nice',"CGI::param() from POST");
+ test(24,(url_param('big_balls') eq 'basketball'),"CGI::url_param()");
+} else {
+ print "ok 23 # Skip\n";
+ print "ok 24 # Skip\n";
+}
+test(25,redirect('http://somewhere.else') eq "Status: 302 Found${CRLF}Location: http://somewhere.else${CRLF}${CRLF}","CGI::redirect() 1");
+my $h = redirect(-Location=>'http://somewhere.else',-Type=>'text/html');
+test(26,$h eq "Status: 302 Found${CRLF}Location: http://somewhere.else${CRLF}Content-Type: text/html; charset=ISO-8859-1${CRLF}${CRLF}","CGI::redirect() 2");
+test(27,redirect(-Location=>'http://somewhere.else/bin/foo&bar',-Type=>'text/html') eq "Status: 302 Found${CRLF}Location: http://somewhere.else/bin/foo&bar${CRLF}Content-Type: text/html; charset=ISO-8859-1${CRLF}${CRLF}","CGI::redirect() 2");
+
+test(28,escapeHTML('CGI') eq 'CGI','escapeHTML(CGI) failing again');
+
+test(29, charset("UTF-8") && header() eq "Content-Type: text/html; charset=UTF-8${CRLF}${CRLF}", "UTF-8 charset");
+test(30, !charset("") && header() eq "Content-Type: text/html${CRLF}${CRLF}", "Empty charset");
+
+test(31, header(-foo=>'bar') eq "Foo: bar${CRLF}Content-Type: text/html${CRLF}${CRLF}", "Custom header");
+
+test(32, start_form(-action=>'one',name=>'two',onsubmit=>'three') eq qq(<form method="post" action="one" enctype="multipart/form-data" onsubmit="three" name="two">\n), "initial dash followed by undashed arguments");
diff --git a/cpan/CGI/t/html.t b/cpan/CGI/t/html.t
new file mode 100644
index 0000000000..49cc595950
--- /dev/null
+++ b/cpan/CGI/t/html.t
@@ -0,0 +1,113 @@
+#!/usr/local/bin/perl -w
+
+# Test ability to retrieve HTTP request info
+######################### We start with some black magic to print on failure.
+use lib '../blib/lib','../blib/arch';
+
+END {print "not ok 1\n" unless $loaded;}
+use CGI (':standard','-no_debug','*h3','start_table');
+$loaded = 1;
+print "ok 1\n";
+
+BEGIN {
+ $| = 1; print "1..28\n";
+ if( $] > 5.006 ) {
+ # no utf8
+ require utf8; # we contain Latin-1
+ utf8->unimport;
+ }
+}
+
+######################### End of black magic.
+
+my $CRLF = "\015\012";
+if ($^O eq 'VMS') {
+ $CRLF = "\n"; # via web server carriage is inserted automatically
+}
+if (ord("\t") != 9) { # EBCDIC?
+ $CRLF = "\r\n";
+}
+
+
+# util
+sub test {
+ local($^W) = 0;
+ my($num, $true,$msg) = @_;
+ print($true ? "ok $num\n" : "not ok $num $msg\n");
+}
+
+# all the automatic tags
+test(2,h1() eq '<h1 />',"single tag");
+test(3,h1('fred') eq '<h1>fred</h1>',"open/close tag");
+test(4,h1('fred','agnes','maura') eq '<h1>fred agnes maura</h1>',"open/close tag multiple");
+test(5,h1({-align=>'CENTER'},'fred') eq '<h1 align="CENTER">fred</h1>',"open/close tag with attribute");
+test(6,h1({-align=>undef},'fred') eq '<h1 align>fred</h1>',"open/close tag with orphan attribute");
+test(7,h1({-align=>'CENTER'},['fred','agnes']) eq
+ '<h1 align="CENTER">fred</h1> <h1 align="CENTER">agnes</h1>',
+ "distributive tag with attribute");
+{
+ local($") = '-';
+ test(8,h1('fred','agnes','maura') eq '<h1>fred-agnes-maura</h1>',"open/close tag \$\" interpolation");
+}
+test(9,header() eq "Content-Type: text/html; charset=ISO-8859-1${CRLF}${CRLF}","header()");
+test(10,header(-type=>'image/gif') eq "Content-Type: image/gif${CRLF}${CRLF}","header()");
+test(11,header(-type=>'image/gif',-status=>'500 Sucks') eq "Status: 500 Sucks${CRLF}Content-Type: image/gif${CRLF}${CRLF}","header()");
+test(12,header(-nph=>1) =~ m!HTTP/1.0 200 OK${CRLF}Server: cmdline${CRLF}Date:.+${CRLF}Content-Type: text/html; charset=ISO-8859-1${CRLF}${CRLF}!,"header()");
+test(13,start_html() eq <<END,"start_html()");
+<!DOCTYPE html
+ PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN"
+ "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
+<html xmlns="http://www.w3.org/1999/xhtml" lang="en-US" xml:lang="en-US">
+<head>
+<title>Untitled Document</title>
+<meta http-equiv="Content-Type" content="text/html; charset=iso-8859-1" />
+</head>
+<body>
+END
+ ;
+test(14,start_html(-Title=>'The world of foo') eq <<END,"start_html()");
+<!DOCTYPE html
+ PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN"
+ "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
+<html xmlns="http://www.w3.org/1999/xhtml" lang="en-US" xml:lang="en-US">
+<head>
+<title>The world of foo</title>
+<meta http-equiv="Content-Type" content="text/html; charset=iso-8859-1" />
+</head>
+<body>
+END
+ ;
+# Note that this test will turn off XHTML until we make a new CGI object.
+test(15,start_html(-dtd=>"-//IETF//DTD HTML 3.2//FR",-lang=>'fr') eq <<END,"start_html()");
+<!DOCTYPE html
+ PUBLIC "-//IETF//DTD HTML 3.2//FR">
+<html lang="fr"><head><title>Untitled Document</title>
+</head>
+<body>
+END
+ ;
+test(16,($cookie=cookie(-name=>'fred',-value=>['chocolate','chip'],-path=>'/')) eq 'fred=chocolate&chip; path=/',"cookie()");
+my $h = header(-Cookie=>$cookie);
+test(17,$h =~ m!^Set-Cookie: fred=chocolate&chip\; path=/${CRLF}Date:.*${CRLF}Content-Type: text/html; charset=ISO-8859-1${CRLF}${CRLF}!s,
+ "header(-cookie)");
+test(18,start_h3 eq '<h3>');
+test(19,end_h3 eq '</h3>');
+test(20,start_table({-border=>undef}) eq '<table border>');
+test(21,h1(escapeHTML("this is <not> \x8bright\x9b")) eq '<h1>this is &lt;not&gt; &#8249;right&#8250;</h1>');
+charset('utf-8');
+if (ord("\t") == 9) {
+test(22,h1(escapeHTML("this is <not> \x8bright\x9b")) eq '<h1>this is &lt;not&gt; ‹right›</h1>');
+}
+else {
+test(22,h1(escapeHTML("this is <not> \x8bright\x9b")) eq '<h1>this is &lt;not&gt; »rightº</h1>');
+}
+test(23,i(p('hello there')) eq '<i><p>hello there</p></i>');
+my $q = new CGI;
+test(24,$q->h1('hi') eq '<h1>hi</h1>');
+
+$q->autoEscape(1);
+test(25,$q->p({title=>"hello world&egrave;"},'hello &aacute;') eq '<p title="hello world&amp;egrave;">hello &aacute;</p>');
+$q->autoEscape(0);
+test(26,$q->p({title=>"hello world&egrave;"},'hello &aacute;') eq '<p title="hello world&egrave;">hello &aacute;</p>');
+test(27,p({title=>"hello world&egrave;"},'hello &aacute;') eq '<p title="hello world&amp;egrave;">hello &aacute;</p>');
+test(28,header(-type=>'image/gif',-charset=>'UTF-8') eq "Content-Type: image/gif; charset=UTF-8${CRLF}${CRLF}","header()");
diff --git a/cpan/CGI/t/no_tabindex.t b/cpan/CGI/t/no_tabindex.t
new file mode 100644
index 0000000000..c9a7fb8fb6
--- /dev/null
+++ b/cpan/CGI/t/no_tabindex.t
@@ -0,0 +1,126 @@
+#!/usr/local/bin/perl -w
+
+# Due to a bug in older versions of MakeMaker & Test::Harness, we must
+# ensure the blib's are in @INC, else we might use the core CGI.pm
+use lib qw(. ./blib/lib ./blib/arch);
+
+use Test::More tests => 18;
+
+BEGIN { use_ok('CGI'); };
+use CGI (':standard','-no_debug');
+
+my $CRLF = "\015\012";
+if ($^O eq 'VMS') {
+ $CRLF = "\n"; # via web server carriage is inserted automatically
+}
+if (ord("\t") != 9) { # EBCDIC?
+ $CRLF = "\r\n";
+}
+
+
+# Set up a CGI environment
+$ENV{REQUEST_METHOD} = 'GET';
+$ENV{QUERY_STRING} = 'game=chess&game=checkers&weather=dull';
+$ENV{PATH_INFO} = '/somewhere/else';
+$ENV{PATH_TRANSLATED} = '/usr/local/somewhere/else';
+$ENV{SCRIPT_NAME} ='/cgi-bin/foo.cgi';
+$ENV{SERVER_PROTOCOL} = 'HTTP/1.0';
+$ENV{SERVER_PORT} = 8080;
+$ENV{SERVER_NAME} = 'the.good.ship.lollypop.com';
+
+ok( (not $CGI::TABINDEX), "Tab index turned off.");
+
+is(submit(),
+ qq(<input type="submit" name=".submit" />),
+ "submit()");
+
+is(submit(-name => 'foo',
+ -value => 'bar'),
+ qq(<input type="submit" name="foo" value="bar" />),
+ "submit(-name,-value)");
+
+is(submit({-name => 'foo',
+ -value => 'bar'}),
+ qq(<input type="submit" name="foo" value="bar" />),
+ "submit({-name,-value})");
+
+is(textfield(-name => 'weather'),
+ qq(<input type="text" name="weather" value="dull" />),
+ "textfield({-name})");
+
+is(textfield(-name => 'weather',
+ -value => 'nice'),
+ qq(<input type="text" name="weather" value="dull" />),
+ "textfield({-name,-value})");
+
+is(textfield(-name => 'weather',
+ -value => 'nice',
+ -override => 1),
+ qq(<input type="text" name="weather" value="nice" />),
+ "textfield({-name,-value,-override})");
+
+is(checkbox(-name => 'weather',
+ -value => 'nice'),
+ qq(<label><input type="checkbox" name="weather" value="nice" />weather</label>),
+ "checkbox()");
+
+is(checkbox(-name => 'weather',
+ -value => 'nice',
+ -label => 'forecast'),
+ qq(<label><input type="checkbox" name="weather" value="nice" />forecast</label>),
+ "checkbox()");
+
+is(checkbox(-name => 'weather',
+ -value => 'nice',
+ -label => 'forecast',
+ -checked => 1,
+ -override => 1),
+ qq(<label><input type="checkbox" name="weather" value="nice" checked="checked" />forecast</label>),
+ "checkbox()");
+
+is(checkbox(-name => 'weather',
+ -value => 'dull',
+ -label => 'forecast'),
+ qq(<label><input type="checkbox" name="weather" value="dull" checked="checked" />forecast</label>),
+ "checkbox()");
+
+is(radio_group(-name => 'game'),
+ qq(<label><input type="radio" name="game" value="chess" checked="checked" />chess</label> <label><input type="radio" name="game" value="checkers" />checkers</label>),
+ 'radio_group()');
+
+is(radio_group(-name => 'game',
+ -labels => {'chess' => 'ping pong'}),
+ qq(<label><input type="radio" name="game" value="chess" checked="checked" />ping pong</label> <label><input type="radio" name="game" value="checkers" />checkers</label>),
+ 'radio_group()');
+
+is(checkbox_group(-name => 'game',
+ -Values => [qw/checkers chess cribbage/]),
+ qq(<label><input type="checkbox" name="game" value="checkers" checked="checked" />checkers</label> <label><input type="checkbox" name="game" value="chess" checked="checked" />chess</label> <label><input type="checkbox" name="game" value="cribbage" />cribbage</label>),
+ 'checkbox_group()');
+
+is(checkbox_group(-name => 'game',
+ '-values' => [qw/checkers chess cribbage/],
+ '-defaults' => ['cribbage'],
+ -override=>1),
+ qq(<label><input type="checkbox" name="game" value="checkers" />checkers</label> <label><input type="checkbox" name="game" value="chess" />chess</label> <label><input type="checkbox" name="game" value="cribbage" checked="checked" />cribbage</label>),
+ 'checkbox_group()');
+
+is(popup_menu(-name => 'game',
+ '-values' => [qw/checkers chess cribbage/],
+ -default => 'cribbage',
+ -override => 1),
+ '<select name="game" >
+<option value="checkers">checkers</option>
+<option value="chess">chess</option>
+<option selected="selected" value="cribbage">cribbage</option>
+</select>',
+ 'popup_menu()');
+
+
+is(textarea(-name=>'foo',
+ -default=>'starting value',
+ -rows=>10,
+ -columns=>50),
+ '<textarea name="foo" rows="10" cols="50">starting value</textarea>',
+ 'textarea()');
+
diff --git a/cpan/CGI/t/popup_menu.t b/cpan/CGI/t/popup_menu.t
new file mode 100644
index 0000000000..3c7d33ee62
--- /dev/null
+++ b/cpan/CGI/t/popup_menu.t
@@ -0,0 +1,15 @@
+#!perl
+# Tests for popup_menu();
+use lib 't/lib';
+use Test::More 'no_plan';
+use CGI;
+
+my $q = CGI->new;
+
+is ( $q->popup_menu(-name=>"foo", - values=>[0,1], -default=>0),
+'<select name="foo" >
+<option selected="selected" value="0">0</option>
+<option value="1">1</option>
+</select>'
+, 'popup_menu(): basic test, including 0 as a default value');
+
diff --git a/cpan/CGI/t/pretty.t b/cpan/CGI/t/pretty.t
new file mode 100644
index 0000000000..d3c19c0c98
--- /dev/null
+++ b/cpan/CGI/t/pretty.t
@@ -0,0 +1,121 @@
+#!/bin/perl -w
+
+use strict;
+use lib '.', 't/lib','../blib/lib','./blib/lib';
+use Test::More tests => 18;
+
+BEGIN { use_ok('CGI::Pretty') };
+
+# This is silly use_ok should take arguments
+use CGI::Pretty (':all');
+
+is(h1(), '<h1 />
+',"single tag");
+
+is(ol(li('fred'),li('ethel')), <<HTML, "basic indentation");
+<ol>
+ <li>
+ fred
+ </li>
+ <li>
+ ethel
+ </li>
+</ol>
+HTML
+
+
+is(p('hi',pre('there'),'frog'), <<HTML, "<pre> tags");
+<p>
+ hi <pre>there</pre>
+ frog
+</p>
+HTML
+
+is(h1({-align=>'CENTER'},'fred'), <<HTML, "open/close tag with attribute");
+<h1 align="CENTER">
+ fred
+</h1>
+HTML
+
+is(h1({-align=>undef},'fred'), <<HTML,"open/close tag with orphan attribute");
+<h1 align>
+ fred
+</h1>
+HTML
+
+is(h1({-align=>'CENTER'},['fred','agnes']), <<HTML, "distributive tag with attribute");
+<h1 align="CENTER">
+ fred
+</h1>
+<h1 align="CENTER">
+ agnes
+</h1>
+HTML
+
+is(p('hi',a({-href=>'frog'},'there'),'frog'), <<HTML, "as-is");
+<p>
+ hi <a href="frog">there</a>
+ frog
+</p>
+HTML
+
+is(p([ qw( hi there frog ) ] ), <<HTML, "array-reference");
+<p>
+ hi
+</p>
+<p>
+ there
+</p>
+<p>
+ frog
+</p>
+HTML
+
+is(p(p(p('hi'), 'there' ), 'frog'), <<HTML, "nested tags");
+<p>
+ <p>
+ <p>
+ hi
+ </p>
+ there
+ </p>
+ frog
+</p>
+HTML
+
+is(table(TR(td(table(TR(td('hi', 'there', 'frog')))))), <<HTML, "nested as-is tags");
+<table>
+ <tr>
+ <td><table>
+ <tr>
+ <td>hi there frog</td>
+ </tr>
+ </table></td>
+ </tr>
+</table>
+HTML
+
+is(table(TR(td(table(TR(td( [ qw( hi there frog ) ])))))), <<HTML, "nested as-is array-reference");
+<table>
+ <tr>
+ <td><table>
+ <tr>
+ <td>hi</td>
+ <td>there</td>
+ <td>frog</td>
+ </tr>
+ </table></td>
+ </tr>
+</table>
+HTML
+
+$CGI::Pretty::INDENT = $CGI::Pretty::LINEBREAK = "";
+
+is(h1(), '<h1 />',"single tag (pretty turned off)");
+is(h1('fred'), '<h1>fred</h1>',"open/close tag (pretty turned off)");
+is(h1('fred','agnes','maura'), '<h1>fred agnes maura</h1>',"open/close tag multiple (pretty turned off)");
+is(h1({-align=>'CENTER'},'fred'), '<h1 align="CENTER">fred</h1>',"open/close tag with attribute (pretty turned off)");
+is(h1({-align=>undef},'fred'), '<h1 align>fred</h1>',"open/close tag with orphan attribute (pretty turned off)");
+is(h1({-align=>'CENTER'},['fred','agnes']), '<h1 align="CENTER">fred</h1> <h1 align="CENTER">agnes</h1>',
+ "distributive tag with attribute (pretty turned off)");
+
diff --git a/cpan/CGI/t/push.t b/cpan/CGI/t/push.t
new file mode 100644
index 0000000000..2c48d60ba3
--- /dev/null
+++ b/cpan/CGI/t/push.t
@@ -0,0 +1,85 @@
+#!./perl -wT
+
+use lib qw(t/lib);
+
+# Due to a bug in older versions of MakeMaker & Test::Harness, we must
+# ensure the blib's are in @INC, else we might use the core CGI.pm
+use lib qw(blib/lib blib/arch);
+
+use Test::More tests => 12;
+
+use_ok( 'CGI::Push' );
+
+ok( my $q = CGI::Push->new(), 'create a new CGI::Push object' );
+
+# test the simple_counter() method
+like( join('', $q->simple_counter(10)) , '/updated.+?10.+?times./', 'counter' );
+
+# test do_sleep, except we don't want to bog down the tests
+# there's also a potential timing-related failure lurking here
+# change this variable at your own risk
+my $sleep_in_tests = 0;
+
+SKIP: {
+ skip( 'do_sleep() test may take a while', 1 ) unless $sleep_in_tests;
+
+ my $time = time;
+ CGI::Push::do_sleep(2);
+ is(time - $time, 2, 'slept for a while' );
+}
+
+# test push_delay()
+ok( ! defined $q->push_delay(), 'no initial delay' );
+is( $q->push_delay(.5), .5, 'set a delay' );
+
+my $out = tie *STDOUT, 'TieOut';
+
+# next_page() to be called twice, last_page() once, no delay
+my %vars = (
+ -next_page => sub { return if $_[1] > 2; 'next page' },
+ -last_page => sub { 'last page' },
+ -delay => 0,
+);
+
+$q->do_push(%vars);
+
+# this seems to appear on every page
+like( $$out, '/WARNING: YOUR BROWSER/', 'unsupported browser warning' );
+
+# these should appear correctly
+is( ($$out =~ s/next page//g), 2, 'next_page callback called appropriately' );
+is( ($$out =~ s/last page//g), 1, 'last_page callback called appropriately' );
+
+# send a fake content type (header capitalization varies in CGI, CGI::Push)
+$$out = '';
+$q->do_push(%vars, -type => 'fake' );
+like( $$out, '/Content-[Tt]ype: fake/', 'set custom Content-type' );
+
+# use our own counter, as $COUNTER in CGI::Push is now off
+my $i;
+$$out = '';
+
+# no delay, custom headers from callback, only call callback once
+$q->do_push(
+ -delay => 0,
+ -type => 'dynamic',
+ -next_page => sub {
+ return if $i++;
+ return $_[0]->header('text/plain'), 'arduk';
+ },
+);
+
+# header capitalization again, our word should appear only once
+like( $$out, '/ype: text\/plain/', 'set custom Content-type in next_page()' );
+is( $$out =~ s/arduk//g, 1, 'found text from next_page()' );
+
+package TieOut;
+
+sub TIEHANDLE {
+ bless( \(my $text), $_[0] );
+}
+
+sub PRINT {
+ my $self = shift;
+ $$self .= join( $/, @_ );
+}
diff --git a/cpan/CGI/t/query_string.t b/cpan/CGI/t/query_string.t
new file mode 100644
index 0000000000..a792232683
--- /dev/null
+++ b/cpan/CGI/t/query_string.t
@@ -0,0 +1,16 @@
+#!perl
+
+# Tests for the query_string() method.
+
+use lib 't/lib';
+use Test::More 'no_plan';
+use CGI;
+
+{
+ my $q1 = CGI->new('b=2;a=1;a=1');
+ my $q2 = CGI->new('b=2&a=1&a=1');
+
+ is($q1->query_string
+ ,$q2->query_string
+ , "query string format is returned with the same delimiter regardless of input.");
+}
diff --git a/cpan/CGI/t/request.t b/cpan/CGI/t/request.t
new file mode 100644
index 0000000000..959986bc6c
--- /dev/null
+++ b/cpan/CGI/t/request.t
@@ -0,0 +1,99 @@
+#!/usr/local/bin/perl -w
+
+# Test ability to retrieve HTTP request info
+######################### We start with some black magic to print on failure.
+use lib '.','../blib/lib','../blib/arch';
+
+BEGIN {$| = 1; print "1..34\n"; }
+END {print "not ok 1\n" unless $loaded;}
+use CGI ();
+use Config;
+$loaded = 1;
+print "ok 1\n";
+
+######################### End of black magic.
+
+# util
+sub test {
+ local($^W) = 0;
+ my($num, $true,$msg) = @_;
+ print($true ? "ok $num\n" : "not ok $num $msg\n");
+}
+
+# Set up a CGI environment
+$ENV{REQUEST_METHOD} = 'GET';
+$ENV{QUERY_STRING} = 'game=chess&game=checkers&weather=dull';
+$ENV{PATH_INFO} = '/somewhere/else';
+$ENV{PATH_TRANSLATED} = '/usr/local/somewhere/else';
+$ENV{SCRIPT_NAME} = '/cgi-bin/foo.cgi';
+$ENV{SERVER_PROTOCOL} = 'HTTP/1.0';
+$ENV{SERVER_PORT} = 8080;
+$ENV{SERVER_NAME} = 'the.good.ship.lollypop.com';
+$ENV{REQUEST_URI} = "$ENV{SCRIPT_NAME}$ENV{PATH_INFO}?$ENV{QUERY_STRING}";
+$ENV{HTTP_LOVE} = 'true';
+
+$q = new CGI;
+test(2,$q,"CGI::new()");
+test(3,$q->request_method eq 'GET',"CGI::request_method()");
+test(4,$q->query_string eq 'game=chess;game=checkers;weather=dull',"CGI::query_string()");
+test(5,$q->param() == 2,"CGI::param()");
+test(6,join(' ',sort $q->param()) eq 'game weather',"CGI::param()");
+test(7,$q->param('game') eq 'chess',"CGI::param()");
+test(8,$q->param('weather') eq 'dull',"CGI::param()");
+test(9,join(' ',$q->param('game')) eq 'chess checkers',"CGI::param()");
+test(10,$q->param(-name=>'foo',-value=>'bar'),'CGI::param() put');
+test(11,$q->param(-name=>'foo') eq 'bar','CGI::param() get');
+test(12,$q->query_string eq 'game=chess;game=checkers;weather=dull;foo=bar',"CGI::query_string() redux");
+test(13,$q->http('love') eq 'true',"CGI::http()");
+test(14,$q->script_name eq '/cgi-bin/foo.cgi',"CGI::script_name()");
+test(15,$q->url eq 'http://the.good.ship.lollypop.com:8080/cgi-bin/foo.cgi',"CGI::url()");
+test(16,$q->self_url eq
+ 'http://the.good.ship.lollypop.com:8080/cgi-bin/foo.cgi/somewhere/else?game=chess;game=checkers;weather=dull;foo=bar',
+ "CGI::url()");
+test(17,$q->url(-absolute=>1) eq '/cgi-bin/foo.cgi','CGI::url(-absolute=>1)');
+test(18,$q->url(-relative=>1) eq 'foo.cgi','CGI::url(-relative=>1)');
+test(19,$q->url(-relative=>1,-path=>1) eq 'foo.cgi/somewhere/else','CGI::url(-relative=>1,-path=>1)');
+test(20,$q->url(-relative=>1,-path=>1,-query=>1) eq
+ 'foo.cgi/somewhere/else?game=chess;game=checkers;weather=dull;foo=bar',
+ 'CGI::url(-relative=>1,-path=>1,-query=>1)');
+$q->delete('foo');
+test(21,!$q->param('foo'),'CGI::delete()');
+
+$q->_reset_globals;
+$ENV{QUERY_STRING}='mary+had+a+little+lamb';
+test(22,$q=new CGI,"CGI::new() redux");
+test(23,join(' ',$q->keywords) eq 'mary had a little lamb','CGI::keywords');
+test(24,join(' ',$q->param('keywords')) eq 'mary had a little lamb','CGI::keywords');
+test(25,$q=new CGI('foo=bar&foo=baz'),"CGI::new() redux");
+test(26,$q->param('foo') eq 'bar','CGI::param() redux');
+test(27,$q=new CGI({'foo'=>'bar','bar'=>'froz'}),"CGI::new() redux 2");
+test(28,$q->param('bar') eq 'froz',"CGI::param() redux 2");
+
+# test tied interface
+my $p = $q->Vars;
+test(29,$p->{bar} eq 'froz',"tied interface fetch");
+$p->{bar} = join("\0",qw(foo bar baz));
+test(30,join(' ',$q->param('bar')) eq 'foo bar baz','tied interface store');
+test(31,exists $p->{bar});
+
+# test posting
+$q->_reset_globals;
+if ($Config{d_fork}) {
+ $test_string = 'game=soccer&game=baseball&weather=nice';
+ $ENV{REQUEST_METHOD}='POST';
+ $ENV{CONTENT_LENGTH}=length($test_string);
+ $ENV{QUERY_STRING}='big_balls=basketball&small_balls=golf';
+ if (open(CHILD,"|-")) { # cparent
+ print CHILD $test_string;
+ close CHILD;
+ exit 0;
+ }
+ # at this point, we're in a new (child) process
+ test(32,$q=new CGI,"CGI::new() from POST");
+ test(33,$q->param('weather') eq 'nice',"CGI::param() from POST");
+ test(34,$q->url_param('big_balls') eq 'basketball',"CGI::url_param()");
+} else {
+ print "ok 32 # Skip\n";
+ print "ok 33 # Skip\n";
+ print "ok 34 # Skip\n";
+}
diff --git a/cpan/CGI/t/start_end_asterisk.t b/cpan/CGI/t/start_end_asterisk.t
new file mode 100644
index 0000000000..0d67c9dae0
--- /dev/null
+++ b/cpan/CGI/t/start_end_asterisk.t
@@ -0,0 +1,72 @@
+#!/usr/local/bin/perl -w
+
+use lib qw(t/lib);
+use strict;
+
+# Due to a bug in older versions of MakeMaker & Test::Harness, we must
+# ensure the blib's are in @INC, else we might use the core CGI.pm
+use lib qw(blib/lib blib/arch);
+use Test::More tests => 45;
+
+use CGI qw(:standard *h1 *h2 *h3 *h4 *h5 *h6 *table *ul *li *ol *td *b *i *u *div);
+
+is(start_h1(), "<h1>", "start_h1"); # TEST
+is(start_h1({class => 'hello'}), "<h1 class=\"hello\">", "start_h1 with param"); # TEST
+is(end_h1(), "</h1>", "end_h1"); # TEST
+
+is(start_h2(), "<h2>", "start_h2"); # TEST
+is(start_h2({class => 'hello'}), "<h2 class=\"hello\">", "start_h2 with param"); # TEST
+is(end_h2(), "</h2>", "end_h2"); # TEST
+
+is(start_h3(), "<h3>", "start_h3"); # TEST
+is(start_h3({class => 'hello'}), "<h3 class=\"hello\">", "start_h3 with param"); # TEST
+is(end_h3(), "</h3>", "end_h3"); # TEST
+
+is(start_h4(), "<h4>", "start_h4"); # TEST
+is(start_h4({class => 'hello'}), "<h4 class=\"hello\">", "start_h4 with param"); # TEST
+is(end_h4(), "</h4>", "end_h4"); # TEST
+
+is(start_h5(), "<h5>", "start_h5"); # TEST
+is(start_h5({class => 'hello'}), "<h5 class=\"hello\">", "start_h5 with param"); # TEST
+is(end_h5(), "</h5>", "end_h5"); # TEST
+
+is(start_h6(), "<h6>", "start_h6"); # TEST
+is(start_h6({class => 'hello'}), "<h6 class=\"hello\">", "start_h6 with param"); # TEST
+is(end_h6(), "</h6>", "end_h6"); # TEST
+
+is(start_table(), "<table>", "start_table"); # TEST
+is(start_table({class => 'hello'}), "<table class=\"hello\">", "start_table with param"); # TEST
+is(end_table(), "</table>", "end_table"); # TEST
+
+is(start_ul(), "<ul>", "start_ul"); # TEST
+is(start_ul({class => 'hello'}), "<ul class=\"hello\">", "start_ul with param"); # TEST
+is(end_ul(), "</ul>", "end_ul"); # TEST
+
+is(start_li(), "<li>", "start_li"); # TEST
+is(start_li({class => 'hello'}), "<li class=\"hello\">", "start_li with param"); # TEST
+is(end_li(), "</li>", "end_li"); # TEST
+
+is(start_ol(), "<ol>", "start_ol"); # TEST
+is(start_ol({class => 'hello'}), "<ol class=\"hello\">", "start_ol with param"); # TEST
+is(end_ol(), "</ol>", "end_ol"); # TEST
+
+is(start_td(), "<td>", "start_td"); # TEST
+is(start_td({class => 'hello'}), "<td class=\"hello\">", "start_td with param"); # TEST
+is(end_td(), "</td>", "end_td"); # TEST
+
+is(start_b(), "<b>", "start_b"); # TEST
+is(start_b({class => 'hello'}), "<b class=\"hello\">", "start_b with param"); # TEST
+is(end_b(), "</b>", "end_b"); # TEST
+
+is(start_i(), "<i>", "start_i"); # TEST
+is(start_i({class => 'hello'}), "<i class=\"hello\">", "start_i with param"); # TEST
+is(end_i(), "</i>", "end_i"); # TEST
+
+is(start_u(), "<u>", "start_u"); # TEST
+is(start_u({class => 'hello'}), "<u class=\"hello\">", "start_u with param"); # TEST
+is(end_u(), "</u>", "end_u"); # TEST
+
+is(start_div(), "<div>", "start_div"); # TEST
+is(start_div({class => 'hello'}), "<div class=\"hello\">", "start_div with param"); # TEST
+is(end_div(), "</div>", "end_div"); # TEST
+
diff --git a/cpan/CGI/t/start_end_end.t b/cpan/CGI/t/start_end_end.t
new file mode 100644
index 0000000000..2eeed60c09
--- /dev/null
+++ b/cpan/CGI/t/start_end_end.t
@@ -0,0 +1,72 @@
+#!/usr/local/bin/perl -w
+
+use lib qw(t/lib);
+use strict;
+
+# Due to a bug in older versions of MakeMaker & Test::Harness, we must
+# ensure the blib's are in @INC, else we might use the core CGI.pm
+use lib qw(blib/lib blib/arch);
+use Test::More tests => 45;
+
+use CGI qw(:standard end_h1 end_h2 end_h3 end_h4 end_h5 end_h6 end_table end_ul end_li end_ol end_td end_b end_i end_u end_div);
+
+is(start_h1(), "<h1>", "start_h1"); # TEST
+is(start_h1({class => 'hello'}), "<h1 class=\"hello\">", "start_h1 with param"); # TEST
+is(end_h1(), "</h1>", "end_h1"); # TEST
+
+is(start_h2(), "<h2>", "start_h2"); # TEST
+is(start_h2({class => 'hello'}), "<h2 class=\"hello\">", "start_h2 with param"); # TEST
+is(end_h2(), "</h2>", "end_h2"); # TEST
+
+is(start_h3(), "<h3>", "start_h3"); # TEST
+is(start_h3({class => 'hello'}), "<h3 class=\"hello\">", "start_h3 with param"); # TEST
+is(end_h3(), "</h3>", "end_h3"); # TEST
+
+is(start_h4(), "<h4>", "start_h4"); # TEST
+is(start_h4({class => 'hello'}), "<h4 class=\"hello\">", "start_h4 with param"); # TEST
+is(end_h4(), "</h4>", "end_h4"); # TEST
+
+is(start_h5(), "<h5>", "start_h5"); # TEST
+is(start_h5({class => 'hello'}), "<h5 class=\"hello\">", "start_h5 with param"); # TEST
+is(end_h5(), "</h5>", "end_h5"); # TEST
+
+is(start_h6(), "<h6>", "start_h6"); # TEST
+is(start_h6({class => 'hello'}), "<h6 class=\"hello\">", "start_h6 with param"); # TEST
+is(end_h6(), "</h6>", "end_h6"); # TEST
+
+is(start_table(), "<table>", "start_table"); # TEST
+is(start_table({class => 'hello'}), "<table class=\"hello\">", "start_table with param"); # TEST
+is(end_table(), "</table>", "end_table"); # TEST
+
+is(start_ul(), "<ul>", "start_ul"); # TEST
+is(start_ul({class => 'hello'}), "<ul class=\"hello\">", "start_ul with param"); # TEST
+is(end_ul(), "</ul>", "end_ul"); # TEST
+
+is(start_li(), "<li>", "start_li"); # TEST
+is(start_li({class => 'hello'}), "<li class=\"hello\">", "start_li with param"); # TEST
+is(end_li(), "</li>", "end_li"); # TEST
+
+is(start_ol(), "<ol>", "start_ol"); # TEST
+is(start_ol({class => 'hello'}), "<ol class=\"hello\">", "start_ol with param"); # TEST
+is(end_ol(), "</ol>", "end_ol"); # TEST
+
+is(start_td(), "<td>", "start_td"); # TEST
+is(start_td({class => 'hello'}), "<td class=\"hello\">", "start_td with param"); # TEST
+is(end_td(), "</td>", "end_td"); # TEST
+
+is(start_b(), "<b>", "start_b"); # TEST
+is(start_b({class => 'hello'}), "<b class=\"hello\">", "start_b with param"); # TEST
+is(end_b(), "</b>", "end_b"); # TEST
+
+is(start_i(), "<i>", "start_i"); # TEST
+is(start_i({class => 'hello'}), "<i class=\"hello\">", "start_i with param"); # TEST
+is(end_i(), "</i>", "end_i"); # TEST
+
+is(start_u(), "<u>", "start_u"); # TEST
+is(start_u({class => 'hello'}), "<u class=\"hello\">", "start_u with param"); # TEST
+is(end_u(), "</u>", "end_u"); # TEST
+
+is(start_div(), "<div>", "start_div"); # TEST
+is(start_div({class => 'hello'}), "<div class=\"hello\">", "start_div with param"); # TEST
+is(end_div(), "</div>", "end_div"); # TEST
+
diff --git a/cpan/CGI/t/start_end_start.t b/cpan/CGI/t/start_end_start.t
new file mode 100644
index 0000000000..94768c1696
--- /dev/null
+++ b/cpan/CGI/t/start_end_start.t
@@ -0,0 +1,72 @@
+#!/usr/local/bin/perl -w
+
+use lib qw(t/lib);
+use strict;
+
+# Due to a bug in older versions of MakeMaker & Test::Harness, we must
+# ensure the blib's are in @INC, else we might use the core CGI.pm
+use lib qw(blib/lib blib/arch);
+use Test::More tests => 45;
+
+use CGI qw(:standard start_h1 start_h2 start_h3 start_h4 start_h5 start_h6 start_table start_ul start_li start_ol start_td start_b start_i start_u start_div);
+
+is(start_h1(), "<h1>", "start_h1"); # TEST
+is(start_h1({class => 'hello'}), "<h1 class=\"hello\">", "start_h1 with param"); # TEST
+is(end_h1(), "</h1>", "end_h1"); # TEST
+
+is(start_h2(), "<h2>", "start_h2"); # TEST
+is(start_h2({class => 'hello'}), "<h2 class=\"hello\">", "start_h2 with param"); # TEST
+is(end_h2(), "</h2>", "end_h2"); # TEST
+
+is(start_h3(), "<h3>", "start_h3"); # TEST
+is(start_h3({class => 'hello'}), "<h3 class=\"hello\">", "start_h3 with param"); # TEST
+is(end_h3(), "</h3>", "end_h3"); # TEST
+
+is(start_h4(), "<h4>", "start_h4"); # TEST
+is(start_h4({class => 'hello'}), "<h4 class=\"hello\">", "start_h4 with param"); # TEST
+is(end_h4(), "</h4>", "end_h4"); # TEST
+
+is(start_h5(), "<h5>", "start_h5"); # TEST
+is(start_h5({class => 'hello'}), "<h5 class=\"hello\">", "start_h5 with param"); # TEST
+is(end_h5(), "</h5>", "end_h5"); # TEST
+
+is(start_h6(), "<h6>", "start_h6"); # TEST
+is(start_h6({class => 'hello'}), "<h6 class=\"hello\">", "start_h6 with param"); # TEST
+is(end_h6(), "</h6>", "end_h6"); # TEST
+
+is(start_table(), "<table>", "start_table"); # TEST
+is(start_table({class => 'hello'}), "<table class=\"hello\">", "start_table with param"); # TEST
+is(end_table(), "</table>", "end_table"); # TEST
+
+is(start_ul(), "<ul>", "start_ul"); # TEST
+is(start_ul({class => 'hello'}), "<ul class=\"hello\">", "start_ul with param"); # TEST
+is(end_ul(), "</ul>", "end_ul"); # TEST
+
+is(start_li(), "<li>", "start_li"); # TEST
+is(start_li({class => 'hello'}), "<li class=\"hello\">", "start_li with param"); # TEST
+is(end_li(), "</li>", "end_li"); # TEST
+
+is(start_ol(), "<ol>", "start_ol"); # TEST
+is(start_ol({class => 'hello'}), "<ol class=\"hello\">", "start_ol with param"); # TEST
+is(end_ol(), "</ol>", "end_ol"); # TEST
+
+is(start_td(), "<td>", "start_td"); # TEST
+is(start_td({class => 'hello'}), "<td class=\"hello\">", "start_td with param"); # TEST
+is(end_td(), "</td>", "end_td"); # TEST
+
+is(start_b(), "<b>", "start_b"); # TEST
+is(start_b({class => 'hello'}), "<b class=\"hello\">", "start_b with param"); # TEST
+is(end_b(), "</b>", "end_b"); # TEST
+
+is(start_i(), "<i>", "start_i"); # TEST
+is(start_i({class => 'hello'}), "<i class=\"hello\">", "start_i with param"); # TEST
+is(end_i(), "</i>", "end_i"); # TEST
+
+is(start_u(), "<u>", "start_u"); # TEST
+is(start_u({class => 'hello'}), "<u class=\"hello\">", "start_u with param"); # TEST
+is(end_u(), "</u>", "end_u"); # TEST
+
+is(start_div(), "<div>", "start_div"); # TEST
+is(start_div({class => 'hello'}), "<div class=\"hello\">", "start_div with param"); # TEST
+is(end_div(), "</div>", "end_div"); # TEST
+
diff --git a/cpan/CGI/t/switch.t b/cpan/CGI/t/switch.t
new file mode 100644
index 0000000000..ac58618a7f
--- /dev/null
+++ b/cpan/CGI/t/switch.t
@@ -0,0 +1,13 @@
+#!/usr/local/bin/perl -w
+
+use lib qw(t/lib);
+
+# Due to a bug in older versions of MakeMaker & Test::Harness, we must
+# ensure the blib's are in @INC, else we might use the core CGI.pm
+use lib qw(blib/lib blib/arch);
+
+use strict;
+use Test::More tests => 1;
+
+# Can't do much with this other than make sure it loads properly
+BEGIN { use_ok('CGI::Switch') };
diff --git a/cpan/CGI/t/unescapeHTML.t b/cpan/CGI/t/unescapeHTML.t
new file mode 100644
index 0000000000..fc0f750f0c
--- /dev/null
+++ b/cpan/CGI/t/unescapeHTML.t
@@ -0,0 +1,11 @@
+use lib 't/lib';
+use Test::More 'no_plan';
+use CGI 'unescapeHTML';
+
+is( unescapeHTML( '&amp;'), '&', 'unescapeHTML: &');
+is( unescapeHTML( '&quot;'), '"', 'unescapeHTML: "');
+TODO: {
+ local $TODO = 'waiting on patch. Reference: https://rt.cpan.org/Ticket/Display.html?id=39122';
+ is( unescapeHTML( 'Bob & Tom went to the store; Where did you go?'),
+ 'Bob & Tom went to the store; Where did you go?', 'unescapeHTML: a case where &...; should not be escaped.');
+}
diff --git a/cpan/CGI/t/upload.t b/cpan/CGI/t/upload.t
new file mode 100644
index 0000000000..0989f1d560
--- /dev/null
+++ b/cpan/CGI/t/upload.t
@@ -0,0 +1,151 @@
+#!/usr/local/bin/perl -w
+
+#################################################################
+# Emanuele Zeppieri, Mark Stosberg #
+# Shamelessly stolen from Data::FormValidator and CGI::Upload #
+#################################################################
+
+# Due to a bug in older versions of MakeMaker & Test::Harness, we must
+# ensure the blib's are in @INC, else we might use the core CGI.pm
+use lib qw(. ./blib/lib ./blib/arch);
+
+use strict;
+
+use Test::More 'no_plan';
+
+use CGI;
+
+#-----------------------------------------------------------------------------
+# %ENV setup.
+#-----------------------------------------------------------------------------
+
+my %myenv;
+
+BEGIN {
+ %myenv = (
+ 'SCRIPT_NAME' => '/test.cgi',
+ 'SERVER_NAME' => 'perl.org',
+ 'HTTP_CONNECTION' => 'TE, close',
+ 'REQUEST_METHOD' => 'POST',
+ 'SCRIPT_URI' => 'http://www.perl.org/test.cgi',
+ 'CONTENT_LENGTH' => 3285,
+ 'SCRIPT_FILENAME' => '/home/usr/test.cgi',
+ 'SERVER_SOFTWARE' => 'Apache/1.3.27 (Unix) ',
+ 'HTTP_TE' => 'deflate,gzip;q=0.3',
+ 'QUERY_STRING' => '',
+ 'REMOTE_PORT' => '1855',
+ 'HTTP_USER_AGENT' => 'Mozilla/5.0 (compatible; Konqueror/2.1.1; X11)',
+ 'SERVER_PORT' => '80',
+ 'REMOTE_ADDR' => '127.0.0.1',
+ 'CONTENT_TYPE' => 'multipart/form-data; boundary=xYzZY',
+ 'SERVER_PROTOCOL' => 'HTTP/1.1',
+ 'PATH' => '/usr/local/bin:/usr/bin:/bin',
+ 'REQUEST_URI' => '/test.cgi',
+ 'GATEWAY_INTERFACE' => 'CGI/1.1',
+ 'SCRIPT_URL' => '/test.cgi',
+ 'SERVER_ADDR' => '127.0.0.1',
+ 'DOCUMENT_ROOT' => '/home/develop',
+ 'HTTP_HOST' => 'www.perl.org'
+ );
+
+ for my $key (keys %myenv) {
+ $ENV{$key} = $myenv{$key};
+ }
+}
+
+END {
+ for my $key (keys %myenv) {
+ delete $ENV{$key};
+ }
+}
+
+#-----------------------------------------------------------------------------
+# Simulate the upload (really, multiple uploads contained in a single stream).
+#-----------------------------------------------------------------------------
+
+my $q;
+
+{
+ local *STDIN;
+ open STDIN, '<t/upload_post_text.txt'
+ or die 'missing test file t/upload_post_text.txt';
+ binmode STDIN;
+ $q = CGI->new;
+}
+
+#-----------------------------------------------------------------------------
+# Check that the file names retrieved by CGI are correct.
+#-----------------------------------------------------------------------------
+
+is( $q->param('does_not_exist_gif'), 'does_not_exist.gif', 'filename_2' );
+is( $q->param('100;100_gif') , '100;100.gif' , 'filename_3' );
+is( $q->param('300x300_gif') , '300x300.gif' , 'filename_4' );
+
+{
+ my $test = "multiple file names are handled right with same-named upload fields";
+ my @hello_names = $q->param('hello_world');
+ is ($hello_names[0],'goodbye_world.txt',$test. "...first file");
+ is ($hello_names[1],'hello_world.txt',$test. "...second file");
+}
+
+#-----------------------------------------------------------------------------
+# Now check that the upload method works.
+#-----------------------------------------------------------------------------
+
+ok( defined $q->upload('does_not_exist_gif'), 'upload_basic_2' );
+ok( defined $q->upload('100;100_gif') , 'upload_basic_3' );
+ok( defined $q->upload('300x300_gif') , 'upload_basic_4' );
+
+{
+ my $test = "file handles have expected length for multi-valued field. ";
+ my ($goodbye_fh,$hello_fh) = $q->upload('hello_world');
+
+ # Go to end of file;
+ seek($goodbye_fh,0,2);
+ # How long is the file?
+ is(tell($goodbye_fh), 15, "$test..first file");
+
+ # Go to end of file;
+ seek($hello_fh,0,2);
+ # How long is the file?
+ is(tell($hello_fh), 13, "$test..second file");
+
+}
+
+
+
+{
+ my $test = "300x300_gif has expected length";
+ my $fh1 = $q->upload('300x300_gif');
+ is(tell($fh1), 0, "First object: filehandle starts with position set at zero");
+
+ # Go to end of file;
+ seek($fh1,0,2);
+ # How long is the file?
+ is(tell($fh1), 1656, $test);
+}
+
+my $q2 = CGI->new;
+
+{
+ my $test = "Upload filehandles still work after calling CGI->new a second time";
+ $q->param('new','zoo');
+
+ is($q2->param('new'),undef,
+ "Reality Check: params set in one object instance don't appear in another instance");
+
+ my $fh2 = $q2->upload('300x300_gif');
+ is(tell($fh2), 0, "...so the state of a file handle shouldn't be carried to a new object instance, either.");
+ # Go to end of file;
+ seek($fh2,0,2);
+ # How long is the file?
+ is(tell($fh2), 1656, $test);
+}
+
+{
+ my $test = "multi-valued uploads are reset properly";
+ my ($dont_care, $hello_fh2) = $q2->upload('hello_world');
+ is(tell($hello_fh2), 0, $test);
+}
+
+# vim: nospell
diff --git a/cpan/CGI/t/uploadInfo.t b/cpan/CGI/t/uploadInfo.t
new file mode 100644
index 0000000000..970429b8bb
--- /dev/null
+++ b/cpan/CGI/t/uploadInfo.t
@@ -0,0 +1,90 @@
+#!/usr/local/bin/perl -w
+
+#################################################################
+# Emanuele Zeppieri, Mark Stosberg #
+# Shamelessly stolen from Data::FormValidator and CGI::Upload #
+#################################################################
+
+# Due to a bug in older versions of MakeMaker & Test::Harness, we must
+# ensure the blib's are in @INC, else we might use the core CGI.pm
+use lib qw(. ./blib/lib ./blib/arch);
+
+use strict;
+
+use Test::More 'no_plan';
+
+use CGI;
+
+#-----------------------------------------------------------------------------
+# %ENV setup.
+#-----------------------------------------------------------------------------
+
+my %myenv;
+
+BEGIN {
+ %myenv = (
+ 'SCRIPT_NAME' => '/test.cgi',
+ 'SERVER_NAME' => 'perl.org',
+ 'HTTP_CONNECTION' => 'TE, close',
+ 'REQUEST_METHOD' => 'POST',
+ 'SCRIPT_URI' => 'http://www.perl.org/test.cgi',
+ 'CONTENT_LENGTH' => 3285,
+ 'SCRIPT_FILENAME' => '/home/usr/test.cgi',
+ 'SERVER_SOFTWARE' => 'Apache/1.3.27 (Unix) ',
+ 'HTTP_TE' => 'deflate,gzip;q=0.3',
+ 'QUERY_STRING' => '',
+ 'REMOTE_PORT' => '1855',
+ 'HTTP_USER_AGENT' => 'Mozilla/5.0 (compatible; Konqueror/2.1.1; X11)',
+ 'SERVER_PORT' => '80',
+ 'REMOTE_ADDR' => '127.0.0.1',
+ 'CONTENT_TYPE' => 'multipart/form-data; boundary=xYzZY',
+ 'SERVER_PROTOCOL' => 'HTTP/1.1',
+ 'PATH' => '/usr/local/bin:/usr/bin:/bin',
+ 'REQUEST_URI' => '/test.cgi',
+ 'GATEWAY_INTERFACE' => 'CGI/1.1',
+ 'SCRIPT_URL' => '/test.cgi',
+ 'SERVER_ADDR' => '127.0.0.1',
+ 'DOCUMENT_ROOT' => '/home/develop',
+ 'HTTP_HOST' => 'www.perl.org'
+ );
+
+ for my $key (keys %myenv) {
+ $ENV{$key} = $myenv{$key};
+ }
+}
+
+END {
+ for my $key (keys %myenv) {
+ delete $ENV{$key};
+ }
+}
+
+
+#-----------------------------------------------------------------------------
+# Simulate the upload (really, multiple uploads contained in a single stream).
+#-----------------------------------------------------------------------------
+
+my $q;
+
+{
+ local *STDIN;
+ open STDIN, '<t/upload_post_text.txt'
+ or die 'missing test file t/upload_post_text.txt';
+ binmode STDIN;
+ $q = CGI->new;
+}
+
+{
+ my $test = "uploadInfo: basic test";
+ my $fh = $q->upload('300x300_gif');
+ is( $q->uploadInfo($fh)->{'Content-Type'}, "image/gif", $test);
+}
+
+my $q2 = CGI->new;
+
+{
+ my $test = "uploadInfo: works with second object instance";
+ my $fh = $q2->upload('300x300_gif');
+ is( $q2->uploadInfo($fh)->{'Content-Type'}, "image/gif", $test);
+}
+
diff --git a/cpan/CGI/t/upload_post_text.txt b/cpan/CGI/t/upload_post_text.txt
new file mode 100644
index 0000000000..91393f064c
--- /dev/null
+++ b/cpan/CGI/t/upload_post_text.txt
Binary files differ
diff --git a/cpan/CGI/t/user_agent.t b/cpan/CGI/t/user_agent.t
new file mode 100644
index 0000000000..1a4880dc7c
--- /dev/null
+++ b/cpan/CGI/t/user_agent.t
@@ -0,0 +1,15 @@
+# Test the user_agent method.
+use lib 't/lib';
+use Test::More 'no_plan';
+use CGI;
+
+my $q = CGI->new;
+
+is($q->user_agent, undef, 'user_agent: undef test');
+
+$ENV{HTTP_USER_AGENT} = 'mark';
+is($q->user_agent, 'mark', 'user_agent: basic test');
+ok($q->user_agent('ma.*'), 'user_agent: positive regex test');
+ok(!$q->user_agent('BOOM.*'), 'user_agent: negative regex test');
+
+
diff --git a/cpan/CGI/t/util-58.t b/cpan/CGI/t/util-58.t
new file mode 100644
index 0000000000..75c0ea9723
--- /dev/null
+++ b/cpan/CGI/t/util-58.t
@@ -0,0 +1,29 @@
+# test CGI::Util::escape
+use Test::More tests => 4;
+use_ok("CGI::Util");
+
+# Byte strings should be escaped byte by byte:
+# 1) not a valid utf-8 sequence:
+my $uri = "pe\x{f8}\x{ed}\x{e8}ko.ogg";
+is(CGI::Util::escape($uri), "pe%F8%ED%E8ko.ogg", "Escape a Latin-2 string");
+
+# 2) is a valid utf-8 sequence, but not an UTF-8-flagged string
+# This happens often: people write utf-8 strings to source, but forget
+# to tell perl about it by "use utf8;"--this is obviously wrong, but we
+# have to handle it gracefully, for compatibility with GCI.pm under
+# perl-5.8.x
+#
+$uri = "pe\x{c5}\x{99}\x{c3}\x{ad}\x{c4}\x{8d}ko.ogg";
+is(CGI::Util::escape($uri), "pe%C5%99%C3%AD%C4%8Dko.ogg",
+ "Escape an utf-8 byte string");
+
+SKIP:
+{
+ # This tests CGI::Util::escape() when fed with UTF-8-flagged string
+ # -- dankogai
+ skip("Unicode strings not available in $]", 1) if ($] < 5.008);
+ $uri = "\x{5c0f}\x{98fc} \x{5f3e}.txt"; # KOGAI, Dan, in Kanji
+ is(CGI::Util::escape($uri), "%E5%B0%8F%E9%A3%BC%20%E5%BC%BE.txt",
+ "Escape string with UTF-8 flag");
+}
+__END__
diff --git a/cpan/CGI/t/util.t b/cpan/CGI/t/util.t
new file mode 100644
index 0000000000..702a4695d6
--- /dev/null
+++ b/cpan/CGI/t/util.t
@@ -0,0 +1,51 @@
+#!/usr/local/bin/perl -w
+
+# Test ability to escape() and unescape() punctuation characters
+# except for qw(- . _).
+######################### We start with some black magic to print on failure.
+use lib '../blib/lib','../blib/arch';
+
+BEGIN {$| = 1; print "1..57\n"; }
+END {print "not ok 1\n" unless $loaded;}
+use Config;
+use CGI::Util qw(escape unescape);
+$loaded = 1;
+print "ok 1\n";
+
+######################### End of black magic.
+
+# util
+sub test {
+ local($^W) = 0;
+ my($num, $true,$msg) = @_;
+ print($true ? "ok $num\n" : "not ok $num $msg\n");
+}
+
+# ASCII order, ASCII codepoints, ASCII repertoire
+
+my %punct = (
+ ' ' => '20', '!' => '21', '"' => '22', '#' => '23',
+ '$' => '24', '%' => '25', '&' => '26', '\'' => '27',
+ '(' => '28', ')' => '29', '*' => '2A', '+' => '2B',
+ ',' => '2C', '/' => '2F', # '-' => '2D', '.' => '2E'
+ ':' => '3A', ';' => '3B', '<' => '3C', '=' => '3D',
+ '>' => '3E', '?' => '3F', '[' => '5B', '\\' => '5C',
+ ']' => '5D', '^' => '5E', '`' => '60', # '_' => '5F',
+ '{' => '7B', '|' => '7C', '}' => '7D', # '~' => '7E',
+ );
+
+# The sort order may not be ASCII on EBCDIC machines:
+
+my $i = 1;
+
+foreach(sort(keys(%punct))) {
+ $i++;
+ my $escape = "AbC\%$punct{$_}dEF";
+ my $cgi_escape = escape("AbC$_" . "dEF");
+ test($i, $escape eq $cgi_escape , "# $escape ne $cgi_escape");
+ $i++;
+ my $unescape = "AbC$_" . "dEF";
+ my $cgi_unescape = unescape("AbC\%$punct{$_}dEF");
+ test($i, $unescape eq $cgi_unescape , "# $unescape ne $cgi_unescape");
+}
+
View Lorry Controller Status