From: David Mitchell <davem@iabyn.com>
Date: Sat, 22 Aug 2009 17:02:13 +0000 (+0100)
Subject: upgrade GCI from 3.43 to 3.45
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=68a4c8b9f23d187f9b39cb387da580869f4cd8ee;p=p5sagit%2Fp5-mst-13.2.git

upgrade GCI from 3.43 to 3.45

Note that this blows away some local mods:
 * b<> to B<> fixes
 * core boilerplate for upload.t and uploadInfo.t
---

diff --git a/MANIFEST b/MANIFEST
index a5daf74..b70837d 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -1926,21 +1926,26 @@ lib/CGI/t/apache.t		See if CGI::Apache still loads
 lib/CGI/t/can.t			See if CGI.pm works
 lib/CGI/t/carp.t		See if CGI::Carp works
 lib/CGI/t/cookie.t		See if CGI::Cookie works
+lib/CGI/t/Dump.t		See if CGI->Dump works
 lib/CGI/t/fast.t		See if CGI::Fast works (if FCGI is installed)
 lib/CGI/t/form.t		See if CGI.pm works
 lib/CGI/t/function.t		See if CGI.pm works
 lib/CGI/t/html.t		See if CGI.pm works
 lib/CGI/t/no_tabindex.t	See if CGI.pm works
+lib/CGI/t/popup_menu.t		See if CGI pop menus work
 lib/CGI/t/pretty.t		See if CGI.pm works
 lib/CGI/t/push.t		See if CGI::Push works
+lib/CGI/t/query_string.t	See if CGI->query_string() works
 lib/CGI/t/request.t		See if CGI.pm works
 lib/CGI/t/start_end_asterisk.t	See if CGI.pm works
 lib/CGI/t/start_end_end.t	See if CGI.pm works
 lib/CGI/t/start_end_start.t	See if CGI.pm works
 lib/CGI/t/switch.t		See if CGI::Switch still loads
+lib/CGI/t/unescapeHTML.t	See if CGI::unescapeHTML() works
 lib/CGI/t/uploadInfo.t		See if CGI.pm works
 lib/CGI/t/upload_post_text.txt.packed	Test data for CGI.pm
 lib/CGI/t/upload.t		See if CGI.pm works
+lib/CGI/t/user_agent.t		See if CGI->user_agent() works
 lib/CGI/t/util-58.t		See if 5.8-dependent features work
 lib/CGI/t/util.t		See if CGI.pm works
 lib/CGI/Util.pm			Utility functions
