Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

This is version 2.55

  • Loading branch information...
commit 818eff36583c348fd5f9e6ca114316979e49e431 1 parent 8bf57ac
lstein authored
View
27 ANNOUNCE
@@ -1,16 +1,25 @@
-CGI.pm version 2.53 is now available for your fun and edification.
-This is identical to the 2.52 release, except that the regression
-tests have been updated to handle the intentional changes in 2.52.
+CGI.pm version 2.54 is now available for your fun and edification.
+This will be the last version of the monolithic CGI.pm module.
-Version 2.52 includes the following bug fixes and features:
+The new version, 3.0, will be fully modularized and optimized for
+faster loading and execution (thanks to a comprehensive rewrite by
+David James).
-1. VMS and DOS fixes
-2. More cookie fixes
-3. Linebreaks supported in dump routine
-4. spurious newline removed from checkbox().
+Fixes in this version:
+
+1. Removed automatic domain name addition from CGI::Cookie. This will
+BREAK some versions of Internet Explorer, but will fix problems that
+arise in internal networks when the host table-based domain names are
+not fully qualified. To avoid breaking browsers, ALWAYS use the
+-domain argument when creating cookies -- and fix your host tables!
+
+2. Fixed problems in escape() handling of + signs.
+
+3. Improvements to CGI::Pretty from Brian Paulsen (*not* regression
+tested).
Lincoln Stein
-6/9/99
+8/9/99
========================================================================
Lincoln D. Stein
View
43 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.55';
# 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) {
+ unless (defined $filename) {
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;
@@ -5075,7 +5080,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 +6434,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;
View
23 CGI/Apache.pm
@@ -0,0 +1,23 @@
+use CGI;
+1;
+__END__
+
+=head1 NAME
+
+CGI::Apache - Backward compatibility module for CGI.pm
+
+=head1 SYNOPSIS
+
+Do not use this module. It is deprecated.
+
+=head1 ABSTRACT
+
+=head1 DESCRIPTION
+
+=head1 AUTHOR INFORMATION
+
+=head1 BUGS
+
+=head1 SEE ALSO
+
+=cut
View
16 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>
View
143 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
-
View
24 CGI/Switch.pm
@@ -0,0 +1,24 @@
+use CGI;
+1;
+
+__END__
+
+=head1 NAME
+
+CGI::Switch - Backward compatibility module for defunct CGI::Switch
+
+=head1 SYNOPSIS
+
+Do not use this module. It is deprecated.
+
+=head1 ABSTRACT
+
+=head1 DESCRIPTION
+
+=head1 AUTHOR INFORMATION
+
+=head1 BUGS
+
+=head1 SEE ALSO
+
+=cut
View
2  MANIFEST
@@ -5,6 +5,8 @@ CGI/Cookie.pm
CGI/Fast.pm
CGI/Pretty.pm
CGI/Push.pm
+CGI/Switch.pm
+CGI/Apache.pm
MANIFEST
Makefile.PL
README
View
2  README
@@ -1,6 +1,6 @@
WHAT IS THIS?
-This is CGI.pm 2.51, an easy-to-use Perl5 library for writing World
+This is CGI.pm, an easy-to-use Perl5 library for writing World
Wide Web CGI scripts.
HOW DO I INSTALL IT?
View
27 cgi_docs.html
@@ -6,7 +6,7 @@
<BODY bgcolor="#FFFFFF">
<H1><IMG SRC="examples/dna.small.gif" ALT="[logo]">
CGI.pm - a Perl5 CGI Library</H1>
-Version 2.53, 6/9/1999, L. Stein
+Version 2.55, 8/31/1999, L. Stein
<p>
<H2>Abstract</H2> This perl 5 library uses objects to create Web
@@ -4548,7 +4548,7 @@
reports, please provide the following information:
<ul>
- <li>the version of CGI.pm (<code>perl -MCGI -e 'print '$CGI::VERSION'</code>)
+ <li>the version of CGI.pm (<code>perl -MCGI -e 'print $CGI::VERSION'</code>)
<li>the version of Perl (<code>perl -v</code>)
<li>the name and version of your Web server
<li>the name and version of the operating system you are using
@@ -4566,6 +4566,27 @@
<HR>
<H2><A NAME="new">Revision History</A></H2>
+
+<h3>Version 2.55</h3>
+<ol>
+ <li>Fixed cookie regression test so as not to produce an error.
+ <li>Fixed path_info() and self_url() to work correctly together when
+ path_info() modified.
+ <li>Removed manify warnings from CGI::{Switch,Apache}.
+</ol>
+
+<h3>Version 2.54</h3>
+<ol>
+ <li>This will be the last release of the monolithic CGI.pm module. Later versions will be
+ modularized and optimized.
+ <li>DOMAIN tag no longer added to cookies by default. This will break some versions of
+ Internet Explorer, but will avoid breaking networks which use host tables without fully
+ qualified domain names. For compatibility, please always add the -domain tag when creating
+ cookies.
+ <li>Fixed escape() method so that +'s are treated correctly.
+ <li>Updated CGI::Pretty module.
+</ol>
+
<h3>Version 2.53</h3>
<ol>
<li>Forgot to upgrade regression tests before releasing 2.52. <b>NOTHING ELSE HAS CHANGED IN LIBRARY</b>
@@ -5262,6 +5283,6 @@
<a href="http://www.cshl.org/">Cold Spring Harbor Laboratory</a></ADDRESS>
<P>
<!-- hhmts start -->
-Last modified: Wed Jun 9 10:50:08 EDT 1999
+Last modified: Tue Aug 31 13:03:44 EDT 1999
<!-- hhmts end -->
</BODY> </HTML>
View
4 examples/index.html
@@ -108,12 +108,12 @@
<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>
View
4 t/html.t
@@ -55,8 +55,8 @@ 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()");
-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,
+ 'fred=chocolate&chip; path=/',"cookie()");
+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)");
test(18,start_h3 eq '<H3>');
test(19,end_h3 eq '</H3>');
Please sign in to comment.
Something went wrong with that request. Please try again.