7 files changed, 286 insertions, 170 deletions

diff --git a/contrib/perl5/lib/CGI/Apache.pm b/contrib/perl5/lib/CGI/Apache.pm
index 82a3669..dced866 100644
--- a/contrib/perl5/lib/CGI/Apache.pm
+++ b/contrib/perl5/lib/CGI/Apache.pm
@@ -1,103 +1,23 @@
-package CGI::Apache;
-use Apache ();
-use vars qw(@ISA $VERSION);
-require CGI;
-@ISA = qw(CGI);
-
-$VERSION = (qw$Revision: 1.1 $)[1];
-$CGI::DefaultClass = 'CGI::Apache';
-$CGI::Apache::AutoloadClass = 'CGI';
-
-sub import {
-    my $self = shift;
-    my ($callpack, $callfile, $callline) = caller;
-    ${"${callpack}::AutoloadClass"} = 'CGI';
-}
-
-sub new {
-    my($class) = shift;
-    my($r) = Apache->request;
-    %ENV = $r->cgi_env unless defined $ENV{GATEWAY_INTERFACE}; #PerlSetupEnv On 
-    my $self = $class->SUPER::new(@_);
-    $self->{'.req'} = $r;
-    $self;
-}
-
-sub header {
-    my ($self,@rest) = CGI::self_or_default(@_);
-    my $r = $self->{'.req'};
-    $r->basic_http_header;
-    return CGI::header($self,@rest);
-}		     
-
-sub print {
-    my($self,@rest) = CGI::self_or_default(@_);
-    $self->{'.req'}->print(@rest);
-}
-
-sub read_from_client {
-    my($self, $fh, $buff, $len, $offset) = @_;
-    my $r = $self->{'.req'} || Apache->request;
-    return $r->read($$buff, $len, $offset);
-}
-
-sub new_MultipartBuffer {
-    my $self = shift;
-    my $new = CGI::Apache::MultipartBuffer->new($self, @_); 
-    $new->{'.req'} = $self->{'.req'} || Apache->request;
-    return $new;
-}
-
-package CGI::Apache::MultipartBuffer;
-use vars qw(@ISA);
-@ISA = qw(MultipartBuffer);
-
-$CGI::Apache::MultipartBuffer::AutoloadClass = 'MultipartBuffer';
-*CGI::Apache::MultipartBuffer::read_from_client = 
-    \&CGI::Apache::read_from_client;
-
-
+use CGI;
 1;
-
 __END__
 
 =head1 NAME
 
-CGI::Apache - Make things work with CGI.pm against Perl-Apache API
+CGI::Apache - Backward compatibility module for CGI.pm
 
 =head1 SYNOPSIS
 
- require CGI::Apache;
-
- my $q = new Apache::CGI;
+Do not use this module.  It is deprecated.
 
- $q->print($q->header);
-
- #do things just like you do with CGI.pm
+=head1 ABSTRACT
 
 =head1 DESCRIPTION
 
-When using the Perl-Apache API, your applications are faster, but the
-environment is different than CGI.
-This module attempts to set-up that environment as best it can.
-
-=head1 NOTE 1
+=head1 AUTHOR INFORMATION
 
-This module used to be named Apache::CGI.  Sorry for the confusion.
-
-=head1 NOTE 2
-
-If you're going to inherit from this class, make sure to "use" it
-after your package declaration rather than "require" it.  This is
-because CGI.pm does a little magic during the import() step in order
-to make autoloading work correctly.
+=head1 BUGS
 
 =head1 SEE ALSO
 
-perl(1), Apache(3), CGI(3)
-
-=head1 AUTHOR
-
-Doug MacEachern E<lt>dougm@osf.orgE<gt>, hacked over by Andreas KE<ouml>nig E<lt>a.koenig@mind.deE<gt>, modified by Lincoln Stein <lt>lstein@genome.wi.mit.edu<gt>
-
 =cut
diff --git a/contrib/perl5/lib/CGI/Carp.pm b/contrib/perl5/lib/CGI/Carp.pm
index dfae1a6..90e9552 100644
--- a/contrib/perl5/lib/CGI/Carp.pm
+++ b/contrib/perl5/lib/CGI/Carp.pm
@@ -192,9 +192,16 @@ use Carp;
 @EXPORT = qw(confess croak carp);
 @EXPORT_OK = qw(carpout fatalsToBrowser wrap set_message cluck);
 
+BEGIN {
+  $] >= 5.005
+    ? eval q#sub ineval { $^S }#
+      : eval q#sub ineval { _longmess() =~ /eval [\{\']/m }#;
+  $@ and die;
+}
+
 $main::SIG{__WARN__}=\&CGI::Carp::warn;
 $main::SIG{__DIE__}=\&CGI::Carp::die;