diff --git a/Porting/Maintainers.pl b/Porting/Maintainers.pl
index 0851f82..9d7365e 100755
--- a/Porting/Maintainers.pl
+++ b/Porting/Maintainers.pl
@@ -314,7 +314,7 @@ package Maintainers;
     'CGI' =>
 	{
 	'MAINTAINER'	=> 'lstein',
-	'DISTRIBUTION'	=> 'LDS/CGI.pm-3.43.tar.gz',
+	'DISTRIBUTION'	=> 'LDS/CGI.pm-3.45.tar.gz',
 	'FILES'		=> q[lib/CGI.pm lib/CGI],
 	'EXCLUDED'	=> [ qr{^t/lib/Test},
 				qw( cgi-lib_porting.html
@@ -324,8 +324,7 @@ package Maintainers;
 				)
 			   ],
 	'MAP'		=> { 'examples/' => 'lib/CGI/eg/',
-			     'CGI/'	 => 'lib/CGI/',
-			     'CGI.pm'	 => 'lib/CGI.pm',
+			     'lib/'	 => 'lib/',
 			     ''		 => 'lib/CGI/',
 			   },
 	'CPAN'		=> 1,
diff --git a/lib/CGI.pm b/lib/CGI.pm
index 008bc7b..cacb03a 100644
--- a/lib/CGI.pm
+++ b/lib/CGI.pm
@@ -18,8 +18,8 @@ use Carp 'croak';
 # The most recent version and complete docs are available at:
 #   http://stein.cshl.org/WWW/software/CGI/
 
-$CGI::revision = '$Id: CGI.pm,v 1.263 2009/02/11 16:56:37 lstein Exp $';
-$CGI::VERSION='3.43';
+$CGI::revision = '$Id: CGI.pm,v 1.266 2009/07/30 16:32:34 lstein Exp $';
+$CGI::VERSION='3.45';
 
 # HARD-CODED LOCATION FOR FILE UPLOAD TEMPORARY FILES.
 # UNCOMMENT THIS ONLY IF YOU KNOW WHAT YOU'RE DOING.
@@ -61,8 +61,8 @@ sub initialize_globals {
 
     # Set this to 1 to enable NOSTICKY scripts
     # or: 
-    #    1) use CGI qw(-nosticky)
-    #    2) $CGI::nosticky(1)
+    #    1) use CGI '-nosticky';
+    #    2) $CGI::NOSTICKY = 1;
     $NOSTICKY = 0;
 
     # Set this to 1 to enable NPH scripts
@@ -156,12 +156,14 @@ if ($OS =~ /^MSWin/i) {
     $OS = 'EPOC';
 } elsif ($OS =~ /^cygwin/i) {
     $OS = 'CYGWIN';
+} elsif ($OS =~ /^NetWare/i) {
+    $OS = 'NETWARE';
 } else {
     $OS = 'UNIX';
 }
 
 # Some OS logic.  Binary mode enabled on DOS, NT and VMS
-$needs_binmode = $OS=~/^(WINDOWS|DOS|OS2|MSWin|CYGWIN)/;
+$needs_binmode = $OS=~/^(WINDOWS|DOS|OS2|MSWin|CYGWIN|NETWARE)/;
 
 # This is the default class for the CGI object to use when all else fails.
 $DefaultClass = 'CGI' unless defined $CGI::DefaultClass;
@@ -172,7 +174,7 @@ $AutoloadClass = $DefaultClass unless defined $CGI::AutoloadClass;
 # The path separator is a slash, backslash or semicolon, depending
 # on the paltform.
 $SL = {
-     UNIX    => '/',  OS2 => '\\', EPOC      => '/', CYGWIN => '/',
+     UNIX    => '/',  OS2 => '\\', EPOC      => '/', CYGWIN => '/', NETWARE => '/',
      WINDOWS => '\\', DOS => '\\', MACINTOSH => ':', VMS    => '/'
     }->{$OS};
 
@@ -181,8 +183,12 @@ $SL = {
 # $NPH++ if defined($ENV{'SERVER_SOFTWARE'}) && $ENV{'SERVER_SOFTWARE'}=~/IIS/;
 $IIS++ if defined($ENV{'SERVER_SOFTWARE'}) && $ENV{'SERVER_SOFTWARE'}=~/IIS/;
 
+# Turn on special checking for ActiveState's PerlEx
+$PERLEX++ if defined($ENV{'GATEWAY_INTERFACE'}) && $ENV{'GATEWAY_INTERFACE'} =~ /^CGI-PerlEx/;
+
 # Turn on special checking for Doug MacEachern's modperl
-if (exists $ENV{MOD_PERL}) {
+# PerlEx::DBI tries to fool DBI by setting MOD_PERL
+if (exists $ENV{MOD_PERL} && ! $PERLEX) {
   # mod_perl handlers may run system() on scripts using CGI.pm;
   # Make sure so we don't get fooled by inherited $ENV{MOD_PERL}
   if (exists $ENV{MOD_PERL_API_VERSION} && $ENV{MOD_PERL_API_VERSION} == 2) {
@@ -198,9 +204,6 @@ if (exists $ENV{MOD_PERL}) {
   }
 }
 
-# Turn on special checking for ActiveState's PerlEx
-$PERLEX++ if defined($ENV{'GATEWAY_INTERFACE'}) && $ENV{'GATEWAY_INTERFACE'} =~ /^CGI-PerlEx/;
-
 # Define the CRLF sequence.  I can't use a simple "\r\n" because the meaning
 # of "\n" is different on different OS's (sometimes it generates CRLF, sometimes LF
 # and sometimes CR).  The most popular VMS web server
@@ -644,8 +647,17 @@ sub init {
       }
 
       if ($meth eq 'POST' || $meth eq 'PUT') {
-	  $self->read_from_client(\$query_string,$content_length,0)
-	      if $content_length > 0;
+	  if ( $content_length > 0 ) {
+	    $self->read_from_client(\$query_string,$content_length,0);
+	  }
+	  else {
+	    $self->read_from_stdin(\$query_string);
+	    # should this be PUTDATA in case of PUT ?
+	    my($param) = $meth . 'DATA' ;
+	    $self->add_parameter($param) ;
+	    push (@{$self->{param}{$param}},$query_string);
+	    undef $query_string ;
+	  }
 	  # Some people want to have their cake and eat it too!
 	  # Uncomment this line to have the contents of the query string
 	  # APPENDED to the POST data.
@@ -653,7 +665,8 @@ sub init {
 	  last METHOD;
       }
 
-      # If $meth is not of GET, POST or HEAD, assume we're being debugged offline.
+      # If $meth is not of GET, POST, PUT or HEAD, assume we're
+      #   being debugged offline.
       # Check the command line and then the standard input for data.
       # We use the shellwords package in order to behave the way that
       # UN*X programmers expect.
@@ -673,10 +686,10 @@ sub init {
         && defined($ENV{'CONTENT_TYPE'})
         && $ENV{'CONTENT_TYPE'} !~ m|^application/x-www-form-urlencoded|
 	&& $ENV{'CONTENT_TYPE'} !~ m|^multipart/form-data| ) {
-        my($param) = $meth . 'DATA' ;
-        $self->add_parameter($param) ;
-      push (@{$self->{param}{$param}},$query_string);
-      undef $query_string ;
+	    my($param) = $meth . 'DATA' ;
+	    $self->add_parameter($param) ;
+	    push (@{$self->{param}{$param}},$query_string);
+	    undef $query_string ;
     }
 # YL: End Change for XML handler 10/19/2001
 
@@ -997,6 +1010,47 @@ sub read_from_client {
 }
 END_OF_FUNC
 
+'read_from_stdin' => <<'END_OF_FUNC',
+# Read data from stdin until all is read
+sub read_from_stdin {
+    my($self, $buff) = @_;
+    local $^W=0;                # prevent a warning
+
+    #
+    # TODO: loop over STDIN until all is read
+    #
+
+    my($eoffound) = 0;
+    my($localbuf) = '';
+    my($tempbuf) = '';
+    my($bufsiz) = 1024;
+    my($res);
+    while ($eoffound == 0) {
+	if ( $MOD_PERL ) {
+	    $res = $self->r->read($tempbuf, $bufsiz, 0)
+	}
+	else {
+	    $res = read(\*STDIN, $tempbuf, $bufsiz);
+	}
+
+	if ( !defined($res) ) {
+	    # TODO: how to do error reporting ?
+	    $eoffound = 1;
+	    last;
+	}
+	if ( $res == 0 ) {
+	    $eoffound = 1;
+	    last;
+	}
+	$localbuf .= $tempbuf;
+    }
+
+    $$buff = $localbuf;
+
+    return $res;
+}
+END_OF_FUNC
+
 'delete' => <<'END_OF_FUNC',
 #### Method: delete
 # Deletes the named parameter entirely.
@@ -1132,6 +1186,12 @@ sub MethPost {
 }
 END_OF_FUNC
 
+'MethPut' => <<'END_OF_FUNC',
+sub MethPut {
+    return request_method() eq 'PUT';
+}
+END_OF_FUNC
+
 'TIEHASH' => <<'END_OF_FUNC',
 sub TIEHASH {
     my $class = shift;
@@ -1300,7 +1360,7 @@ sub Dump {
     push(@result,"<ul>");
     for $param ($self->param) {
 	my($name)=$self->escapeHTML($param);
-	push(@result,"<li><strong>$param</strong></li>");
+	push(@result,"<li><strong>$name</strong></li>");
 	push(@result,"<ul>");
 	for $value ($self->param($param)) {
 	    $value = $self->escapeHTML($value);
@@ -2592,14 +2652,26 @@ sub scrolling_list {
     $tabindex = $self->element_tab($tabindex);
     $result = qq/<select name="$name" $tabindex$has_size$is_multiple$other>\n/;
     for (@values) {
-	my($selectit) = $self->_selected($selected{$_});
-	my($label) = $_;
-	$label = $labels->{$_} if defined($labels) && defined($labels->{$_});
-	$label=$self->escapeHTML($label);
-	my($value)=$self->escapeHTML($_,1);
-        my $attribs = $self->_set_attributes($_, $attributes);
-        $result .= "<option ${selectit}${attribs}value=\"$value\">$label</option>\n";
+        if (/<optgroup/) {
+            for my $v (split(/\n/)) {
+                my $selectit = $XHTML ? 'selected="selected"' : 'selected';
+		for my $selected (keys %selected) {
+		    $v =~ s/(value="$selected")/$selectit $1/;
+		}
+                $result .= "$v\n";
+            }
+        }
+        else {
+          my $attribs   = $self->_set_attributes($_, $attributes);
+	  my($selectit) = $self->_selected($selected{$_});
+	  my($label)    = $_;
+	  $label        = $labels->{$_} if defined($labels) && defined($labels->{$_});
+	  my($value)    = $self->escapeHTML($_);
+	  $label        = $self->escapeHTML($label,1);
+          $result      .= "<option${attribs} ${selectit}value=\"$value\">$label</option>\n";
+        }
     }
+
     $result .= "</select>";
     $self->register_parameter($name);
     return $result;
@@ -2779,9 +2851,8 @@ sub cookie {
     # value of the cookie, if any.  For efficiency, we cache the parsed
     # cookies in our state variables.
     unless ( defined($value) ) {
-	$self->{'.cookies'} = CGI::Cookie->fetch
-	    unless $self->{'.cookies'};
-
+	$self->{'.cookies'} = CGI::Cookie->fetch;
+	
 	# If no name is supplied, then retrieve the names of all our cookies.
 	return () unless $self->{'.cookies'};
 	return keys %{$self->{'.cookies'}} unless $name;
@@ -2911,7 +2982,7 @@ END_OF_FUNC
 ####
 'request_method' => <<'END_OF_FUNC',
 sub request_method {
-    return $ENV{'REQUEST_METHOD'};
+    return (defined $ENV{'REQUEST_METHOD'}) ? $ENV{'REQUEST_METHOD'} : undef;
 }
 END_OF_FUNC
 
@@ -2920,7 +2991,7 @@ END_OF_FUNC
 ####
 'content_type' => <<'END_OF_FUNC',
 sub content_type {
-    return $ENV{'CONTENT_TYPE'};
+    return (defined $ENV{'CONTENT_TYPE'}) ? $ENV{'CONTENT_TYPE'} : undef;
 }
 END_OF_FUNC
 
@@ -2930,7 +3001,7 @@ END_OF_FUNC
 ####
 'path_translated' => <<'END_OF_FUNC',
 sub path_translated {
-    return $ENV{'PATH_TRANSLATED'};
+    return (defined $ENV{'PATH_TRANSLATED'}) ? $ENV{'PATH_TRANSLATED'} : undef;
 }
 END_OF_FUNC
 
@@ -2940,7 +3011,7 @@ END_OF_FUNC
 ####
 'request_uri' => <<'END_OF_FUNC',
 sub request_uri {
-    return $ENV{'REQUEST_URI'};
+    return (defined $ENV{'REQUEST_URI'}) ? $ENV{'REQUEST_URI'} : undef;
 }
 END_OF_FUNC
 
@@ -2954,12 +3025,12 @@ sub query_string {
     my($self) = self_or_default(@_);
     my($param,$value,@pairs);
     for $param ($self->param) {
-	my($eparam) = escape($param);
-	for $value ($self->param($param)) {
-	    $value = escape($value);
+       my($eparam) = escape($param);
+       for $value ($self->param($param)) {
+           $value = escape($value);
             next unless defined $value;
-	    push(@pairs,"$eparam=$value");
-	}
+           push(@pairs,"$eparam=$value");
+       }
     }
     for (keys %{$self->{'.fieldnames'}}) {
       push(@pairs,".cgifields=".escape("$_"));
@@ -3026,8 +3097,9 @@ END_OF_FUNC
 'user_agent' => <<'END_OF_FUNC',
 sub user_agent {
     my($self,$match)=self_or_CGI(@_);
-    return $self->http('user_agent') unless $match;
-    return $self->http('user_agent') =~ /$match/i;
+    my $user_agent = $self->http('user_agent');
+    return $user_agent unless $match && $user_agent;
+    return $user_agent =~ /$match/i;
 }
 END_OF_FUNC
 
@@ -3185,8 +3257,12 @@ END_OF_FUNC
 'http' => <<'END_OF_FUNC',
 sub http {
     my ($self,$parameter) = self_or_CGI(@_);
-    return $ENV{$parameter} if $parameter=~/^HTTP/;
-    $parameter =~ tr/-/_/;
+    if ( defined($parameter) ) {
+	if ( $parameter =~ /^HTTP/ ) {
+	    return $ENV{$parameter};
+	}
+	$parameter =~ tr/-/_/;
+    }
     return $ENV{"HTTP_\U$parameter\E"} if $parameter;
     my(@p);
     for (keys %ENV) {
@@ -3236,7 +3312,7 @@ END_OF_FUNC
 ####
 'remote_ident' => <<'END_OF_FUNC',
 sub remote_ident {
-    return $ENV{'REMOTE_IDENT'};
+    return (defined $ENV{'REMOTE_IDENT'}) ? $ENV{'REMOTE_IDENT'} : undef;
 }
 END_OF_FUNC
 
@@ -3246,7 +3322,7 @@ END_OF_FUNC
 ####
 'auth_type' => <<'END_OF_FUNC',
 sub auth_type {
-    return $ENV{'AUTH_TYPE'};
+    return (defined $ENV{'AUTH_TYPE'}) ? $ENV{'AUTH_TYPE'} : undef;
 }
 END_OF_FUNC
 
@@ -3257,7 +3333,7 @@ END_OF_FUNC
 ####
 'remote_user' => <<'END_OF_FUNC',
 sub remote_user {
-    return $ENV{'REMOTE_USER'};
+    return (defined $ENV{'REMOTE_USER'}) ? $ENV{'REMOTE_USER'} : undef;
 }
 END_OF_FUNC
 
@@ -3426,7 +3502,7 @@ sub read_multipart {
 
 	$header{'Content-Disposition'} ||= ''; # quench uninit variable warning
 
-	my($param)= $header{'Content-Disposition'}=~/ name="([^"]*)"/;
+	my($param)= $header{'Content-Disposition'}=~/[\s;]name="([^"]*)"/;
         $param .= $TAINTED;
 
         # See RFC 1867, 2183, 2045
@@ -3762,7 +3838,9 @@ sub new {
     (my $safename = $name) =~ s/([':%])/ sprintf '%%%02X', ord $1 /eg;
     my $fv = ++$FH . $safename;
     my $ref = \*{"Fh::$fv"};
-    $file =~ m!^([a-zA-Z0-9_\+ \'\":/.\$\\~-]+)$! || return;
+
+    # Note this same regex is also used elsewhere in the same file for CGITempFile::new
+    $file =~ m!^([a-zA-Z0-9_ \'\":/.\$\\\+-]+)$! || return;
     my $safe = $1;
     sysopen($ref,$safe,Fcntl::O_RDWR()|Fcntl::O_CREAT()|Fcntl::O_EXCL(),0600) || return;
     unlink($safe) if $delete;
@@ -4062,10 +4140,11 @@ sub find_tempdir {
 	   "C:${SL}system${SL}temp");
     
     if( $CGI::OS eq 'WINDOWS' ){
-       unshift @TEMP,
-           $ENV{TEMP},
-           $ENV{TMP},
-           $ENV{WINDIR} . $SL . 'TEMP';
+         # PeterH: These evars may not exist if this is invoked within a service and untainting
+         # is in effect - with 'use warnings' the undefined array entries causes Perl to die
+         unshift(@TEMP,$ENV{TEMP}) if defined $ENV{TEMP};
+         unshift(@TEMP,$ENV{TMP}) if defined $ENV{TMP};
+         unshift(@TEMP,$ENV{WINDIR} . $SL . 'TEMP') if defined $ENV{WINDIR};
     }
 
     unshift(@TEMP,$ENV{'TMPDIR'}) if defined $ENV{'TMPDIR'};
@@ -4117,7 +4196,8 @@ sub new {
 	last if ! -f ($filename = sprintf("\%s${SL}CGItemp%d", $TMPDIRECTORY, $sequence++));
     }
     # check that it is a more-or-less valid filename
-    return unless $filename =~ m!^([a-zA-Z0-9_\+ \'\":/.\$\\~-]+)$!;
+    # Note this same regex is also used elsewhere in the same file for Fh::new
+    return unless $filename =~ m!^([a-zA-Z0-9_ \'\":/.\$\\\+-]+)$!;
     # this used to untaint, now it doesn't
     # $filename = $1;
     return bless \$filename;
@@ -5135,13 +5215,13 @@ In either case, the outgoing header will be formatted as:
 
 =head2 GENERATING A REDIRECTION HEADER
 
-   print redirect('http://somewhere.else/in/movie/land');
+   print $q->redirect('http://somewhere.else/in/movie/land');
 
 Sometimes you don't want to produce a document yourself, but simply
 redirect the browser elsewhere, perhaps choosing a URL based on the
 time of day or the identity of the user.  
 
-The redirect() function redirects the browser to a different URL.  If
+The redirect() method redirects the browser to a different URL.  If
 you use redirection like this, you should B<not> print out a header as
 well.
 
@@ -5150,9 +5230,14 @@ redirection requests.  Relative URLs will not work correctly.
 
 You can also use named arguments:
 
-    print redirect(-uri=>'http://somewhere.else/in/movie/land',
-			   -nph=>1,
-                           -status=>301);
+    print $q->redirect(
+        -uri=>'http://somewhere.else/in/movie/land',
+	    -nph=>1,
+         -status=>301);
+
+All names arguments recognized by header() are also recognized by
+redirect(). However, most HTTP headers, including those generated by
+-cookie and -target, are ignored by the browser.
 
 The B<-nph> parameter, if set to a true value, will issue the correct
 headers to work with a NPH (no-parse-header) script.  This is important
@@ -5606,7 +5691,7 @@ This is extremely useful for creating tables.  For example:
 
    print table({-border=>undef},
            caption('When Should You Eat Your Vegetables?'),
-           Tr({-align=>CENTER,-valign=>TOP},
+           Tr({-align=>'CENTER',-valign=>'TOP'},
            [
               th(['Vegetable', 'Breakfast','Lunch','Dinner']),
               td(['Tomatoes' , 'no', 'yes', 'yes']),
@@ -5787,13 +5872,13 @@ default is to process the query with the current script.
 		    -action=>$action,
 		    -enctype=>$encoding);
       <... various form stuff ...>
-    print endform;
+    print end_form;
 
 	-or-
 
     print start_form($method,$action,$encoding);
       <... various form stuff ...>
-    print endform;
+    print end_form;
 
 start_form() will return a <form> tag with the optional method,
 action and form encoding that you specify.  The defaults are:
@@ -5802,14 +5887,14 @@ action and form encoding that you specify.  The defaults are:
     action: this script
     enctype: application/x-www-form-urlencoded
 
-endform() returns the closing </form> tag.  
+end_form() returns the closing </form> tag.  
 
 Start_form()'s enctype argument tells the browser how to package the various
 fields of the form before sending the form to the server.  Two
 values are possible:
 
-B<Note:> This method was previously named startform(), and startform()
-is still recognized as an alias.
+B<Note:> These methods were previously named startform() and endform(), and they
+are still recognized as aliases of start_form() and end_form().
 
 =over 4
 
@@ -5895,7 +5980,7 @@ JavaScript and DHTML.
 
 A boolean, which, if true, forces the element to take on the value
 specified by B<-value>, overriding the sticky behavior described
-earlier for the B<-no_sticky> pragma.
+earlier for the B<-nosticky> pragma.
 
 =item B<-onChange>, B<-onFocus>, B<-onBlur>, B<-onMouseOver>, B<-onMouseOut>, B<-onSelect>
 
@@ -6441,7 +6526,7 @@ list.  Otherwise, they will be strung together on a horizontal line.
 =back
 
 
-The optional B<-labels> argument is a pointer to a hash
+The optional b<-labels> argument is a pointer to a hash
 relating the checkbox values to the user-visible labels that will be
 printed next to them.  If not provided, the values will be used as the
 default.
@@ -6453,7 +6538,7 @@ checkbox group formatted with the specified number of rows and
 columns.  You can provide just the -columns parameter if you wish;
 checkbox_group will calculate the correct number of rows for you.
 
-The option B<-disabled> takes an array of checkbox values and disables
+The option b<-disabled> takes an array of checkbox values and disables
 them by greying them out (this may not be supported by all browsers).
 
 The optional B<-attributes> argument is provided to assign any of the
@@ -7507,7 +7592,7 @@ running under IIS and put itself into this mode.  You do not need to
 do this manually, although it won't hurt anything if you do.  However,
 note that if you have applied Service Pack 6, much of the
 functionality of NPH scripts, including the ability to redirect while
-setting a cookie, B<do not work at all> on IIS without a special patch
+setting a cookie, b<do not work at all> on IIS without a special patch
 from Microsoft.  See
 http://support.microsoft.com/support/kb/articles/Q280/3/41.ASP:
 Non-Parsed Headers Stripped From CGI Applications That Have nph-
@@ -7730,7 +7815,7 @@ of CGI.pm without rewriting your old scripts from scratch.
 
 =head1 AUTHOR INFORMATION
 
-The GD.pm interface is copyright 1995-2007, Lincoln D. Stein.  It is
+The CGI.pm distribution is copyright 1995-2007, Lincoln D. Stein.  It is
 distributed under GPL and the Artistic License 2.0.
 
 Address bug reports and comments to: lstein@cshl.org.  When sending
@@ -7849,7 +7934,7 @@ for suggestions and bug fixes.
 	   print "<p>",reset;
 	   print submit('Action','Shout');
 	   print submit('Action','Scream');
-	   print endform;
+	   print end_form;
 	   print "<hr>\n";
 	}
 
diff --git a/lib/CGI/Apache.pm b/lib/CGI/Apache.pm
index c711a48..e055e30 100644
--- a/lib/CGI/Apache.pm
+++ b/lib/CGI/Apache.pm
@@ -1,6 +1,7 @@
+package CGI::Apache;
 use CGI;
 
-$VERSION = '1.00';
+$VERSION = '1.01';
 
 1;
 __END__
diff --git a/lib/CGI/Carp.pm b/lib/CGI/Carp.pm
index 4ddf27c..aa79d19 100644
--- a/lib/CGI/Carp.pm
+++ b/lib/CGI/Carp.pm
@@ -300,10 +300,6 @@ Address bug reports and comments to: lstein@cshl.org
 
 Carp, CGI::Base, CGI::BasePlus, CGI::Request, CGI::MiniSvr, CGI::Form,
 CGI::Response
-    if (defined($CGI::Carp::PROGNAME)) 
-    {
-      $file = $CGI::Carp::PROGNAME;
-    }
 
 =cut
 
@@ -323,7 +319,7 @@ use File::Spec;
 
 $main::SIG{__WARN__}=\&CGI::Carp::warn;
 
-$CGI::Carp::VERSION     = '1.30_01';
+$CGI::Carp::VERSION     = '3.45';
 $CGI::Carp::CUSTOM_MSG  = undef;
 $CGI::Carp::DIE_HANDLER = undef;
 
@@ -524,7 +520,11 @@ END
     if (ref($CUSTOM_MSG) eq 'CODE') {
       print STDOUT "Content-type: text/html\n\n" 
         unless $mod_perl;
-      &$CUSTOM_MSG($msg); # nicer to perl 5.003 users
+        eval { 
+            &$CUSTOM_MSG($msg); # nicer to perl 5.003 users
+        };
+        if ($@) { print STDERR q(error while executing the error handler: $@); }
+
       return;
     } else {
       $outer_message = $CUSTOM_MSG;
diff --git a/lib/CGI/Changes b/lib/CGI/Changes
index 9b9f566..a45e39b 100644
--- a/lib/CGI/Changes
+++ b/lib/CGI/Changes
@@ -1,3 +1,48 @@
+Version 3.45
+  [BUG FIXES]
+  1. Prevent warnings about "uninitialized values" for REQUEST_URI, HTTP_USER_AGENT and other environment variables.
+     Patches by Callum Gibson, heiko and Mark Stosberg. (RT#24684, RT#29065)
+  2. Avoid death in some cases when running under Taint mode on Windows. 
+     Patch by Peter Hancock (RT#43796)
+  3. Allow 0 to be used as a default value in popup_menu(). This was broken starting in 3.37.
+     Thanks to Haze, who was the first to report this and supply a patch, and pfschill, who pinpointed
+     when the bug was introduced. A regression test for this was also added. (RT#37908)
+  4. Allow "+" as a valid character in file names, which fixes temp file creation on OS X Leopard.  
+     Thanks to Andy Armstrong, and alech for patches. (RT#30504) 
+  5. Set binmode() on the Netware platform, thanks to Guenter Knauf (RT#27455)
+  6. Don't allow a CGI::Carp error handler to die recursively. Print a warning and exit instead. 
+     Thanks to Marc Chantreux. (RT#45956)
+  7. The Dump() method now is fixed to escape HTML properly. Thanks to Mark Stosberg (RT#21341)
+  8. Support for <optgroup> with scrolling_list() now works the same way as it does for popup_menu().
+     Thanks to Stuart Johnston (RT#30097)
+  9. CGI::Pretty now works properly when $" is set to ''. Thanks to Jim Keenan (RT#12401)
+ 10. Fix crash when used in combination with PerlEx::DBI. Thanks to Burak Gürsoy (RT#19902)
+
+  [DOCUMENTATION]
+  1. Several typos were fixed, Thanks to ambs. (RT#41105)
+  2. A typo related to the nosticky pragma was fixed, thanks to Britton Kerin. (RT#43220)
+  3. examples/nph-clock.cgi is now more portable, by calling localtime() rather than `/bin/date`,
+     thanks to Guenter Knauf. (RT#27456).
+  4. In CGI::Carp, the SEE ALSO section was cleaned up, thanks to Slaven Rezic. (RT#32769)
+  5. The docs for redirect() were updated to reflect that most headers are
+     ignored during redirection. Thanks to Mark Stosberg (RT#44911)
+
+  [INTERNALS]  
+  1. New t/unescapeHTML.t test script has been added. It includes a TODO test for a pre-existing
+     bug which could use a patch. Thanks to Pete Gamache and Mark Stosberg (RT#39122)
+  2. New test scripts have been added for user_agent(), popup_menu() and query_string(), scrolling_list() and Dump()
+     Thanks to Mark Stosberg and Stuart Johnston. (RT#37908, RT#43006, RT#21341, RT#30097)
+  3. CGI::Carp and CGI::Util have been updated to have non-developer version numbers. 
+     Thanks to Slaven Rezic. (RT#48425)
+  4. CGI::Switch and CGI::Apache now properly set their VERSION in their own name space.  
+     Thanks to Alexey Tourbin (RT#11941,RT#11942)
+
+  Version 3.44
+  1. Patch from Kurt Jaeger to allow HTTP PUT even if the content length is unknown.
+  2. Patch from Pavel merdin to fix a problem for one of the FireFox addons.
+  3. Fixed issue in mod_perl & fastCGI environment of cookies returned from 
+     CGI->cookie() leaking from one session to another.
+
   Version 3.43
   1. Documentation patch from MARKSTOS@cpan.org to replace all occurrences of
   "new CGI" with CGI->new()" to reflect best perl practices.
diff --git a/lib/CGI/Cookie.pm b/lib/CGI/Cookie.pm
index c9f318e..f2535f4 100644
--- a/lib/CGI/Cookie.pm
+++ b/lib/CGI/Cookie.pm
@@ -21,9 +21,14 @@ use overload '""' => \&as_string,
     'cmp' => \&compare,
     'fallback'=>1;
 
+my $PERLEX = 0;
+# Turn on special checking for ActiveState's PerlEx
+$PERLEX++ if defined($ENV{'GATEWAY_INTERFACE'}) && $ENV{'GATEWAY_INTERFACE'} =~ /^CGI-PerlEx/;
+
 # Turn on special checking for Doug MacEachern's modperl
+# PerlEx::DBI tries to fool DBI by setting MOD_PERL
 my $MOD_PERL = 0;
-if (exists $ENV{MOD_PERL}) {
+if (exists $ENV{MOD_PERL} && ! $PERLEX) {
   if (exists $ENV{MOD_PERL_API_VERSION} && $ENV{MOD_PERL_API_VERSION} == 2) {
       $MOD_PERL = 2;
       require Apache2::RequestUtil;
diff --git a/lib/CGI/Pretty.pm b/lib/CGI/Pretty.pm
index 44e9186..83d5a58 100644
--- a/lib/CGI/Pretty.pm
+++ b/lib/CGI/Pretty.pm
@@ -10,7 +10,7 @@ package CGI::Pretty;
 use strict;
 use CGI ();
 
-$CGI::Pretty::VERSION = '1.08';
+$CGI::Pretty::VERSION = '3.44';
 $CGI::DefaultClass = __PACKAGE__;
 $CGI::Pretty::AutoloadClass = 'CGI';
 @CGI::Pretty::ISA = qw( CGI );
@@ -105,7 +105,7 @@ sub _make_tag_func {
                       
   	              \$args[0] .= \$" if \$args[0] !~ /\$CGI::Pretty::LINEBREAK\$/ && 1;
 		  }
-                  chop \$args[0];
+                  chop \$args[0] unless \$" eq "";
 	      }
             }
             else {
@@ -127,8 +127,11 @@ sub _make_tag_func {
                     \$untag . \$CGI::Pretty::LINEBREAK
                 } \@args;
 	    }
-	    local \$" = "" if \$CGI::Pretty::LINEBREAK || \$CGI::Pretty::INDENT;
-	    return "\@result";
+            if (\$CGI::Pretty::LINEBREAK || \$CGI::Pretty::INDENT) {
+                return join ("", \@result);
+            } else {
+                return "\@result";
+            }
 	}#;
     }    
 
diff --git a/lib/CGI/Switch.pm b/lib/CGI/Switch.pm
index b8cc9ef..a311080 100644
--- a/lib/CGI/Switch.pm
+++ b/lib/CGI/Switch.pm
@@ -1,6 +1,7 @@
+package CGI::Switch;
 use CGI;
 
-$VERSION = '1.00';
+$VERSION = '1.01';
 
 1;
 
diff --git a/lib/CGI/Util.pm b/lib/CGI/Util.pm
index 8ac1764..9a0ea2b 100644
--- a/lib/CGI/Util.pm
+++ b/lib/CGI/Util.pm
@@ -7,7 +7,7 @@ require Exporter;
 @EXPORT_OK = qw(rearrange rearrange_header make_attributes unescape escape 
 		expires ebcdic2ascii ascii2ebcdic);
 
-$VERSION = '1.5_01';
+$VERSION = '3.45';
 
 $EBCDIC = "\t" ne "\011";
 # (ord('^') == 95) for codepage 1047 as on os390, vmesa
diff --git a/lib/CGI/eg/nph-clock.cgi b/lib/CGI/eg/nph-clock.cgi
old mode 100644
new mode 100755
index 55a2fbe..f34fde2
--- a/lib/CGI/eg/nph-clock.cgi
+++ b/lib/CGI/eg/nph-clock.cgi
@@ -5,7 +5,7 @@ use CGI::Push qw(:standard :html3);
 do_push(-next_page=>\&draw_time,-delay=>1);
 
 sub draw_time {
-    my $time = `/bin/date`;
+    my $time = localtime();
     return start_html('Tick Tock'),
            div({-align=>CENTER},
 	       h1('Virtual Clock'),
diff --git a/lib/CGI/t/Dump.t b/lib/CGI/t/Dump.t
new file mode 100644
index 0000000..fafb5b2
--- /dev/null
+++ b/lib/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/lib/CGI/t/form.t b/lib/CGI/t/form.t
index dea0046..b532db9 100644
--- a/lib/CGI/t/form.t
+++ b/lib/CGI/t/form.t
@@ -1,10 +1,6 @@
 #!/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 => 19;
+use Test::More tests => 22;
 
 BEGIN { use_ok('CGI'); };
 use CGI (':standard','-no_debug','-tabindex');
@@ -134,3 +130,48 @@ is(checkbox_group(-name   => 'game',
    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/lib/CGI/t/popup_menu.t b/lib/CGI/t/popup_menu.t
new file mode 100644
index 0000000..3c7d33e
--- /dev/null
+++ b/lib/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/lib/CGI/t/query_string.t b/lib/CGI/t/query_string.t
new file mode 100644
index 0000000..a792232
--- /dev/null
+++ b/lib/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/lib/CGI/t/unescapeHTML.t b/lib/CGI/t/unescapeHTML.t
new file mode 100644
index 0000000..fc0f750
--- /dev/null
+++ b/lib/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/lib/CGI/t/upload.t b/lib/CGI/t/upload.t
index 58f0971..0989f1d 100644
--- a/lib/CGI/t/upload.t
+++ b/lib/CGI/t/upload.t
@@ -7,17 +7,7 @@
 
 # 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
-
-my $test_file;
-if($ENV{PERL_CORE}) {
-   chdir 't';
-   @INC = '../lib';
-   use File::Spec ();
-   $test_file = File::Spec->catfile(qw(.. lib CGI t), "upload_post_text.txt");
-} else {
-   use lib qw(. ./blib/lib ./blib/arch);
-   $test_file = "t/upload_post_text.txt";
-}
+use lib qw(. ./blib/lib ./blib/arch);
 
 use strict;
 
@@ -77,7 +67,7 @@ my $q;
 
 {
     local *STDIN;
-    open STDIN, "< $test_file"
+    open STDIN, '<t/upload_post_text.txt'
         or die 'missing test file t/upload_post_text.txt';
     binmode STDIN;
     $q = CGI->new;
diff --git a/lib/CGI/t/uploadInfo.t b/lib/CGI/t/uploadInfo.t
index 591afa6..970429b 100644
--- a/lib/CGI/t/uploadInfo.t
+++ b/lib/CGI/t/uploadInfo.t
@@ -7,17 +7,7 @@
 
 # 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
-
-my $test_file;
-if($ENV{PERL_CORE}) {
-   chdir 't';
-   @INC = '../lib';
-   use File::Spec ();
-   $test_file = File::Spec->catfile(qw(.. lib CGI t), "upload_post_text.txt");
-} else {
-   use lib qw(. ./blib/lib ./blib/arch);
-   $test_file = "t/upload_post_text.txt";
-}
+use lib qw(. ./blib/lib ./blib/arch);
 
 use strict;
 
@@ -78,7 +68,7 @@ my $q;
 
 {
     local *STDIN;
-    open STDIN, "< $test_file"
+    open STDIN, '<t/upload_post_text.txt'
         or die 'missing test file t/upload_post_text.txt';
     binmode STDIN;
     $q = CGI->new;
diff --git a/lib/CGI/t/user_agent.t b/lib/CGI/t/user_agent.t
new file mode 100644
index 0000000..1a4880d
--- /dev/null
+++ b/lib/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'); 
+
+