From: Gurusamy Sarathy <gsar@cpan.org>
Date: Sat, 22 Jan 2000 12:34:39 +0000 (+0000)
Subject: CGI.pm upgraded to v2.56 from CPAN
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=ffd2dff2e01ae9b3aa6cf87f762201cc006553e8;p=p5sagit%2Fp5-mst-13.2.git

CGI.pm upgraded to v2.56 from CPAN

p4raw-id: //depot/perl@4842
---

diff --git a/eg/cgi/index.html b/eg/cgi/index.html
index 4125b28..133ecc4 100644
--- a/eg/cgi/index.html
+++ b/eg/cgi/index.html
@@ -108,12 +108,12 @@ or Internet Explorer 3.0 and higher</EM>
 <HR>
 <MENU>
   <LI> <A HREF="../cgi_docs.html">CGI.pm documentation</A>
-  <LI> <A HREF="../../CGI.pm.tar.gz">Download the CGI.pm distribution</A>
+  <LI> <A HREF="../CGI.pm.tar.gz">Download the CGI.pm distribution</A>
 </MENU>
 <HR>
 <ADDRESS>Lincoln D. Stein, lstein@genome.wi.mit.edu<br>
 <a href="/">Whitehead Institute/MIT Center for Genome Research</a></ADDRESS>
 <!-- hhmts start -->
-Last modified: Tue Nov 24 18:07:15 MET 1998
+Last modified: Wed Jun 23 15:31:47 EDT 1999
 <!-- hhmts end -->
 </BODY> </HTML>
diff --git a/lib/CGI.pm b/lib/CGI.pm
index c0cb5fd..ad7cd02 100644
--- a/lib/CGI.pm
+++ b/lib/CGI.pm
@@ -17,8 +17,8 @@ require 5.004;
 # The most recent version and complete docs are available at:
 #   http://stein.cshl.org/WWW/software/CGI/
 
-$CGI::revision = '$Id: CGI.pm,v 1.18 1999/06/09 14:52:45 lstein Exp $';
-$CGI::VERSION='2.53';
+$CGI::revision = '$Id: CGI.pm,v 1.19 1999/08/31 17:04:37 lstein Exp $';
+$CGI::VERSION='2.56';
 
 # HARD-CODED LOCATION FOR FILE UPLOAD TEMPORARY FILES.
 # UNCOMMENT THIS ONLY IF YOU KNOW WHAT YOU'RE DOING.
