From 3282be229999dc36c197b264d63063a18d136331 Mon Sep 17 00:00:00 2001 From: Andreas Brachold Date: Sun, 11 Nov 2007 06:55:13 +0000 Subject: * Update installation list with required modules * Remove unused/doubled provided external perl moduls --- lib/CGI/Apache.pm | 26 --- lib/CGI/Carp.pm | 524 ------------------------------------------------------ lib/CGI/Cookie.pm | 478 ------------------------------------------------- lib/CGI/Fast.pm | 230 ------------------------ lib/CGI/Pretty.pm | 275 ---------------------------- lib/CGI/Push.pm | 328 ---------------------------------- lib/CGI/Switch.pm | 27 --- lib/CGI/Util.pm | 317 --------------------------------- 8 files changed, 2205 deletions(-) delete mode 100644 lib/CGI/Apache.pm delete mode 100644 lib/CGI/Carp.pm delete mode 100644 lib/CGI/Cookie.pm delete mode 100644 lib/CGI/Fast.pm delete mode 100644 lib/CGI/Pretty.pm delete mode 100644 lib/CGI/Push.pm delete mode 100644 lib/CGI/Switch.pm delete mode 100644 lib/CGI/Util.pm (limited to 'lib/CGI') diff --git a/lib/CGI/Apache.pm b/lib/CGI/Apache.pm deleted file mode 100644 index c711a48..0000000 --- a/lib/CGI/Apache.pm +++ /dev/null @@ -1,26 +0,0 @@ -use CGI; - -$VERSION = '1.00'; - -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 diff --git a/lib/CGI/Carp.pm b/lib/CGI/Carp.pm deleted file mode 100644 index e25cd7f..0000000 --- a/lib/CGI/Carp.pm +++ /dev/null @@ -1,524 +0,0 @@ -package CGI::Carp; - -=head1 NAME - -B - CGI routines for writing to the HTTPD (or other) error log - -=head1 SYNOPSIS - - use CGI::Carp; - - croak "We're outta here!"; - confess "It was my fault: $!"; - carp "It was your fault!"; - warn "I'm confused"; - die "I'm dying.\n"; - - use CGI::Carp qw(cluck); - cluck "I wouldn't do that if I were you"; - - use CGI::Carp qw(fatalsToBrowser); - die "Fatal error messages are now sent to browser"; - -=head1 DESCRIPTION - -CGI scripts have a nasty habit of leaving warning messages in the error -logs that are neither time stamped nor fully identified. Tracking down -the script that caused the error is a pain. This fixes that. Replace -the usual - - use Carp; - -with - - use CGI::Carp - -And the standard warn(), die (), croak(), confess() and carp() calls -will automagically be replaced with functions that write out nicely -time-stamped messages to the HTTP server error log. - -For example: - - [Fri Nov 17 21:40:43 1995] test.pl: I'm confused at test.pl line 3. - [Fri Nov 17 21:40:43 1995] test.pl: Got an error message: Permission denied. - [Fri Nov 17 21:40:43 1995] test.pl: I'm dying. - -=head1 REDIRECTING ERROR MESSAGES - -By default, error messages are sent to STDERR. Most HTTPD servers -direct STDERR to the server's error log. Some applications may wish -to keep private error logs, distinct from the server's error log, or -they may wish to direct error messages to STDOUT so that the browser -will receive them. - -The C function is provided for this purpose. Since -carpout() is not exported by default, you must import it explicitly by -saying - - use CGI::Carp qw(carpout); - -The carpout() function requires one argument, which should be a -reference to an open filehandle for writing errors. It should be -called in a C block at the top of the CGI application so that -compiler errors will be caught. Example: - - BEGIN { - use CGI::Carp qw(carpout); - open(LOG, ">>/usr/local/cgi-logs/mycgi-log") or - die("Unable to open mycgi-log: $!\n"); - carpout(LOG); - } - -carpout() does not handle file locking on the log for you at this point. - -The real STDERR is not closed -- it is moved to CGI::Carp::SAVEERR. Some -servers, when dealing with CGI scripts, close their connection to the -browser when the script closes STDOUT and STDERR. CGI::Carp::SAVEERR is there to -prevent this from happening prematurely. - -You can pass filehandles to carpout() in a variety of ways. The "correct" -way according to Tom Christiansen is to pass a reference to a filehandle -GLOB: - - carpout(\*LOG); - -This looks weird to mere mortals however, so the following syntaxes are -accepted as well: - - carpout(LOG); - carpout(main::LOG); - carpout(main'LOG); - carpout(\LOG); - carpout(\'main::LOG'); - - ... and so on - -FileHandle and other objects work as well. - -Use of carpout() is not great for performance, so it is recommended -for debugging purposes or for moderate-use applications. A future -version of this module may delay redirecting STDERR until one of the -CGI::Carp methods is called to prevent the performance hit. - -=head1 MAKING PERL ERRORS APPEAR IN THE BROWSER WINDOW - -If you want to send fatal (die, confess) errors to the browser, ask to -import the special "fatalsToBrowser" subroutine: - - use CGI::Carp qw(fatalsToBrowser); - die "Bad error here"; - -Fatal errors will now be echoed to the browser as well as to the log. CGI::Carp -arranges to send a minimal HTTP header to the browser so that even errors that -occur in the early compile phase will be seen. -Nonfatal errors will still be directed to the log file only (unless redirected -with carpout). - -=head2 Changing the default message - -By default, the software error message is followed by a note to -contact the Webmaster by e-mail with the time and date of the error. -If this message is not to your liking, you can change it using the -set_message() routine. This is not imported by default; you should -import it on the use() line: - - use CGI::Carp qw(fatalsToBrowser set_message); - set_message("It's not a bug, it's a feature!"); - -You may also pass in a code reference in order to create a custom -error message. At run time, your code will be called with the text -of the error message that caused the script to die. Example: - - use CGI::Carp qw(fatalsToBrowser set_message); - BEGIN { - sub handle_errors { - my $msg = shift; - print "

Oh gosh

"; - print "

Got an error: $msg

"; - } - set_message(\&handle_errors); - } - -In order to correctly intercept compile-time errors, you should call -set_message() from within a BEGIN{} block. - -=head1 MAKING WARNINGS APPEAR AS HTML COMMENTS - -It is now also possible to make non-fatal errors appear as HTML -comments embedded in the output of your program. To enable this -feature, export the new "warningsToBrowser" subroutine. Since sending -warnings to the browser before the HTTP headers have been sent would -cause an error, any warnings are stored in an internal buffer until -you call the warningsToBrowser() subroutine with a true argument: - - use CGI::Carp qw(fatalsToBrowser warningsToBrowser); - use CGI qw(:standard); - print header(); - warningsToBrowser(1); - -You may also give a false argument to warningsToBrowser() to prevent -warnings from being sent to the browser while you are printing some -content where HTML comments are not allowed: - - warningsToBrowser(0); # disable warnings - print "\n"; - warningsToBrowser(1); # re-enable warnings - -Note: In this respect warningsToBrowser() differs fundamentally from -fatalsToBrowser(), which you should never call yourself! - -=head1 OVERRIDING THE NAME OF THE PROGRAM - -CGI::Carp includes the name of the program that generated the error or -warning in the messages written to the log and the browser window. -Sometimes, Perl can get confused about what the actual name of the -executed program was. In these cases, you can override the program -name that CGI::Carp will use for all messages. - -The quick way to do that is to tell CGI::Carp the name of the program -in its use statement. You can do that by adding -"name=cgi_carp_log_name" to your "use" statement. For example: - - use CGI::Carp qw(name=cgi_carp_log_name); - -. If you want to change the program name partway through the program, -you can use the C function instead. It is not -exported by default, you must import it explicitly by saying - - use CGI::Carp qw(set_progname); - -Once you've done that, you can change the logged name of the program -at any time by calling - - set_progname(new_program_name); - -You can set the program back to the default by calling - - set_progname(undef); - -Note that this override doesn't happen until after the program has -compiled, so any compile-time errors will still show up with the -non-overridden program name - -=head1 CHANGE LOG - -1.05 carpout() added and minor corrections by Marc Hedlund - on 11/26/95. - -1.06 fatalsToBrowser() no longer aborts for fatal errors within - eval() statements. - -1.08 set_message() added and carpout() expanded to allow for FileHandle - objects. - -1.09 set_message() now allows users to pass a code REFERENCE for - really custom error messages. croak and carp are now - exported by default. Thanks to Gunther Birznieks for the - patches. - -1.10 Patch from Chris Dean (ctdean@cogit.com) to allow - module to run correctly under mod_perl. - -1.11 Changed order of > and < escapes. - -1.12 Changed die() on line 217 to CORE::die to avoid B<-w> warning. - -1.13 Added cluck() to make the module orthogonal with Carp. - More mod_perl related fixes. - -1.20 Patch from Ilmari Karonen (perl@itz.pp.sci.fi): Added - warningsToBrowser(). Replaced tags with
 in
-     fatalsToBrowser() output.
-
-1.23 ineval() now checks both $^S and inspects the message for the "eval" pattern
-     (hack alert!) in order to accomodate various combinations of Perl and
-     mod_perl.
-
-1.24 Patch from Scott Gifford (sgifford@suspectclass.com): Add support
-     for overriding program name.
-
-1.26 Replaced CORE::GLOBAL::die with the evil $SIG{__DIE__} because the
-     former isn't working in some people's hands.  There is no such thing
-     as reliable exception handling in Perl.
-
-1.27 Replaced tell STDOUT with bytes=tell STDOUT.
-
-=head1 AUTHORS
-
-Copyright 1995-2002, Lincoln D. Stein.  All rights reserved.  
-
-This library is free software; you can redistribute it and/or modify
-it under the same terms as Perl itself.
-
-Address bug reports and comments to: lstein@cshl.org
-
-=head1 SEE ALSO
-
-Carp, CGI::Base, CGI::BasePlus, CGI::Request, CGI::MiniSvr, CGI::Form,
-CGI::Response
-    if (defined($CGI::Carp::PROGNAME)) 
-    {
-      $file = $CGI::Carp::PROGNAME;
-    }
-
-=cut
-
-require 5.000;
-use Exporter;
-#use Carp;
-BEGIN { 
-  require Carp; 
-  *CORE::GLOBAL::die = \&CGI::Carp::die;
-}
-
-use File::Spec;
-
-@ISA = qw(Exporter);
-@EXPORT = qw(confess croak carp);
-@EXPORT_OK = qw(carpout fatalsToBrowser warningsToBrowser wrap set_message set_progname cluck ^name= die);
-
-$main::SIG{__WARN__}=\&CGI::Carp::warn;
-
-$CGI::Carp::VERSION    = '1.28';
-$CGI::Carp::CUSTOM_MSG = undef;
-
-
-# fancy import routine detects and handles 'errorWrap' specially.
-sub import {
-    my $pkg = shift;
-    my(%routines);
-    my(@name);
-  
-    if (@name=grep(/^name=/,@_))
-      {
-        my($n) = (split(/=/,$name[0]))[1];
-        set_progname($n);
-        @_=grep(!/^name=/,@_);
-      }
-
-    grep($routines{$_}++,@_,@EXPORT);
-    $WRAP++ if $routines{'fatalsToBrowser'} || $routines{'wrap'};
-    $WARN++ if $routines{'warningsToBrowser'};
-    my($oldlevel) = $Exporter::ExportLevel;
-    $Exporter::ExportLevel = 1;
-    Exporter::import($pkg,keys %routines);
-    $Exporter::ExportLevel = $oldlevel;
-    $main::SIG{__DIE__} =\&CGI::Carp::die if $routines{'fatalsToBrowser'};
-#    $pkg->export('CORE::GLOBAL','die');
-}
-
-# These are the originals
-sub realwarn { CORE::warn(@_); }
-sub realdie { CORE::die(@_); }
-
-sub id {
-    my $level = shift;
-    my($pack,$file,$line,$sub) = caller($level);
-    my($dev,$dirs,$id) = File::Spec->splitpath($file);
-    return ($file,$line,$id);
-}
-
-sub stamp {
-    my $time = scalar(localtime);
-    my $frame = 0;
-    my ($id,$pack,$file,$dev,$dirs);
-    if (defined($CGI::Carp::PROGNAME)) {
-        $id = $CGI::Carp::PROGNAME;
-    } else {
-        do {
-  	  $id = $file;
-	  ($pack,$file) = caller($frame++);
-        } until !$file;
-    }
-    ($dev,$dirs,$id) = File::Spec->splitpath($id);
-    return "[$time] $id: ";
-}
-
-sub set_progname {
-    $CGI::Carp::PROGNAME = shift;
-    return $CGI::Carp::PROGNAME;
-}
-
-
-sub warn {
-    my $message = shift;
-    my($file,$line,$id) = id(1);
-    $message .= " at $file line $line.\n" unless $message=~/\n$/;
-    _warn($message) if $WARN;
-    my $stamp = stamp;
-    $message=~s/^/$stamp/gm;
-    realwarn $message;
-}
-
-sub _warn {
-    my $msg = shift;
-    if ($EMIT_WARNINGS) {
-	# We need to mangle the message a bit to make it a valid HTML
-	# comment.  This is done by substituting similar-looking ISO
-	# 8859-1 characters for <, > and -.  This is a hack.
-	$msg =~ tr/<>-/\253\273\255/;
-	chomp $msg;
-	print STDOUT "\n";
-    } else {
-	push @WARNINGS, $msg;
-    }
-}
-
-
-# The mod_perl package Apache::Registry loads CGI programs by calling
-# eval.  These evals don't count when looking at the stack backtrace.
-sub _longmess {
-    my $message = Carp::longmess();
-    $message =~ s,eval[^\n]+(ModPerl|Apache)/Registry\w*\.pm.*,,s
-        if exists $ENV{MOD_PERL};
-    return $message;
-}
-
-sub ineval {
-  (exists $ENV{MOD_PERL} ? 0 : $^S) || _longmess() =~ /eval [\{\']/m
-}
-
-sub die {
-  my ($arg,@rest) = @_;
-  realdie ($arg,@rest) if ineval();
-
-  if (!ref($arg)) {
-    $arg = join("", ($arg,@rest));
-    my($file,$line,$id) = id(1);
-    $arg .= " at $file line $line." unless $arg=~/\n$/;
-    &fatalsToBrowser($arg) if $WRAP;
-    if (($arg =~ /\n$/) || !exists($ENV{MOD_PERL})) {
-      my $stamp = stamp;
-      $arg=~s/^/$stamp/gm;
-    }
-    if ($arg !~ /\n$/) {
-      $arg .= "\n";
-    }
-  }
-  realdie $arg;
-}
-
-sub set_message {
-    $CGI::Carp::CUSTOM_MSG = shift;
-    return $CGI::Carp::CUSTOM_MSG;
-}
-
-sub confess { CGI::Carp::die Carp::longmess @_; }
-sub croak   { CGI::Carp::die Carp::shortmess @_; }
-sub carp    { CGI::Carp::warn Carp::shortmess @_; }
-sub cluck   { CGI::Carp::warn Carp::longmess @_; }
-
-# We have to be ready to accept a filehandle as a reference
-# or a string.
-sub carpout {
-    my($in) = @_;
-    my($no) = fileno(to_filehandle($in));
-    realdie("Invalid filehandle $in\n") unless defined $no;
-    
-    open(SAVEERR, ">&STDERR");
-    open(STDERR, ">&$no") or 
-	( print SAVEERR "Unable to redirect STDERR: $!\n" and exit(1) );
-}
-
-sub warningsToBrowser {
-    $EMIT_WARNINGS = @_ ? shift : 1;
-    _warn(shift @WARNINGS) while $EMIT_WARNINGS and @WARNINGS;
-}
-
-# headers
-sub fatalsToBrowser {
-  my($msg) = @_;
-  $msg=~s/&/&/g;
-  $msg=~s/>/>/g;
-  $msg=~s/$ENV{SERVER_ADMIN})] :
-      "this site's webmaster";
-  my ($outer_message) = <Software error:
-
$msg
-

-$outer_message -

-END - ; - - if ($mod_perl) { - require mod_perl; - if ($mod_perl::VERSION >= 1.99) { - $mod_perl = 2; - require Apache::RequestRec; - require Apache::RequestIO; - require Apache::RequestUtil; - require APR::Pool; - require ModPerl::Util; - require Apache::Response; - } - my $r = Apache->request; - # If bytes have already been sent, then - # we print the message out directly. - # Otherwise we make a custom error - # handler to produce the doc for us. - if ($r->bytes_sent) { - $r->print($mess); - $mod_perl == 2 ? ModPerl::Util::exit(0) : $r->exit; - } else { - # MSIE won't display a custom 500 response unless it is >512 bytes! - if ($ENV{HTTP_USER_AGENT} =~ /MSIE/) { - $mess = "\n$mess"; - } - $r->custom_response(500,$mess); - } - } else { - my $bytes_written = eval{tell STDOUT}; - if (defined $bytes_written && $bytes_written > 0) { - print STDOUT $mess; - } - else { - print STDOUT "Content-type: text/html\n\n"; - print STDOUT $mess; - } - } - - warningsToBrowser(1); # emit warnings before dying -} - -# Cut and paste from CGI.pm so that we don't have the overhead of -# always loading the entire CGI module. -sub to_filehandle { - my $thingy = shift; - return undef unless $thingy; - return $thingy if UNIVERSAL::isa($thingy,'GLOB'); - return $thingy if UNIVERSAL::isa($thingy,'FileHandle'); - if (!ref($thingy)) { - my $caller = 1; - while (my $package = caller($caller++)) { - my($tmp) = $thingy=~/[\':]/ ? $thingy : "$package\:\:$thingy"; - return $tmp if defined(fileno($tmp)); - } - } - return undef; -} - -1; diff --git a/lib/CGI/Cookie.pm b/lib/CGI/Cookie.pm deleted file mode 100644 index 27a93c5..0000000 --- a/lib/CGI/Cookie.pm +++ /dev/null @@ -1,478 +0,0 @@ -package CGI::Cookie; - -# 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). - -# 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. - -$CGI::Cookie::VERSION='1.24'; - -use CGI::Util qw(rearrange unescape escape); -use overload '""' => \&as_string, - 'cmp' => \&compare, - 'fallback'=>1; - -# Turn on special checking for Doug MacEachern's modperl -my $MOD_PERL = 0; -if (exists $ENV{MOD_PERL}) { - eval "require mod_perl"; - if (defined $mod_perl::VERSION) { - if ($mod_perl::VERSION >= 1.99) { - $MOD_PERL = 2; - require Apache::RequestUtil; - } else { - $MOD_PERL = 1; - require Apache; - } - } -} - -# fetch a list of cookies from the environment and -# return as a hash. the cookies are parsed as normal -# escaped URL data. -sub fetch { - my $class = shift; - my $raw_cookie = get_raw_cookie(@_) or return; - return $class->parse($raw_cookie); -} - -# Fetch a list of cookies from the environment or the incoming headers and -# return as a hash. The cookie values are not unescaped or altered in any way. - sub raw_fetch { - my $class = shift; - my $raw_cookie = get_raw_cookie(@_) or return; - my %results; - my($key,$value); - - my(@pairs) = split("; ?",$raw_cookie); - foreach (@pairs) { - s/\s*(.*?)\s*/$1/; - if (/^([^=]+)=(.*)/) { - $key = $1; - $value = $2; - } - else { - $key = $_; - $value = ''; - } - $results{$key} = $value; - } - return \%results unless wantarray; - return %results; -} - -sub get_raw_cookie { - my $r = shift; - $r ||= eval { Apache->request() } if $MOD_PERL; - if ($r) { - $raw_cookie = $r->headers_in->{'Cookie'}; - } else { - if ($MOD_PERL && !exists $ENV{REQUEST_METHOD}) { - die "Run $r->subprocess_env; before calling fetch()"; - } - $raw_cookie = $ENV{HTTP_COOKIE} || $ENV{COOKIE}; - } -} - - -sub parse { - my ($self,$raw_cookie) = @_; - my %results; - - my(@pairs) = split("; ?",$raw_cookie); - foreach (@pairs) { - s/\s*(.*?)\s*/$1/; - my($key,$value) = split("=",$_,2); - - # Some foreign cookies are not in name=value format, so ignore - # them. - next if !defined($value); - my @values = (); - if ($value ne '') { - @values = map unescape($_),split(/[&;]/,$value.'&dmy'); - pop @values; - } - $key = unescape($key); - # A bug in Netscape can cause several cookies with same name to - # appear. The FIRST one in HTTP_COOKIE is the most recent version. - $results{$key} ||= $self->new(-name=>$key,-value=>\@values); - } - return \%results unless wantarray; - return %results; -} - -sub new { - my $class = shift; - $class = ref($class) if ref($class); - my($name,$value,$path,$domain,$secure,$expires) = - rearrange([NAME,[VALUE,VALUES],PATH,DOMAIN,SECURE,EXPIRES],@_); - - # Pull out our parameters. - my @values; - if (ref($value)) { - if (ref($value) eq 'ARRAY') { - @values = @$value; - } elsif (ref($value) eq 'HASH') { - @values = %$value; - } - } else { - @values = ($value); - } - - bless my $self = { - 'name'=>$name, - 'value'=>[@values], - },$class; - - # IE requires the path and domain to be present for some reason. - $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->domain($domain) if defined $domain; - $self->secure($secure) if defined $secure; - $self->expires($expires) if defined $expires; -# $self->max_age($expires) if defined $expires; - return $self; -} - -sub as_string { - my $self = shift; - return "" unless $self->name; - - my(@constant_values,$domain,$path,$expires,$max_age,$secure); - - push(@constant_values,"domain=$domain") if $domain = $self->domain; - push(@constant_values,"path=$path") if $path = $self->path; - push(@constant_values,"expires=$expires") if $expires = $self->expires; - push(@constant_values,"max-age=$max_age") if $max_age = $self->max_age; - push(@constant_values,"secure") if $secure = $self->secure; - - my($key) = escape($self->name); - my($cookie) = join("=",$key,join("&",map escape($_),$self->value)); - return join("; ",$cookie,@constant_values); -} - -sub compare { - my $self = shift; - my $value = shift; - return "$self" cmp $value; -} - -# accessors -sub name { - my $self = shift; - my $name = shift; - $self->{'name'} = $name if defined $name; - return $self->{'name'}; -} - -sub value { - my $self = shift; - my $value = shift; - if (defined $value) { - my @values; - if (ref($value)) { - if (ref($value) eq 'ARRAY') { - @values = @$value; - } elsif (ref($value) eq 'HASH') { - @values = %$value; - } - } else { - @values = ($value); - } - $self->{'value'} = [@values]; - } - return wantarray ? @{$self->{'value'}} : $self->{'value'}->[0] -} - -sub domain { - my $self = shift; - my $domain = shift; - $self->{'domain'} = $domain if defined $domain; - return $self->{'domain'}; -} - -sub secure { - my $self = shift; - my $secure = shift; - $self->{'secure'} = $secure if defined $secure; - return $self->{'secure'}; -} - -sub expires { - my $self = shift; - my $expires = shift; - $self->{'expires'} = CGI::Util::expires($expires,'cookie') if defined $expires; - return $self->{'expires'}; -} - -sub max_age { - my $self = shift; - my $expires = shift; - $self->{'max-age'} = CGI::Util::expire_calc($expires)-time() if defined $expires; - return $self->{'max-age'}; -} - -sub path { - my $self = shift; - my $path = shift; - $self->{'path'} = $path if defined $path; - return $self->{'path'}; -} - -1; - -=head1 NAME - -CGI::Cookie - Interface to Netscape Cookies - -=head1 SYNOPSIS - - use CGI qw/:standard/; - use CGI::Cookie; - - # Create new cookies and send them - $cookie1 = new CGI::Cookie(-name=>'ID',-value=>123456); - $cookie2 = new CGI::Cookie(-name=>'preferences', - -value=>{ font => Helvetica, - size => 12 } - ); - print header(-cookie=>[$cookie1,$cookie2]); - - # fetch existing cookies - %cookies = fetch CGI::Cookie; - $id = $cookies{'ID'}->value; - - # create cookies returned from an external source - %cookies = parse CGI::Cookie($ENV{COOKIE}); - -=head1 DESCRIPTION - -CGI::Cookie is an interface to Netscape (HTTP/1.1) cookies, an -innovation that allows Web servers to store persistent information on -the browser's side of the connection. Although CGI::Cookie is -intended to be used in conjunction with CGI.pm (and is in fact used by -it internally), you can use this module independently. - -For full information on cookies see - - http://www.ics.uci.edu/pub/ietf/http/rfc2109.txt - -=head1 USING CGI::Cookie - -CGI::Cookie is object oriented. Each cookie object has a name and a -value. The name is any scalar value. The value is any scalar or -array value (associative arrays are also allowed). Cookies also have -several optional attributes, including: - -=over 4 - -=item B<1. expiration date> - -The expiration date tells the browser how long to hang on to the -cookie. If the cookie specifies an expiration date in the future, the -browser will store the cookie information in a disk file and return it -to the server every time the user reconnects (until the expiration -date is reached). If the cookie species an expiration date in the -past, the browser will remove the cookie from the disk file. If the -expiration date is not specified, the cookie will persist only until -the user quits the browser. - -=item B<2. domain> - -This is a partial or complete domain name for which the cookie is -valid. The browser will return the cookie to any host that matches -the partial domain name. For example, if you specify a domain name -of ".capricorn.com", then Netscape will return the cookie to -Web servers running on any of the machines "www.capricorn.com", -"ftp.capricorn.com", "feckless.capricorn.com", etc. Domain names -must contain at least two periods to prevent attempts to match -on top level domains like ".edu". If no domain is specified, then -the browser will only return the cookie to servers on the host the -cookie originated from. - -=item B<3. path> - -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, the path is set to "/", so -that all scripts at your site will receive the cookie. - -=item B<4. secure flag> - -If the "secure" attribute is set, the cookie will only be sent to your -script if the CGI request is occurring on a secure channel, such as SSL. - -=back - -=head2 Creating New Cookies - - $c = new CGI::Cookie(-name => 'foo', - -value => 'bar', - -expires => '+3M', - -domain => '.capricorn.com', - -path => '/cgi-bin/database', - -secure => 1 - ); - -Create cookies from scratch with the B method. The B<-name> and -B<-value> parameters are required. The name must be a scalar value. -The value can be a scalar, an array reference, or a hash reference. -(At some point in the future cookies will support one of the Perl -object serialization protocols for full generality). - -B<-expires> accepts any of the relative or absolute date formats -recognized by CGI.pm, for example "+3M" for three months in the -future. See CGI.pm's documentation for details. - -B<-domain> points to a domain name or to a fully qualified host name. -If not specified, the cookie will be returned only to the Web server -that created it. - -B<-path> points to a partial URL on the current server. The cookie -will be returned to all URLs beginning with the specified path. If -not specified, it defaults to '/', which returns the cookie to all -pages at your site. - -B<-secure> if set to a true value instructs the browser to return the -cookie only when a cryptographic protocol is in use. - -=head2 Sending the Cookie to the Browser - -Within a CGI script you can send a cookie to the browser by creating -one or more Set-Cookie: fields in the HTTP header. Here is a typical -sequence: - - my $c = new CGI::Cookie(-name => 'foo', - -value => ['bar','baz'], - -expires => '+3M'); - - print "Set-Cookie: $c\n"; - print "Content-Type: text/html\n\n"; - -To send more than one cookie, create several Set-Cookie: fields. - -If you are using CGI.pm, you send cookies by providing a -cookie -argument to the header() method: - - print header(-cookie=>$c); - -Mod_perl users can set cookies using the request object's header_out() -method: - - $r->headers_out->set('Set-Cookie' => $c); - -Internally, Cookie overloads the "" operator to call its as_string() -method when incorporated into the HTTP header. as_string() turns the -Cookie's internal representation into an RFC-compliant text -representation. You may call as_string() yourself if you prefer: - - print "Set-Cookie: ",$c->as_string,"\n"; - -=head2 Recovering Previous Cookies - - %cookies = fetch CGI::Cookie; - -B returns an associative array consisting of all cookies -returned by the browser. The keys of the array are the cookie names. You -can iterate through the cookies this way: - - %cookies = fetch CGI::Cookie; - foreach (keys %cookies) { - do_something($cookies{$_}); - } - -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 -same semantics as fetch(), but performs no unescaping. - -You may also retrieve cookies that were stored in some external -form using the parse() class method: - - $COOKIES = `cat /usr/tmp/Cookie_stash`; - %cookies = parse CGI::Cookie($COOKIES); - -If you are in a mod_perl environment, you can save some overhead by -passing the request object to fetch() like this: - - CGI::Cookie->fetch($r); - -=head2 Manipulating Cookies - -Cookie objects have a series of accessor methods to get and set cookie -attributes. Each accessor has a similar syntax. Called without -arguments, the accessor returns the current value of the attribute. -Called with an argument, the accessor changes the attribute and -returns its new value. - -=over 4 - -=item B - -Get or set the cookie's name. Example: - - $name = $c->name; - $new_name = $c->name('fred'); - -=item B - -Get or set the cookie's value. Example: - - $value = $c->value; - @new_value = $c->value(['a','b','c','d']); - -B is context sensitive. In a list context it will return -the current value of the cookie as an array. In a scalar context it -will return the B value of a multivalued cookie. - -=item B - -Get or set the cookie's domain. - -=item B - -Get or set the cookie's path. - -=item B - -Get or set the cookie's expiration time. - -=back - - -=head1 AUTHOR INFORMATION - -Copyright 1997-1998, Lincoln D. Stein. All rights reserved. - -This library is free software; you can redistribute it and/or modify -it under the same terms as Perl itself. - -Address bug reports and comments to: lstein@cshl.org - -=head1 BUGS - -This section intentionally left blank. - -=head1 SEE ALSO - -L, L - -=cut diff --git a/lib/CGI/Fast.pm b/lib/CGI/Fast.pm deleted file mode 100644 index 43b8709..0000000 --- a/lib/CGI/Fast.pm +++ /dev/null @@ -1,230 +0,0 @@ -package CGI::Fast; - -# 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). - -# Copyright 1995,1996, 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::Fast::VERSION='1.05'; - -use CGI; -use FCGI; -@ISA = ('CGI'); - -# workaround for known bug in libfcgi -while (($ignore) = each %ENV) { } - -# override the initialization behavior so that -# state is NOT maintained between invocations -sub save_request { - # no-op -} - -# If ENV{FCGI_SOCKET_PATH} is specified, we maintain a FCGI Request handle -# in this package variable. -use vars qw($Ext_Request); -BEGIN { - # If ENV{FCGI_SOCKET_PATH} is given, explicitly open the socket, - # and keep the request handle around from which to call Accept(). - if ($ENV{FCGI_SOCKET_PATH}) { - my $path = $ENV{FCGI_SOCKET_PATH}; - my $backlog = $ENV{FCGI_LISTEN_QUEUE} || 100; - my $socket = FCGI::OpenSocket( $path, $backlog ); - $Ext_Request = FCGI::Request( \*STDIN, \*STDOUT, \*STDERR, - \%ENV, $socket, 1 ); - } -} - -# New is slightly different in that it calls FCGI's -# accept() method. -sub new { - my ($self, $initializer, @param) = @_; - unless (defined $initializer) { - if ($Ext_Request) { - return undef unless $Ext_Request->Accept() >= 0; - } else { - return undef unless FCGI::accept() >= 0; - } - } - return $CGI::Q = $self->SUPER::new($initializer, @param); -} - -1; - -=head1 NAME - -CGI::Fast - CGI Interface for Fast CGI - -=head1 SYNOPSIS - - use CGI::Fast qw(:standard); - $COUNTER = 0; - while (new CGI::Fast) { - print header; - print start_html("Fast CGI Rocks"); - print - h1("Fast CGI Rocks"), - "Invocation number ",b($COUNTER++), - " PID ",b($$),".", - hr; - print end_html; - } - -=head1 DESCRIPTION - -CGI::Fast is a subclass of the CGI object created by -CGI.pm. It is specialized to work well with the Open Market -FastCGI standard, which greatly speeds up CGI scripts by -turning them into persistently running server processes. Scripts -that perform time-consuming initialization processes, such as -loading large modules or opening persistent database connections, -will see large performance improvements. - -=head1 OTHER PIECES OF THE PUZZLE - -In order to use CGI::Fast you'll need a FastCGI-enabled Web -server. Open Market's server is FastCGI-savvy. There are also -freely redistributable FastCGI modules for NCSA httpd 1.5 and Apache. -FastCGI-enabling modules for Microsoft Internet Information Server and -Netscape Communications Server have been announced. - -In addition, you'll need a version of the Perl interpreter that has -been linked with the FastCGI I/O library. Precompiled binaries are -available for several platforms, including DEC Alpha, HP-UX and -SPARC/Solaris, or you can rebuild Perl from source with patches -provided in the FastCGI developer's kit. The FastCGI Perl interpreter -can be used in place of your normal Perl without ill consequences. - -You can find FastCGI modules for Apache and NCSA httpd, precompiled -Perl interpreters, and the FastCGI developer's kit all at URL: - - http://www.fastcgi.com/ - -=head1 WRITING FASTCGI PERL SCRIPTS - -FastCGI scripts are persistent: one or more copies of the script -are started up when the server initializes, and stay around until -the server exits or they die a natural death. After performing -whatever one-time initialization it needs, the script enters a -loop waiting for incoming connections, processing the request, and -waiting some more. - -A typical FastCGI script will look like this: - - #!/usr/local/bin/perl # must be a FastCGI version of perl! - use CGI::Fast; - &do_some_initialization(); - while ($q = new CGI::Fast) { - &process_request($q); - } - -Each time there's a new request, CGI::Fast returns a -CGI object to your loop. The rest of the time your script -waits in the call to new(). When the server requests that -your script be terminated, new() will return undef. You can -of course exit earlier if you choose. A new version of the -script will be respawned to take its place (this may be -necessary in order to avoid Perl memory leaks in long-running -scripts). - -CGI.pm's default CGI object mode also works. Just modify the loop -this way: - - while (new CGI::Fast) { - &process_request; - } - -Calls to header(), start_form(), etc. will all operate on the -current request. - -=head1 INSTALLING FASTCGI SCRIPTS - -See the FastCGI developer's kit documentation for full details. On -the Apache server, the following line must be added to srm.conf: - - AddType application/x-httpd-fcgi .fcgi - -FastCGI scripts must end in the extension .fcgi. For each script you -install, you must add something like the following to srm.conf: - - FastCgiServer /usr/etc/httpd/fcgi-bin/file_upload.fcgi -processes 2 - -This instructs Apache to launch two copies of file_upload.fcgi at -startup time. - -=head1 USING FASTCGI SCRIPTS AS CGI SCRIPTS - -Any script that works correctly as a FastCGI script will also work -correctly when installed as a vanilla CGI script. However it will -not see any performance benefit. - -=head1 EXTERNAL FASTCGI SERVER INVOCATION - -FastCGI supports a TCP/IP transport mechanism which allows FastCGI scripts to run -external to the webserver, perhaps on a remote machine. To configure the -webserver to connect to an external FastCGI server, you would add the following -to your srm.conf: - - FastCgiExternalServer /usr/etc/httpd/fcgi-bin/file_upload.fcgi -host sputnik:8888 - -Two environment variables affect how the C object is created, -allowing C to be used as an external FastCGI server. (See C -documentation for C for more information.) - -=over - -=item FCGI_SOCKET_PATH - -The address (TCP/IP) or path (UNIX Domain) of the socket the external FastCGI -script to which bind an listen for incoming connections from the web server. - -=item FCGI_LISTEN_QUEUE - -Maximum length of the queue of pending connections. - -=back - -For example: - - #!/usr/local/bin/perl # must be a FastCGI version of perl! - use CGI::Fast; - &do_some_initialization(); - $ENV{FCGI_SOCKET_PATH} = "sputnik:8888"; - $ENV{FCGI_LISTEN_QUEUE} = 100; - while ($q = new CGI::Fast) { - &process_request($q); - } - -=head1 CAVEATS - -I haven't tested this very much. - -=head1 AUTHOR INFORMATION - -Copyright 1996-1998, Lincoln D. Stein. All rights reserved. - -This library is free software; you can redistribute it and/or modify -it under the same terms as Perl itself. - -Address bug reports and comments to: lstein@cshl.org - -=head1 BUGS - -This section intentionally left blank. - -=head1 SEE ALSO - -L, L - -=cut diff --git a/lib/CGI/Pretty.pm b/lib/CGI/Pretty.pm deleted file mode 100644 index d824a02..0000000 --- a/lib/CGI/Pretty.pm +++ /dev/null @@ -1,275 +0,0 @@ -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.08'; -$CGI::DefaultClass = __PACKAGE__; -$CGI::Pretty::AutoloadClass = 'CGI'; -@CGI::Pretty::ISA = qw( CGI ); - -initialize_globals(); - -sub _prettyPrint { - my $input = shift; - return if !$$input; - return if !$CGI::Pretty::LINEBREAK || !$CGI::Pretty::INDENT; - -# print STDERR "'", $$input, "'\n"; - - foreach my $i ( @CGI::Pretty::AS_IS ) { - if ( $$input =~ m{}si ) { - my ( $a, $b, $c ) = $$input =~ m{(.*)(<$i[\s/>].*?)(.*)}si; - next if !$b; - $a ||= ""; - $c ||= ""; - - _prettyPrint( \$a ) if $a; - _prettyPrint( \$c ) if $c; - - $b ||= ""; - $$input = "$a$b$c"; - 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 if $CGI::Pretty::LINEBREAK; - - return $self->SUPER::comment( "$CGI::Pretty::LINEBREAK$CGI::Pretty::INDENT$s$CGI::Pretty::LINEBREAK" ) . $CGI::Pretty::LINEBREAK; -} - -sub _make_tag_func { - my ($self,$tagname) = @_; - - # 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 - - my $func = qq" - sub $tagname {"; - - $func .= q' - shift if $_[0] && - (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()||undef,1); - $attr = " @attr" if @attr; - }'; - - if ($tagname=~/start_(\w+)/i) { - $func .= qq! - return "<\L$1\E\$attr>\$CGI::Pretty::LINEBREAK";} !; - } elsif ($tagname=~/end_(\w+)/i) { - $func .= qq! - return "<\L/$1\E>\$CGI::Pretty::LINEBREAK"; } !; - } else { - $func .= qq# - return ( \$CGI::XHTML ? "<\L$tagname\E\$attr />" : "<\L$tagname\E\$attr>" ) . - \$CGI::Pretty::LINEBREAK unless \@_; - my(\$tag,\$untag) = ("<\L$tagname\E\$attr>","\E"); - - my \%ASIS = map { lc("\$_") => 1 } \@CGI::Pretty::AS_IS; - my \@args; - if ( \$CGI::Pretty::LINEBREAK || \$CGI::Pretty::INDENT ) { - if(ref(\$_[0]) eq 'ARRAY') { - \@args = \@{\$_[0]} - } else { - foreach (\@_) { - \$args[0] .= \$_; - \$args[0] .= \$CGI::Pretty::LINEBREAK if \$args[0] !~ /\$CGI::Pretty::LINEBREAK\$/ && 0; - chomp \$args[0] if exists \$ASIS{ "\L$tagname\E" }; - - \$args[0] .= \$" if \$args[0] !~ /\$CGI::Pretty::LINEBREAK\$/ && 1; - } - chop \$args[0]; - } - } - else { - \@args = ref(\$_[0]) eq 'ARRAY' ? \@{\$_[0]} : "\@_"; - } - - my \@result; - if ( exists \$ASIS{ "\L$tagname\E" } ) { - \@result = map { "\$tag\$_\$untag\$CGI::Pretty::LINEBREAK" } - \@args; - } - else { - \@result = map { - chomp; - my \$tmp = \$_; - CGI::Pretty::_prettyPrint( \\\$tmp ); - \$tag . \$CGI::Pretty::LINEBREAK . - \$CGI::Pretty::INDENT . \$tmp . \$CGI::Pretty::LINEBREAK . - \$untag . \$CGI::Pretty::LINEBREAK - } \@args; - } - local \$" = "" if \$CGI::Pretty::LINEBREAK || \$CGI::Pretty::INDENT; - return "\@result"; - }#; - } - - return $func; -} - -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( @_ ); - - if ($CGI::MOD_PERL) { - my $r = Apache->request; - if ($CGI::MOD_PERL == 1) { - $r->register_cleanup(\&CGI::Pretty::_reset_globals); - } - else { - $r->pool->cleanup_register(\&CGI::Pretty::_reset_globals); - } - } - $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 = $/; - - # These tags are not prettify'd. - @CGI::Pretty::AS_IS = qw( a pre code script textarea td ); - - 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: -
foo
- -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: - - - - -
- foo -
- - -=head2 Tags that won't be formatted - -The and
 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 , with minor modifications by
-Lincoln Stein  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
-
-=cut
diff --git a/lib/CGI/Push.pm b/lib/CGI/Push.pm
deleted file mode 100644
index 8356c60..0000000
--- a/lib/CGI/Push.pm
+++ /dev/null
@@ -1,328 +0,0 @@
-package CGI::Push;
-
-# 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).
-
-# Copyright 1995-2000, 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://stein.cshl.org/WWW/software/CGI/
-
-$CGI::Push::VERSION='1.04';
-use CGI;
-use CGI::Util 'rearrange';
-@ISA = ('CGI');
-
-$CGI::DefaultClass = 'CGI::Push';
-$CGI::Push::AutoloadClass = 'CGI';
-
-# add do_push() and push_delay() to exported tags
-push(@{$CGI::EXPORT_TAGS{':standard'}},'do_push','push_delay');
-
-sub do_push {
-    my ($self,@p) = CGI::self_or_default(@_);
-
-    # unbuffer output
-    $| = 1;
-    srand;
-    my ($random) = sprintf("%08.0f",rand()*1E8);
-    my ($boundary) = "----=_NeXtPaRt$random";
-
-    my (@header);
-    my ($type,$callback,$delay,$last_page,$cookie,$target,$expires,$nph,$handle,@other) = rearrange([TYPE,NEXT_PAGE,DELAY,LAST_PAGE,[COOKIE,COOKIES],TARGET,EXPIRES,NPH,HANDLE],@p);
-    $type = 'text/html' unless $type;
-    $callback = \&simple_counter unless $callback && ref($callback) eq 'CODE';
-    $delay = 1 unless defined($delay);
-    $self->push_delay($delay);
-    $nph = 1 unless defined($nph);
-    $handle = \*STDOUT unless defined($handle);
-
-sdf;kjsdlfsdfkl
-
-    my(@o);
-    foreach (@other) { push(@o,split("=")); }
-    push(@o,'-Target'=>$target) if defined($target);
-    push(@o,'-Cookie'=>$cookie) if defined($cookie);
-    push(@o,'-Type'=>"multipart/x-mixed-replace;boundary=\"$boundary\"");
-    push(@o,'-Server'=>"CGI.pm Push Module") if $nph;
-    push(@o,'-Status'=>'200 OK');
-    push(@o,'-nph'=>1) if $nph;
-    $handle->print($self->header(@o));
-
-    $boundary = "$CGI::CRLF--$boundary";
-
-    $handle->print("WARNING: YOUR BROWSER DOESN'T SUPPORT THIS SERVER-PUSH TECHNOLOGY.${boundary}$CGI::CRLF");
-
-    my (@contents) = &$callback($self,++$COUNTER);
-
-    # now we enter a little loop
-    while (1) {
-        $handle->print("Content-type: ${type}$CGI::CRLF$CGI::CRLF") unless $type =~ /^dynamic|heterogeneous$/i;
-        $handle->print(@contents);
-        @contents = &$callback($self,++$COUNTER);
-        if ((@contents) && defined($contents[0])) {
-            $handle->print("${boundary}$CGI::CRLF");
-            do_sleep($self->push_delay()) if $self->push_delay();
-        } else {
-            if ($last_page && ref($last_page) eq 'CODE') {
-                $handle->print("${boundary}$CGI::CRLF");
-                do_sleep($self->push_delay()) if $self->push_delay();
-                $handle->print("Content-type: ${type}$CGI::CRLF$CGI::CRLF") unless $type =~ /^dynamic|heterogeneous$/i;
-                $handle->print(&$last_page($self,$COUNTER));
-            }
-            $handle->print("${boundary}--$CGI::CRLF");
-            last;
-        }
-    }
-    $handle->print("WARNING: YOUR BROWSER DOESN'T SUPPORT THIS SERVER-PUSH TECHNOLOGY.${boundary}$CGI::CRLF");
-}
-
-sub simple_counter {
-    my ($self,$count) = @_;
-    return $self->start_html("CGI::Push Default Counter"),
-           $self->h1("CGI::Push Default Counter"),
-           "This page has been updated ",$self->strong($count)," times.",
-           $self->hr(),
-           $self->a({'-href'=>'http://www.genome.wi.mit.edu/ftp/pub/software/WWW/cgi_docs.html'},'CGI.pm home page'),
-           $self->end_html;
-}
-
-sub do_sleep {
-    my $delay = shift;
-    if ( ($delay >= 1) && ($delay!~/\./) ){
-        sleep($delay);
-    } else {
-        select(undef,undef,undef,$delay);
-    }
-}
-
-sub push_delay {
-    my ($self,$delay) = CGI::self_or_default(@_);
-    return defined($delay) ? $self->{'.delay'} =
-        $delay : $self->{'.delay'};
-}
-
-1;
-
-=head1 NAME
-
-CGI::Push - Simple Interface to Server Push
-
-=head1 SYNOPSIS
-
-    use CGI::Push qw(:standard);
-
-    do_push(-next_page=>\&next_page,
-            -last_page=>\&last_page,
-            -delay=>0.5);
-
-    sub next_page {
-        my($q,$counter) = @_;
-        return undef if $counter >= 10;
-        return start_html('Test'),
-               h1('Visible'),"\n",
-               "This page has been called ", strong($counter)," times",
-               end_html();
-    }
-
-    sub last_page {
-        my($q,$counter) = @_;
-        return start_html('Done'),
-               h1('Finished'),
-               strong($counter - 1),' iterations.',
-               end_html;
-    }
-
-=head1 DESCRIPTION
-
-CGI::Push is a subclass of the CGI object created by CGI.pm.  It is
-specialized for server push operations, which allow you to create
-animated pages whose content changes at regular intervals.
-
-You provide CGI::Push with a pointer to a subroutine that will draw
-one page.  Every time your subroutine is called, it generates a new
-page.  The contents of the page will be transmitted to the browser
-in such a way that it will replace what was there beforehand.  The
-technique will work with HTML pages as well as with graphics files,
-allowing you to create animated GIFs.
-
-Only Netscape Navigator supports server push.  Internet Explorer
-browsers do not.
-
-=head1 USING CGI::Push
-
-CGI::Push adds one new method to the standard CGI suite, do_push().
-When you call this method, you pass it a reference to a subroutine
-that is responsible for drawing each new page, an interval delay, and
-an optional subroutine for drawing the last page.  Other optional
-parameters include most of those recognized by the CGI header()
-method.
-
-You may call do_push() in the object oriented manner or not, as you
-prefer:
-
-    use CGI::Push;
-    $q = new CGI::Push;
-    $q->do_push(-next_page=>\&draw_a_page);
-
-        -or-
-
-    use CGI::Push qw(:standard);
-    do_push(-next_page=>\&draw_a_page);
-
-Parameters are as follows:
-
-=over 4
-
-=item -next_page
-
-    do_push(-next_page=>\&my_draw_routine);
-
-This required parameter points to a reference to a subroutine responsible for
-drawing each new page.  The subroutine should expect two parameters
-consisting of the CGI object and a counter indicating the number
-of times the subroutine has been called.  It should return the
-contents of the page as an B of one or more items to print.
-It can return a false value (or an empty array) in order to abort the
-redrawing loop and print out the final page (if any)
-
-    sub my_draw_routine {
-        my($q,$counter) = @_;
-        return undef if $counter > 100;
-        return start_html('testing'),
-               h1('testing'),
-               "This page called $counter times";
-    }
-
-You are of course free to refer to create and use global variables
-within your draw routine in order to achieve special effects.
-
-=item -last_page
-
-This optional parameter points to a reference to the subroutine
-responsible for drawing the last page of the series.  It is called
-after the -next_page routine returns a false value.  The subroutine
-itself should have exactly the same calling conventions as the
--next_page routine.
-
-=item -type
-
-This optional parameter indicates the content type of each page.  It
-defaults to "text/html".  Normally the module assumes that each page
-is of a homogenous MIME type.  However if you provide either of the
-magic values "heterogeneous" or "dynamic" (the latter provided for the
-convenience of those who hate long parameter names), you can specify
-the MIME type -- and other header fields -- on a per-page basis.  See
-"heterogeneous pages" for more details.
-
-=item -delay
-
-This indicates the delay, in seconds, between frames.  Smaller delays
-refresh the page faster.  Fractional values are allowed.
-
-B
-
-=item -cookie, -target, -expires, -nph
-
-These have the same meaning as the like-named parameters in
-CGI::header().
-
-If not specified, -nph will default to 1 (as needed for many servers, see below).
-
-=back
-
-=head2 Heterogeneous Pages
-
-Ordinarily all pages displayed by CGI::Push share a common MIME type.
-However by providing a value of "heterogeneous" or "dynamic" in the
-do_push() -type parameter, you can specify the MIME type of each page
-on a case-by-case basis.
-
-If you use this option, you will be responsible for producing the
-HTTP header for each page.  Simply modify your draw routine to
-look like this:
-
-    sub my_draw_routine {
-        my($q,$counter) = @_;
-        return header('text/html'),   # note we're producing the header here
-               start_html('testing'),
-               h1('testing'),
-               "This page called $counter times";
-    }
-
-You can add any header fields that you like, but some (cookies and
-status fields included) may not be interpreted by the browser.  One
-interesting effect is to display a series of pages, then, after the
-last page, to redirect the browser to a new URL.  Because redirect()
-does b work, the easiest way is with a -refresh header field,
-as shown below:
-
-    sub my_draw_routine {
-        my($q,$counter) = @_;
-        return undef if $counter > 10;
-        return header('text/html'),   # note we're producing the header here
-               start_html('testing'),
-               h1('testing'),
-               "This page called $counter times";
-    }
-
-    sub my_last_page {
-        return header(-refresh=>'5; URL=http://somewhere.else/finished.html',
-                      -type=>'text/html'),
-               start_html('Moved'),
-               h1('This is the last page'),
-               'Goodbye!'
-               hr,
-               end_html;
-    }
-
-=head2 Changing the Page Delay on the Fly
-
-If you would like to control the delay between pages on a page-by-page
-basis, call push_delay() from within your draw routine.  push_delay()
-takes a single numeric argument representing the number of seconds you
-wish to delay after the current page is displayed and before
-displaying the next one.  The delay may be fractional.  Without
-parameters, push_delay() just returns the current delay.
-
-=head1 INSTALLING CGI::Push SCRIPTS
-
-Server push scripts must be installed as no-parsed-header (NPH)
-scripts in order to work correctly on many servers.  On Unix systems,
-this is most often accomplished by prefixing the script's name with "nph-".
-Recognition of NPH scripts happens automatically with WebSTAR and
-Microsoft IIS.  Users of other servers should see their documentation
-for help.
-
-Apache web server from version 1.3b2 on does not need server
-push scripts installed as NPH scripts: the -nph parameter to do_push()
-may be set to a false value to disable the extra headers needed by an
-NPH script.
-
-=head1 AUTHOR INFORMATION
-
-Copyright 1995-1998, Lincoln D. Stein.  All rights reserved.
-
-This library is free software; you can redistribute it and/or modify
-it under the same terms as Perl itself.
-
-Address bug reports and comments to: lstein@cshl.org
-
-=head1 BUGS
-
-This section intentionally left blank.
-
-=head1 SEE ALSO
-
-L, L
-
-=cut
-
diff --git a/lib/CGI/Switch.pm b/lib/CGI/Switch.pm
deleted file mode 100644
index b8cc9ef..0000000
--- a/lib/CGI/Switch.pm
+++ /dev/null
@@ -1,27 +0,0 @@
-use CGI;
-
-$VERSION = '1.00';
-
-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
diff --git a/lib/CGI/Util.pm b/lib/CGI/Util.pm
deleted file mode 100644
index 6af42de..0000000
--- a/lib/CGI/Util.pm
+++ /dev/null
@@ -1,317 +0,0 @@
-package CGI::Util;
-
-use strict;
-use vars qw($VERSION @EXPORT_OK @ISA $EBCDIC @A2E @E2A);
-require Exporter;
-@ISA = qw(Exporter);
-@EXPORT_OK = qw(rearrange make_attributes unescape escape 
-		expires ebcdic2ascii ascii2ebcdic);
-
-$VERSION = '1.5';
-
-$EBCDIC = "\t" ne "\011";
-# (ord('^') == 95) for codepage 1047 as on os390, vmesa
-@A2E = (
-   0,  1,  2,  3, 55, 45, 46, 47, 22,  5, 21, 11, 12, 13, 14, 15,
-  16, 17, 18, 19, 60, 61, 50, 38, 24, 25, 63, 39, 28, 29, 30, 31,
-  64, 90,127,123, 91,108, 80,125, 77, 93, 92, 78,107, 96, 75, 97,
- 240,241,242,243,244,245,246,247,248,249,122, 94, 76,126,110,111,
- 124,193,194,195,196,197,198,199,200,201,209,210,211,212,213,214,
- 215,216,217,226,227,228,229,230,231,232,233,173,224,189, 95,109,
- 121,129,130,131,132,133,134,135,136,137,145,146,147,148,149,150,
- 151,152,153,162,163,164,165,166,167,168,169,192, 79,208,161,  7,
-  32, 33, 34, 35, 36, 37,  6, 23, 40, 41, 42, 43, 44,  9, 10, 27,
-  48, 49, 26, 51, 52, 53, 54,  8, 56, 57, 58, 59,  4, 20, 62,255,
-  65,170, 74,177,159,178,106,181,187,180,154,138,176,202,175,188,
- 144,143,234,250,190,160,182,179,157,218,155,139,183,184,185,171,
- 100,101, 98,102, 99,103,158,104,116,113,114,115,120,117,118,119,
- 172,105,237,238,235,239,236,191,128,253,254,251,252,186,174, 89,
-  68, 69, 66, 70, 67, 71,156, 72, 84, 81, 82, 83, 88, 85, 86, 87,
- 140, 73,205,206,203,207,204,225,112,221,222,219,220,141,142,223
-	 );
-@E2A = (
-   0,  1,  2,  3,156,  9,134,127,151,141,142, 11, 12, 13, 14, 15,
-  16, 17, 18, 19,157, 10,  8,135, 24, 25,146,143, 28, 29, 30, 31,
- 128,129,130,131,132,133, 23, 27,136,137,138,139,140,  5,  6,  7,
- 144,145, 22,147,148,149,150,  4,152,153,154,155, 20, 21,158, 26,
-  32,160,226,228,224,225,227,229,231,241,162, 46, 60, 40, 43,124,
-  38,233,234,235,232,237,238,239,236,223, 33, 36, 42, 41, 59, 94,
-  45, 47,194,196,192,193,195,197,199,209,166, 44, 37, 95, 62, 63,
- 248,201,202,203,200,205,206,207,204, 96, 58, 35, 64, 39, 61, 34,
- 216, 97, 98, 99,100,101,102,103,104,105,171,187,240,253,254,177,
- 176,106,107,108,109,110,111,112,113,114,170,186,230,184,198,164,
- 181,126,115,116,117,118,119,120,121,122,161,191,208, 91,222,174,
- 172,163,165,183,169,167,182,188,189,190,221,168,175, 93,180,215,
- 123, 65, 66, 67, 68, 69, 70, 71, 72, 73,173,244,246,242,243,245,
- 125, 74, 75, 76, 77, 78, 79, 80, 81, 82,185,251,252,249,250,255,
-  92,247, 83, 84, 85, 86, 87, 88, 89, 90,178,212,214,210,211,213,
-  48, 49, 50, 51, 52, 53, 54, 55, 56, 57,179,219,220,217,218,159
-	 );
-
-if ($EBCDIC && ord('^') == 106) { # as in the BS2000 posix-bc coded character set
-     $A2E[91] = 187;   $A2E[92] = 188;  $A2E[94] = 106;  $A2E[96] = 74;
-     $A2E[123] = 251;  $A2E[125] = 253; $A2E[126] = 255; $A2E[159] = 95;
-     $A2E[162] = 176;  $A2E[166] = 208; $A2E[168] = 121; $A2E[172] = 186;
-     $A2E[175] = 161;  $A2E[217] = 224; $A2E[219] = 221; $A2E[221] = 173;
-     $A2E[249] = 192;
-
-     $E2A[74] = 96;   $E2A[95] = 159;  $E2A[106] = 94;  $E2A[121] = 168;
-     $E2A[161] = 175; $E2A[173] = 221; $E2A[176] = 162; $E2A[186] = 172;
-     $E2A[187] = 91;  $E2A[188] = 92;  $E2A[192] = 249; $E2A[208] = 166;
-     $E2A[221] = 219; $E2A[224] = 217; $E2A[251] = 123; $E2A[253] = 125;
-     $E2A[255] = 126;
-   }
-elsif ($EBCDIC && ord('^') == 176) { # as in codepage 037 on os400
-  $A2E[10] = 37;  $A2E[91] = 186;  $A2E[93] = 187; $A2E[94] = 176;
-  $A2E[133] = 21; $A2E[168] = 189; $A2E[172] = 95; $A2E[221] = 173;
-
-  $E2A[21] = 133; $E2A[37] = 10;  $E2A[95] = 172; $E2A[173] = 221;
-  $E2A[176] = 94; $E2A[186] = 91; $E2A[187] = 93; $E2A[189] = 168;
-}
-
-# Smart rearrangement of parameters to allow named parameter
-# calling.  We do the rearangement if:
-# the first parameter begins with a -
-sub rearrange {
-    my($order,@param) = @_;
-    return () unless @param;
-
-    if (ref($param[0]) eq 'HASH') {
-	@param = %{$param[0]};
-    } else {
-	return @param 
-	    unless (defined($param[0]) && substr($param[0],0,1) eq '-');
-    }
-
-    # map parameters into positional indices
-    my ($i,%pos);
-    $i = 0;
-    foreach (@$order) {
-	foreach (ref($_) eq 'ARRAY' ? @$_ : $_) { $pos{lc($_)} = $i; }
-	$i++;
-    }
-
-    my (@result,%leftover);
-    $#result = $#$order;  # preextend
-    while (@param) {
-	my $key = lc(shift(@param));
-	$key =~ s/^\-//;
-	if (exists $pos{$key}) {
-	    $result[$pos{$key}] = shift(@param);
-	} else {
-	    $leftover{$key} = shift(@param);
-	}
-    }
-
-    push (@result,make_attributes(\%leftover,1)) if %leftover;
-    @result;
-}
-
-sub make_attributes {
-    my $attr = shift;
-    return () unless $attr && ref($attr) && ref($attr) eq 'HASH';
-    my $escape = shift || 0;
-    my(@att);
-    foreach (keys %{$attr}) {
-	my($key) = $_;
-	$key=~s/^\-//;     # get rid of initial - if present
-
-	# old way: breaks EBCDIC!
-	# $key=~tr/A-Z_/a-z-/; # parameters are lower case, use dashes
-
-	($key="\L$key") =~ tr/_/-/; # parameters are lower case, use dashes
-
-	my $value = $escape ? simple_escape($attr->{$_}) : $attr->{$_};
-	push(@att,defined($attr->{$_}) ? qq/$key="$value"/ : qq/$key/);
-    }
-    return @att;
-}
-
-sub simple_escape {
-  return unless defined(my $toencode = shift);
-  $toencode =~ s{&}{&}gso;
-  $toencode =~ s{<}{<}gso;
-  $toencode =~ s{>}{>}gso;
-  $toencode =~ s{\"}{"}gso;
-# Doesn't work.  Can't work.  forget it.
-#  $toencode =~ s{\x8b}{‹}gso;
-#  $toencode =~ s{\x9b}{›}gso;
-  $toencode;
-}
-
-sub utf8_chr {
-        my $c = shift(@_);
-
-        if ($c < 0x80) {
-                return sprintf("%c", $c);
-        } elsif ($c < 0x800) {
-                return sprintf("%c%c", 0xc0 | ($c >> 6), 0x80 | ($c & 0x3f));
-        } elsif ($c < 0x10000) {
-                return sprintf("%c%c%c",
-                                           0xe0 |  ($c >> 12),
-                                           0x80 | (($c >>  6) & 0x3f),
-                                           0x80 | ( $c          & 0x3f));
-        } elsif ($c < 0x200000) {
-                return sprintf("%c%c%c%c",
-                                           0xf0 |  ($c >> 18),
-                                           0x80 | (($c >> 12) & 0x3f),
-                                           0x80 | (($c >>  6) & 0x3f),
-                                           0x80 | ( $c          & 0x3f));
-        } elsif ($c < 0x4000000) {
-                return sprintf("%c%c%c%c%c",
-                                           0xf8 |  ($c >> 24),
-                                           0x80 | (($c >> 18) & 0x3f),
-                                           0x80 | (($c >> 12) & 0x3f),
-                                           0x80 | (($c >>  6) & 0x3f),
-                                           0x80 | ( $c          & 0x3f));
-
-        } elsif ($c < 0x80000000) {
-                return sprintf("%c%c%c%c%c%c",
-                                           0xfc |  ($c >> 30),
-                                           0x80 | (($c >> 24) & 0x3f),
-                                           0x80 | (($c >> 18) & 0x3f),
-                                           0x80 | (($c >> 12) & 0x3f),
-                                           0x80 | (($c >> 6)  & 0x3f),
-                                           0x80 | ( $c          & 0x3f));
-        } else {
-                return utf8_chr(0xfffd);
-        }
-}
-
-# unescape URL-encoded data
-sub unescape {
-  shift() if @_ > 1 and (ref($_[0]) || (defined $_[1] && $_[0] eq $CGI::DefaultClass));
-  my $todecode = shift;
-  return undef unless defined($todecode);
-  $todecode =~ tr/+/ /;       # pluses become spaces
-    $EBCDIC = "\t" ne "\011";
-    if ($EBCDIC) {
-      $todecode =~ s/%([0-9a-fA-F]{2})/chr $A2E[hex($1)]/ge;
-    } else {
-      $todecode =~ s/%(?:([0-9a-fA-F]{2})|u([0-9a-fA-F]{4}))/
-	defined($1)? chr hex($1) : utf8_chr(hex($2))/ge;
-    }
-  return $todecode;
-}
-
-# URL-encode data
-sub escape {
-  shift() if @_ > 1 and ( ref($_[0]) || (defined $_[1] && $_[0] eq $CGI::DefaultClass));
-  my $toencode = shift;
-  return undef unless defined($toencode);
-  # force bytes while preserving backward compatibility -- dankogai
-  $toencode = pack("C*", unpack("C*", $toencode));
-    if ($EBCDIC) {
-      $toencode=~s/([^a-zA-Z0-9_.-])/uc sprintf("%%%02x",$E2A[ord($1)])/eg;
-    } else {
-      $toencode=~s/([^a-zA-Z0-9_.-])/uc sprintf("%%%02x",ord($1))/eg;
-    }
-  return $toencode;
-}
-
-# This internal routine creates date strings suitable for use in
-# cookies and HTTP headers.  (They differ, unfortunately.)
-# Thanks to Mark Fisher for this.
-sub expires {
-    my($time,$format) = @_;
-    $format ||= 'http';
-
-    my(@MON)=qw/Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec/;
-    my(@WDAY) = qw/Sun Mon Tue Wed Thu Fri Sat/;
-
-    # pass through preformatted dates for the sake of expire_calc()
-    $time = expire_calc($time);
-    return $time unless $time =~ /^\d+$/;
-
-    # make HTTP/cookie date string from GMT'ed time
-    # (cookies use '-' as date separator, HTTP uses ' ')
-    my($sc) = ' ';
-    $sc = '-' if $format eq "cookie";
-    my($sec,$min,$hour,$mday,$mon,$year,$wday) = gmtime($time);
-    $year += 1900;
-    return sprintf("%s, %02d$sc%s$sc%04d %02d:%02d:%02d GMT",
-                   $WDAY[$wday],$mday,$MON[$mon],$year,$hour,$min,$sec);
-}
-
-# This internal routine creates an expires time exactly some number of
-# hours from the current time.  It incorporates modifications from 
-# Mark Fisher.
-sub expire_calc {
-    my($time) = @_;
-    my(%mult) = ('s'=>1,
-                 'm'=>60,
-                 'h'=>60*60,
-                 'd'=>60*60*24,
-                 'M'=>60*60*24*30,
-                 'y'=>60*60*24*365);
-    # format for time can be in any of the forms...
-    # "now" -- expire immediately
-    # "+180s" -- in 180 seconds
-    # "+2m" -- in 2 minutes
-    # "+12h" -- in 12 hours
-    # "+1d"  -- in 1 day
-    # "+3M"  -- in 3 months
-    # "+2y"  -- in 2 years
-    # "-3m"  -- 3 minutes ago(!)
-    # If you don't supply one of these forms, we assume you are
-    # specifying the date yourself
-    my($offset);
-    if (!$time || (lc($time) eq 'now')) {
-        $offset = 0;
-    } elsif ($time=~/^\d+/) {
-        return $time;
-    } elsif ($time=~/^([+-]?(?:\d+|\d*\.\d*))([mhdMy]?)/) {
-        $offset = ($mult{$2} || 1)*$1;
-    } else {
-        return $time;
-    }
-    return (time+$offset);
-}
-
-sub ebcdic2ascii {
-  my $data = shift;
-  $data =~ s/(.)/chr $E2A[ord($1)]/ge;
-  $data;
-}
-
-sub ascii2ebcdic {
-  my $data = shift;
-  $data =~ s/(.)/chr $A2E[ord($1)]/ge;
-  $data;
-}
-
-1;
-
-__END__
-
-=head1 NAME
-
-CGI::Util - Internal utilities used by CGI module
-
-=head1 SYNOPSIS
-
-none
-
-=head1 DESCRIPTION
-
-no public subroutines
-
-=head1 AUTHOR INFORMATION
-
-Copyright 1995-1998, Lincoln D. Stein.  All rights reserved.  
-
-This library is free software; you can redistribute it and/or modify
-it under the same terms as Perl itself.
-
-Address bug reports and comments to: lstein@cshl.org.  When sending
-bug reports, please provide the version of CGI.pm, the version of
-Perl, the name and version of your Web server, and the name and
-version of the operating system you are using.  If the problem is even
-remotely browser dependent, please provide information about the
-affected browers as well.
-
-=head1 SEE ALSO
-
-L
-
-=cut
-- 
cgit v1.2.3