-$CGI::Carp::VERSION = '1.13';
+$CGI::Carp::VERSION = '1.14';
 $CGI::Carp::CUSTOM_MSG = undef;
 
 # fancy import routine detects and handles 'errorWrap' specially.
@@ -216,7 +223,7 @@ sub realdie { CORE::die(@_); }
 sub id {
     my $level = shift;
     my($pack,$file,$line,$sub) = caller($level);
-    my($id) = $file=~m|([^/]+)$|;
+    my($id) = $file=~m|([^/]+)\z|;
     return ($file,$line,$id);
 }
 
@@ -228,7 +235,7 @@ sub stamp {
 	$id = $file;
 	($pack,$file) = caller($frame++);
     } until !$file;
-    ($id) = $id=~m|([^/]+)$|;
+    ($id) = $id=~m|([^/]+)\z|;
     return "[$time] $id: ";
 }
 
@@ -251,14 +258,15 @@ sub _longmess {
 }
 
 sub die {
-    my $message = shift;
-    my $time = scalar(localtime);
-    my($file,$line,$id) = id(1);
-    $message .= " at $file line $line." unless $message=~/\n$/;
-    &fatalsToBrowser($message) if $WRAP && _longmess() !~ /eval [{\']/m;
-    my $stamp = stamp;
-    $message=~s/^/$stamp/gm;
-    realdie $message;
+  realdie @_ if ineval;
+  my $message = shift;
+  my $time = scalar(localtime);
+  my($file,$line,$id) = id(1);
+  $message .= " at $file line $line." unless $message=~/\n$/;
+  &fatalsToBrowser($message) if $WRAP;
+  my $stamp = stamp;
+  $message=~s/^/$stamp/gm;
+  realdie $message;
 }
 
 sub set_message {
diff --git a/contrib/perl5/lib/CGI/Cookie.pm b/contrib/perl5/lib/CGI/Cookie.pm
index 204d67b..bd3c3d8 100644
--- a/contrib/perl5/lib/CGI/Cookie.pm
+++ b/contrib/perl5/lib/CGI/Cookie.pm
@@ -7,19 +7,15 @@ package CGI::Cookie;
 # documentation in manual or html file format (these utilities are part of the
 # Perl 5 distribution).
 
-# Copyright 1995,1996, Lincoln D. Stein.  All rights reserved.
+# Copyright 1995-1999, Lincoln D. Stein.  All rights reserved.
 # It may be used and modified freely, but I do request that this copyright
 # notice remain attached to the file.  You may modify this module as you 
 # wish, but if you redistribute a modified version, please attach a note
 # listing the modifications you have made.
 
-# The most recent version and complete docs are available at:
-#   http://www.genome.wi.mit.edu/ftp/pub/software/WWW/cgi_docs.html
-#   ftp://ftp-genome.wi.mit.edu/pub/software/WWW/
+$CGI::Cookie::VERSION='1.12';
 
-$CGI::Cookie::VERSION='1.06';
-
-use CGI;
+use CGI qw(-no_debug);
 use overload '""' => \&as_string,
     'cmp' => \&compare,
     'fallback'=>1;
@@ -100,10 +96,13 @@ sub new {
 	'value'=>[@values],
 	},$class;
 
-    # IE requires the path to be present for some reason.
-    ($path = $ENV{'SCRIPT_NAME'})=~s![^/]+$!! unless $path;
+    # IE requires the path and domain to be present for some reason.
+    $path   = CGI::url(-absolute=>1) unless defined $path;
+# however, this breaks networks which use host tables without fully qualified
+# names, so we comment it out.
+#    $domain = CGI::virtual_host()    unless defined $domain;
 
-    $self->path($path) if defined $path;
+    $self->path($path)     if defined $path;
     $self->domain($domain) if defined $domain;
     $self->secure($secure) if defined $secure;
     $self->expires($expires) if defined $expires;
@@ -251,10 +250,10 @@ cookie originated from.
 If you provide a cookie path attribute, the browser will check it
 against your script's URL before returning the cookie.  For example,
 if you specify the path "/cgi-bin", then the cookie will be returned
-to each of the scripts "/cgi-bin/tally.pl", "/cgi-bin/order.pl",
-and "/cgi-bin/customer_service/complain.pl", but not to the script
-"/cgi-private/site_admin.pl".  By default, path is set to "/", which
-causes the cookie to be sent to any CGI script on your site.
+to each of the scripts "/cgi-bin/tally.pl", "/cgi-bin/order.pl", and
+"/cgi-bin/customer_service/complain.pl", but not to the script
+"/cgi-private/site_admin.pl".  By default, the path is set to your
+script, so that only it will receive the cookie.
 
 =item B<4. secure flag>
 
@@ -344,7 +343,7 @@ can iterate through the cookies this way:
 
 In a scalar context, fetch() returns a hash reference, which may be more
 efficient if you are manipulating multiple cookies.
-    
+
 CGI.pm uses the URL escaping methods to save and restore reserved characters
 in its cookies.  If you are trying to retrieve a cookie set by a foreign server,
 this escaping method may trip you up.  Use raw_fetch() instead, which has the
@@ -415,5 +414,5 @@ This section intentionally left blank.
 =head1 SEE ALSO
 
 L<CGI::Carp>, L<CGI>
- 
+
 =cut
diff --git a/contrib/perl5/lib/CGI/Fast.pm b/contrib/perl5/lib/CGI/Fast.pm
index a39fe05..b485186 100644
--- a/contrib/perl5/lib/CGI/Fast.pm
+++ b/contrib/perl5/lib/CGI/Fast.pm
@@ -16,7 +16,7 @@ package CGI::Fast;
 # The most recent version and complete docs are available at:
 #   http://www.genome.wi.mit.edu/ftp/pub/software/WWW/cgi_docs.html
 #   ftp://ftp-genome.wi.mit.edu/pub/software/WWW/
-$CGI::Fast::VERSION='1.01';
+$CGI::Fast::VERSION='1.02';
 
 use CGI;
 use FCGI;
@@ -170,5 +170,5 @@ This section intentionally left blank.
 =head1 SEE ALSO
 
 L<CGI::Carp>, L<CGI>
- 
+
 =cut
diff --git a/contrib/perl5/lib/CGI/Pretty.pm b/contrib/perl5/lib/CGI/Pretty.pm
new file mode 100644
index 0000000..4f2eed4
--- /dev/null
+++ b/contrib/perl5/lib/CGI/Pretty.pm
@@ -0,0 +1,236 @@
+package CGI::Pretty;
+
+# See the bottom of this file for the POD documentation.  Search for the
+# string '=head'.
+
+# You can run this file through either pod2man or pod2html to produce pretty
+# documentation in manual or html file format (these utilities are part of the
+# Perl 5 distribution).
+
+use strict;
+use CGI ();
+
+$CGI::Pretty::VERSION = '1.03';
+$CGI::DefaultClass = __PACKAGE__;
+$CGI::Pretty::AutoloadClass = 'CGI';
+@CGI::Pretty::ISA = qw( CGI );
+
+initialize_globals();
+
+sub _prettyPrint {
+    my $input = shift;
+
+    foreach my $i ( @CGI::Pretty::AS_IS ) {
+	if ( $$input =~ /<\/$i>/si ) {
+	    my ( $a, $b, $c, $d, $e ) = $$input =~ /(.*)<$i(\s?)(.*?)>(.*?)<\/$i>(.*)/si;
+	    _prettyPrint( \$a );
+	    _prettyPrint( \$e );
+	    
+	    $$input = "$a<$i$b$c>$d</$i>$e";
+	    return;
+	}
+    }
+    $$input =~ s/$CGI::Pretty::LINEBREAK/$CGI::Pretty::LINEBREAK$CGI::Pretty::INDENT/g;
+}
+
+sub comment {
+    my($self,@p) = CGI::self_or_CGI(@_);
+
+    my $s = "@p";
+    $s =~ s/$CGI::Pretty::LINEBREAK/$CGI::Pretty::LINEBREAK$CGI::Pretty::INDENT/g; 
+    
+    return $self->SUPER::comment( "$CGI::Pretty::LINEBREAK$CGI::Pretty::INDENT$s$CGI::Pretty::LINEBREAK" ) . $CGI::Pretty::LINEBREAK;
+}
+
+sub _make_tag_func {
+    my ($self,$tagname) = @_;
+    return $self->SUPER::_make_tag_func($tagname) if $tagname=~/^(start|end)_/;
+
+    # As Lincoln as noted, the last else clause is VERY hairy, and it
+    # took me a while to figure out what I was trying to do.
+    # What it does is look for tags that shouldn't be indented (e.g. PRE)
+    # and makes sure that when we nest tags, those tags don't get
+    # indented.
+    # For an example, try print td( pre( "hello\nworld" ) );
+    # If we didn't care about stuff like that, the code would be
+    # MUCH simpler.  BTW: I won't claim to be a regular expression
+    # guru, so if anybody wants to contribute something that would
+    # be quicker, easier to read, etc, I would be more than
+    # willing to put it in - Brian
+    
+    return qq{
+	sub $tagname { 
+	    # handle various cases in which we're called
+	    # most of this bizarre stuff is to avoid -w errors
+	    shift if \$_[0] && 
+		(!ref(\$_[0]) && \$_[0] eq \$CGI::DefaultClass) ||
+		    (ref(\$_[0]) &&
+		     (substr(ref(\$_[0]),0,3) eq 'CGI' ||
+		    UNIVERSAL::isa(\$_[0],'CGI')));
+	    
+	    my(\$attr) = '';
+	    if (ref(\$_[0]) && ref(\$_[0]) eq 'HASH') {
+		my(\@attr) = make_attributes('',shift);
+		\$attr = " \@attr" if \@attr;
+	    }
+
+	    my(\$tag,\$untag) = ("\U<$tagname\E\$attr>","\U</$tagname>\E");
+	    return \$tag unless \@_;
+
+	    my \@result;
+	    my \$NON_PRETTIFY_ENDTAGS =  join "", map { "</\$_>" } \@CGI::Pretty::AS_IS;
+
+	    if ( \$NON_PRETTIFY_ENDTAGS =~ /\$untag/ ) {
+		\@result = map { "\$tag\$_\$untag\$CGI::Pretty::LINEBREAK" } 
+		 (ref(\$_[0]) eq 'ARRAY') ? \@{\$_[0]} : "\@_";
+	    }
+	    else {
+		\@result = map { 
+		    chomp; 
+		    if ( \$_ !~ /<\\// ) {
+			s/\$CGI::Pretty::LINEBREAK/\$CGI::Pretty::LINEBREAK\$CGI::Pretty::INDENT/g; 
+		    } 
+		    else {
+			my \$tmp = \$_;
+			CGI::Pretty::_prettyPrint( \\\$tmp );
+			\$_ = \$tmp;
+		    }
+		    "\$tag\$CGI::Pretty::LINEBREAK\$CGI::Pretty::INDENT\$_\$CGI::Pretty::LINEBREAK\$untag\$CGI::Pretty::LINEBREAK" } 
+		(ref(\$_[0]) eq 'ARRAY') ? \@{\$_[0]} : "\@_";
+	    }
+	    local \$" = "";
+	    return "\@result";
+	}
+    };
+}
+
+sub start_html {
+    return CGI::start_html( @_ ) . $CGI::Pretty::LINEBREAK;
+}
+
+sub end_html {
+    return CGI::end_html( @_ ) . $CGI::Pretty::LINEBREAK;
+}
+
+sub new {
+    my $class = shift;
+    my $this = $class->SUPER::new( @_ );
+
+    Apache->request->register_cleanup(\&CGI::Pretty::_reset_globals) if ($CGI::MOD_PERL);
+    $class->_reset_globals if $CGI::PERLEX;
+
+    return bless $this, $class;
+}
+
+sub initialize_globals {
+    # This is the string used for indentation of tags
+    $CGI::Pretty::INDENT = "\t";
+    
+    # This is the string used for seperation between tags
+    $CGI::Pretty::LINEBREAK = "\n";
+
+    # These tags are not prettify'd.
+    @CGI::Pretty::AS_IS = qw( A PRE CODE SCRIPT TEXTAREA );
+
+    1;
+}
+sub _reset_globals { initialize_globals(); }
+
+1;
+
+=head1 NAME
+
+CGI::Pretty - module to produce nicely formatted HTML code
+
+=head1 SYNOPSIS
+
+    use CGI::Pretty qw( :html3 );
+
+    # Print a table with a single data element
+    print table( TR( td( "foo" ) ) );
+
+=head1 DESCRIPTION
+
+CGI::Pretty is a module that derives from CGI.  It's sole function is to
+allow users of CGI to output nicely formatted HTML code.
+
+When using the CGI module, the following code:
+    print table( TR( td( "foo" ) ) );
+
+produces the following output:
+    <TABLE><TR><TD>foo</TD></TR></TABLE>
+
+If a user were to create a table consisting of many rows and many columns,
+the resultant HTML code would be quite difficult to read since it has no
+carriage returns or indentation.
+
+CGI::Pretty fixes this problem.  What it does is add a carriage
+return and indentation to the HTML code so that one can easily read
+it.
+
+    print table( TR( td( "foo" ) ) );
+
+now produces the following output:
+    <TABLE>
+       <TR>
+          <TD>
+             foo
+          </TD>
+       </TR>
+    </TABLE>
+
+
+=head2 Tags that won't be formatted
+
+The <A> and <PRE> tags are not formatted.  If these tags were formatted, the
+user would see the extra indentation on the web browser causing the page to
+look different than what would be expected.  If you wish to add more tags to
+the list of tags that are not to be touched, push them onto the C<@AS_IS> array:
+
+    push @CGI::Pretty::AS_IS,qw(CODE XMP);
+
+=head2 Customizing the Indenting
+
+If you wish to have your own personal style of indenting, you can change the
+C<$INDENT> variable:
+
+    $CGI::Pretty::INDENT = "\t\t";
+
+would cause the indents to be two tabs.
+
+Similarly, if you wish to have more space between lines, you may change the
+C<$LINEBREAK> variable:
+
+    $CGI::Pretty::LINEBREAK = "\n\n";
+
+would create two carriage returns between lines.
+
+If you decide you want to use the regular CGI indenting, you can easily do 
+the following:
+
+    $CGI::Pretty::INDENT = $CGI::Pretty::LINEBREAK = "";
+
+=head1 BUGS
+
+This section intentionally left blank.
+
+=head1 AUTHOR
+
+Brian Paulsen <Brian@ThePaulsens.com>, with minor modifications by
+Lincoln Stein <lstein@cshl.org> for incorporation into the CGI.pm
+distribution.
+
+Copyright 1999, Brian Paulsen.  All rights reserved.
+
+This library is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself.
+
+Bug reports and comments to Brian@ThePaulsens.com.  You can also write
+to lstein@cshl.org, but this code looks pretty hairy to me and I'm not
+sure I understand it!
+
+=head1 SEE ALSO
+
+L<CGI>
+
+=cut
diff --git a/contrib/perl5/lib/CGI/Push.pm b/contrib/perl5/lib/CGI/Push.pm
index e4a66ae..80683a2 100644
--- a/contrib/perl5/lib/CGI/Push.pm
+++ b/contrib/perl5/lib/CGI/Push.pm
@@ -257,7 +257,7 @@ as shown below:
                h1('testing'),
 	       "This page called $counter times";
     }
-   
+
     sub my_last_page {
 	header(-refresh=>'5; URL=http://somewhere.else/finished.html',
 	       -type=>'text/html'),
diff --git a/contrib/perl5/lib/CGI/Switch.pm b/contrib/perl5/lib/CGI/Switch.pm
index 8afc6a6..b16b9c0 100644
--- a/contrib/perl5/lib/CGI/Switch.pm
+++ b/contrib/perl5/lib/CGI/Switch.pm
@@ -1,71 +1,24 @@
-package CGI::Switch;
-use Carp;
-use strict;
-use vars qw($VERSION @Pref);
-$VERSION = '0.06';
-@Pref = qw(CGI::Apache CGI); #default
-
-sub import {
-    my($self,@arg) = @_;
-    @Pref = @arg if @arg;
-}
-
-sub new {
-    shift;
-    my($file,$pack);
-    for $pack (@Pref) {
-	($file = $pack) =~ s|::|/|g;
-	eval { require "$file.pm"; };
-	if ($@) {
-#XXX	    warn $@;
-	    next;
-	} else {
-#XXX	    warn "Going to try $pack\->new\n";
-	    my $obj;
-	    eval {$obj = $pack->new(@_)};
-	    if ($@) {
-#XXX		warn $@;
-	    } else {
-		return $obj;
-	    }
-	}
-    }
-    Carp::croak "Couldn't load+construct any of @Pref\n";
-}
-
+use CGI;
 1;
+
 __END__
 
 =head1 NAME
 
-CGI::Switch - Try more than one constructors and return the first object available
+CGI::Switch - Backward compatibility module for defunct CGI::Switch
 
 =head1 SYNOPSIS
 
- 
- use CGISwitch;
-
-  -or-
+Do not use this module.  It is deprecated.
 
- use CGI::Switch This, That, CGI::XA, Foo, Bar, CGI;
-
- my $q = new CGI::Switch;
+=head1 ABSTRACT
 
 =head1 DESCRIPTION
 
-Per default the new() method tries to call new() in the three packages
-Apache::CGI, CGI::XA, and CGI. It returns the first CGI object it
-succeeds with.
+=head1 AUTHOR INFORMATION
 
-The import method allows you to set up the default order of the
-modules to be tested.
+=head1 BUGS
 
 =head1 SEE ALSO
 
-perl(1), Apache(3), CGI(3), CGI::XA(3)
-
-=head1 AUTHOR
-
-Andreas KE<ouml>nig E<lt>a.koenig@mind.deE<gt>
-
 =cut