@@ -95,6 +95,8 @@ if ($OS=~/Win/i) {
   $OS = 'WINDOWS';
 } elsif ($OS=~/vms/i) {
   $OS = 'VMS';
+} elsif ($OS=~/bsdos/i) {
+  $OS = 'UNIX';
 } elsif ($OS=~/dos/i) {
   $OS = 'DOS';
 } elsif ($OS=~/^MacOS$/i) {
@@ -453,7 +455,7 @@ sub init {
 
     # We now have the query string in hand.  We do slightly
     # different things for keyword lists and parameter lists.
-    if ($query_string ne '') {
+    if (defined $query_string && $query_string) {
 	if ($query_string =~ /=/) {
 	    $self->parse_params($query_string);
 	} else {
@@ -518,7 +520,7 @@ sub cgi_error {
 
 # unescape URL-encoded data
 sub unescape {
-  shift() if ref($_[0]) || $_[0] eq $DefaultClass;
+  shift() if ref($_[0]) || (defined $_[1] && $_[0] eq $DefaultClass);
   my $todecode = shift;
   return undef unless defined($todecode);
   $todecode =~ tr/+/ /;       # pluses become spaces
@@ -532,12 +534,11 @@ sub unescape {
 
 # URL-encode data
 sub escape {
-    shift() if ref($_[0]) || $_[0] eq $DefaultClass;
-    my $toencode = shift;
-    return undef unless defined($toencode);
-    $toencode=~s/ /+/g;
-    $toencode=~s/([^a-zA-Z0-9_.+-])/uc sprintf("%%%02x",ord($1))/eg;
-    return $toencode;
+  shift() if ref($_[0]) || (defined $_[1] && $_[0] eq $DefaultClass);
+  my $toencode = shift;
+  return undef unless defined($toencode);
+  $toencode=~s/([^a-zA-Z0-9_.-])/uc sprintf("%%%02x",ord($1))/eg;
+  return $toencode;
 }
 
 sub save_request {
@@ -851,8 +852,9 @@ END_OF_FUNC
 # with Steve Brenner's cgi-lib.pl routines
 'Vars' => <<'END_OF_FUNC',
 sub Vars {
+    my $q = shift;
     my %in;
-    tie(%in,CGI);
+    tie(%in,CGI,$q);
     return %in if wantarray;
     return \%in;
 }
@@ -917,7 +919,8 @@ END_OF_FUNC
 
 'TIEHASH' => <<'END_OF_FUNC',
 sub TIEHASH { 
-    return $Q || new CGI;
+    return $_[1] if defined $_[1];
+    return $Q || new shift;
 }
 END_OF_FUNC
 
@@ -1520,7 +1523,8 @@ END_OF_FUNC
 'endform' => <<'END_OF_FUNC',
 sub endform {
     my($self,@p) = self_or_default(@_);    
-    return ($self->get_fields,"</FORM>");
+    return wantarray ? ($self->get_fields,"</FORM>") : 
+                        $self->get_fields ."\n</FORM>";
 }
 END_OF_FUNC
 
@@ -2126,7 +2130,7 @@ sub hidden {
 
     $name=$self->escapeHTML($name);
     foreach (@value) {
-	$_=$self->escapeHTML($_);
+	$_ = defined($_) ? $self->escapeHTML($_) : '';
 	push(@result,qq/<INPUT TYPE="hidden" NAME="$name" VALUE="$_">/);
     }
     return wantarray ? @result : join('',@result);
@@ -2200,7 +2204,8 @@ sub url {
         # strip query string
         substr($script_name,$index) = '' if ($index = index($script_name,'?')) >= 0;
         # and path
-        substr($script_name,$index) = '' if $path and ($index = rindex($script_name,$path)) >= 0;
+        substr($script_name,$index) = '' if exists($ENV{PATH_INFO})
+                                     and ($index = rindex($script_name,$ENV{PATH_INFO})) >= 0;
     } else {
 	$script_name = $self->script_name;
     }
@@ -2854,7 +2859,7 @@ sub read_multipart {
 
 	# If no filename specified, then just read the data and assign it
 	# to our parameter list.
-	unless ($filename) {
+	if ( !defined($filename) || $filename eq '' ) {
 	    my($value) = $buffer->readBody;
 	    push(@{$self->{$param}},$value);
 	    next;
@@ -2877,7 +2882,7 @@ sub read_multipart {
           for (my $cnt=10;$cnt>0;$cnt--) {
 	    next unless $tmpfile = new TempFile($seqno);
 	    $tmp = $tmpfile->as_string;
-	    last if $filehandle = Fh->new($filename,$tmp,$PRIVATE_TEMPFILES);
+	    last if defined($filehandle = Fh->new($filename,$tmp,$PRIVATE_TEMPFILES));
             $seqno += int rand(100);
           }
           die "CGI open of tmpfile: $!\n" unless $filehandle;
@@ -2895,7 +2900,7 @@ sub read_multipart {
 
 	  # Save some information about the uploaded file where we can get
 	  # at it later.
-	  $self->{'.tmpfiles'}->{$filename}= {
+	  $self->{'.tmpfiles'}->{fileno($filehandle)}= {
 	      name => $tmpfile,
 	      info => {%header},
 	  };
@@ -2918,8 +2923,8 @@ END_OF_FUNC
 'tmpFileName' => <<'END_OF_FUNC',
 sub tmpFileName {
     my($self,$filename) = self_or_default(@_);
-    return $self->{'.tmpfiles'}->{$filename}->{name} ?
-	$self->{'.tmpfiles'}->{$filename}->{name}->as_string
+    return $self->{'.tmpfiles'}->{fileno($filename)}->{name} ?
+	$self->{'.tmpfiles'}->{fileno($filename)}->{name}->as_string
 	    : '';
 }
 END_OF_FUNC
@@ -2927,7 +2932,7 @@ END_OF_FUNC
 'uploadInfo' => <<'END_OF_FUNC',
 sub uploadInfo {
     my($self,$filename) = self_or_default(@_);
-    return $self->{'.tmpfiles'}->{$filename}->{info};
+    return $self->{'.tmpfiles'}->{fileno($filename)}->{info};
 }
 END_OF_FUNC
 
@@ -2979,7 +2984,7 @@ $AUTOLOADED_ROUTINES=<<'END_OF_AUTOLOAD';
 sub asString {
     my $self = shift;
     # get rid of package name
-    (my $i = $$self) =~ s/^\*(\w+::)+//; 
+    (my $i = $$self) =~ s/^\*(\w+::fh\d{5})+//; 
     $i =~ s/\\(.)/$1/g;
     return $i;
 # BEGIN DEAD CODE
@@ -3005,8 +3010,7 @@ END_OF_FUNC
 sub new {
     my($pack,$name,$file,$delete) = @_;
     require Fcntl unless defined &Fcntl::O_RDWR;
-    ++$FH;
-    my $ref = \*{'Fh::' . quotemeta($name)}; 
+    my $ref = \*{'Fh::' .  ++$FH . quotemeta($name)};
     sysopen($ref,$file,Fcntl::O_RDWR()|Fcntl::O_CREAT()|Fcntl::O_EXCL(),0600) || return;
     unlink($file) if $delete;
     CORE::delete $Fh::{$FH};
@@ -5075,7 +5079,7 @@ Example:
 
    $file = $query->upload('uploaded_file');
    if (!$file && $query->cgi_error) {
-      print $query->header(-status->$query->cgi_error);
+      print $query->header(-status=>$query->cgi_error);
       exit 0;
    }
 
@@ -6429,7 +6433,7 @@ for suggestions and bug fixes.
 				  -rows=>10,
 				  -columns=>50);
  
-	   print "<P>",$query->Reset;
+	   print "<P>",$query->reset;
 	   print $query->submit('Action','Shout');
 	   print $query->submit('Action','Scream');
 	   print $query->endform;
diff --git a/lib/CGI/Apache.pm b/lib/CGI/Apache.pm
index 82a3669..dced866 100644
--- a/lib/CGI/Apache.pm
+++ b/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/lib/CGI/Cookie.pm b/lib/CGI/Cookie.pm
index 433df49..aac0fb0 100644
--- a/lib/CGI/Cookie.pm
+++ b/lib/CGI/Cookie.pm
@@ -13,9 +13,9 @@ package CGI::Cookie;
 # wish, but if you redistribute a modified version, please attach a note
 # listing the modifications you have made.
 
-$CGI::Cookie::VERSION='1.10';
+$CGI::Cookie::VERSION='1.12';
 
-use CGI;
+use CGI qw(-no_debug);
 use overload '""' => \&as_string,
     'cmp' => \&compare,
     'fallback'=>1;
@@ -97,10 +97,12 @@ sub new {
 	},$class;
 
     # IE requires the path and domain to be present for some reason.
-    $path   ||= CGI::url(-absolute=>1);
-    $domain ||= CGI::virtual_host();
+    $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;
@@ -250,8 +252,8 @@ 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, the path is set to the
-directory that contains your 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>
 
diff --git a/lib/CGI/Pretty.pm b/lib/CGI/Pretty.pm
index f8931fb..4f2eed4 100644
--- a/lib/CGI/Pretty.pm
+++ b/lib/CGI/Pretty.pm
@@ -7,28 +7,63 @@ package CGI::Pretty;
 # documentation in manual or html file format (these utilities are part of the
 # Perl 5 distribution).
 
+use strict;
 use CGI ();
 
-$VERSION = '1.0';
+$CGI::Pretty::VERSION = '1.03';
 $CGI::DefaultClass = __PACKAGE__;
-$AutoloadClass = 'CGI';
-@ISA = 'CGI';
+$CGI::Pretty::AutoloadClass = 'CGI';
+@CGI::Pretty::ISA = qw( CGI );
 
-#    These tags should not be prettify'd.  If we did prettify them, the
-#    browser would output text that would have extraneous spaces
-@AS_IS = qw( A PRE );
-my $NON_PRETTIFY_ENDTAGS =  join "", map { "</$_>" } @AS_IS;
+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]) && \$_[0] eq \$CGI::DefaultClass) ||
 		    (ref(\$_[0]) &&
 		     (substr(ref(\$_[0]),0,3) eq 'CGI' ||
 		    UNIVERSAL::isa(\$_[0],'CGI')));
@@ -43,58 +78,64 @@ sub _make_tag_func {
 	    return \$tag unless \@_;
 
 	    my \@result;
-	    if ( "$NON_PRETTIFY_ENDTAGS" =~ /\$untag/ ) {
-		\@result = map { "\$tag\$_\$untag\\n" } 
+	    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/\\n/\\n   /g; 
+			s/\$CGI::Pretty::LINEBREAK/\$CGI::Pretty::LINEBREAK\$CGI::Pretty::INDENT/g; 
 		    } 
 		    else {
-			my \$text = "";
-			my ( \$pretag, \$thistag, \$posttag );
-			while ( /<\\/.*>/si ) {
-			    if ( (\$pretag, \$thistag, \$posttag ) = 
-				/(.*?)<(.*?)>(.*)/si ) {
-				\$pretag =~ s/\\n/\\n   /g;
-				\$text .= "\$pretag<\$thistag>";
-			
-				( \$thistag ) = split ' ', \$thistag;
-				my \$endtag = "</" . uc(\$thistag) . ">";
-				if ( "$NON_PRETTIFY_ENDTAGS" =~ /\$endtag/ ) {
-				    if ( ( \$pretag, \$posttag ) = 
-					\$posttag =~ /(.*?)\$endtag(.*)/si ) {
-					\$text .= "\$pretag\$endtag";
-				    }
-				}
-				
-				\$_ = \$posttag;
-			    }
-			}
-			\$_ = \$text;
-			if ( defined \$posttag ) {
-			    \$posttag =~ s/\\n/\\n   /g;
-			    \$_ .= \$posttag;
-			}
+			my \$tmp = \$_;
+			CGI::Pretty::_prettyPrint( \\\$tmp );
+			\$_ = \$tmp;
 		    }
-		    "\$tag\\n   \$_\\n\$untag\\n" } 
+		    "\$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
@@ -148,22 +189,43 @@ 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 <bpaulsen@lehman.com>, with minor modifications by
+Brian Paulsen <Brian@ThePaulsens.com>, with minor modifications by
 Lincoln Stein <lstein@cshl.org> for incorporation into the CGI.pm
 distribution.
 
-Copyright 1998, Brian Paulsen.  All rights reserved.
+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 bpaulsen@lehman.com.  You can also write
+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!
 
@@ -172,4 +234,3 @@ sure I understand it!
 L<CGI>
 
 =cut
-
diff --git a/lib/CGI/Switch.pm b/lib/CGI/Switch.pm
index 8afc6a6..b16b9c0 100644
--- a/lib/CGI/Switch.pm
+++ b/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
diff --git a/t/lib/cgi-html.t b/t/lib/cgi-html.t
index e878b21..c51318e 100755
--- a/t/lib/cgi-html.t
+++ b/t/lib/cgi-html.t
@@ -69,12 +69,12 @@ test(15,start_html(-Title=>'The world of foo') ."\n" eq <<END,"start_html()");
 END
     ;
 test(16,($cookie=cookie(-name=>'fred',-value=>['chocolate','chip'],-path=>'/')) eq 
-     'fred=chocolate&chip; domain=localhost; path=/',"cookie()");
+     'fred=chocolate&chip; path=/',"cookie()");
 if (!$Is_EBCDIC) {
-test(17,header(-Cookie=>$cookie) =~ m!^Set-Cookie: fred=chocolate&chip\; domain=localhost; path=/\015\012Date:.*\015\012Content-Type: text/html\015\012\015\012!s,
+test(17,header(-Cookie=>$cookie) =~ m!^Set-Cookie: fred=chocolate&chip\; path=/\015\012Date:.*\015\012Content-Type: text/html\015\012\015\012!s,
      "header(-cookie)");
 } else {
-test(17,header(-Cookie=>$cookie) =~ m!^Set-Cookie: fred=chocolate&chip\; domain=localhost; path=/\r\nDate:.*\r\nContent-Type: text/html\r\n\r\n!s,
+test(17,header(-Cookie=>$cookie) =~ m!^Set-Cookie: fred=chocolate&chip\; path=/\r\nDate:.*\r\nContent-Type: text/html\r\n\r\n!s,
      "header(-cookie)");
 }
 test(18,start_h3 eq '<H3>');