package CGI::Simple;
require 5.004;

use strict;
# use warnings;  # during testing
use SelfLoader;
use vars qw ( $DISABLE_UPLOADS $POST_MAX $VERSION );
$VERSION = "0.01";
$DISABLE_UPLOADS = 1;
$POST_MAX = 102400;  # use a post max of 100K, set to -1 for no limits

=head1 NAME

CGI::Simple - A Simple totally OO CGI interface that is CGI.pm complia
+nt

=head1 SYNOPSIS

    use CGI::Simple;
    $CGI::Simple::POST_MAX = 1024;

    $q = new CGI::Simple;
    $q = new CGI::Simple( { 'foo'=>'1', 'bar'=>[2,3,4] } );
    $q = new CGI::Simple( 'foo=1&bar=2&bar=3&bar=4' );
    $q = new CGI::Simple( \*FILEHANDLE );

    $q->save( \*FILEHANDLE );

    @params = $q->param;
    $value = $q->param('foo');
    @values = $q->param('foo');

    %fields = $q->Vars;

    @keywords = $q->keywords;

    $q->param( 'foo', 'some', 'new', 'values' );
    $q->param( -name=>'foo', -value=>'bar' );
    $q->param( -name=>'foo', -value=>['bar','baz'] );

    $q->append( -name=>'foo', -value=>'bar' );
    $q->append( -name=>'foo', -value=>['some', 'new', 'values'] );

    $q->delete('foo');
    $q->delete_all;

    $decoded = $q->url_decode($encoded);
    $encoded = $q->url_encode($unencoded);
    $param = $q->escapeHTML('  < >&"'."\n".'<>&"');

    dienice( $q->cgi_error ) if $q->cgi_error;

=head1 DESCRIPTION

CGI::Simple provides a lightweight drop in replacement for CGI.pm. It 
+has 
an identical OO interface to CGI.pm for parameter parsing. Multipart/f
+orm-data 
encoding is not supported. It has no HTML output functionality outside
+ of an 
escapeHTML() method. There is no header method either.

A list of the supported methods is given above. For full specifics see
+ the 
extensive CGI.pm pod. Unlike CGI.pm this module has a default $POST_MA
+X setting 
of 100K This should be more than adequate for most purposes. If you wi
+sh 
to change this you must set it before you call the new() constructor, 
+just as 
with CGI.pm

=head2 EXPORT

Nothing. $POST_MAX and $DISABLE_UPLOADS globals from CGI.pm used

=head1 BUGS

As this is 0.01 there are almost bound to be some. Unlike CGI.pm which
+ tries 
to accept all filehandle like objects only \*FH and $fh are accepted b
+y 
CGI::Simple as file accessors.

=head1 AUTHOR

Dr James Freeman E<lt>jfreeman@tassie.net.auE<gt>

This package is free software and is provided ``as is'' without expres
+s or 
implied warranty. It may be used, redistributed and/or modified under 
+the terms 
of the Perl Artistic License (see http://www.perl.com/perl/misc/Artist
+ic.html)

=head1 CREDITS

The entire interface and key sections of code come from CGI.pm by Linc
+oln Stein. 
Hopefully Randall Schwartz will go over the code with his eagle eye to
+ iron out 
the bugs. Then again he may just flame me :-) I enjoyed writing this a
+nyway.

Jeff Pinyan picked the first bug - the gauntlet is laid down:

Cristians: 0   Lions: 13
Japhy:1        Rest: 0

=head1 SEE ALSO

CGI.pm by Lincoln Stein

=cut


sub new {
    my ( $class, $init ) = @_;
    $class = ref($class) || $class;
    my $self  = {};
    bless $self, $class;
    $self->init($init);
  return $self;
}

sub init {
    my ( $self, $init ) = @_;
    if ( ! defined $init ) {
        $self->initialise;
    }
    elsif ( (ref $init) =~ m/HASH/i ) {
        for my $param( keys %{$init} ) {
            $self->{$param} = (ref $init->{$param}) ? $init->{$param} 
+: [$init->{$param}];
        }
    }
    elsif ( (ref $init) =~ m/GLOB/i ) { 
        $self->init_from_file($init);
    }
    else {
        $self->parse_params($init);
    }
}

sub initialise {
    my $self = shift;
    my $data;
    my ( $type, $length, $method ) = @ENV{'CONTENT_TYPE','CONTENT_LENG
+TH','REQUEST_METHOD'};
    if ( defined $type and $type =~ m|^multipart/form-data| ) {
        $self->cgi_error( "Can't process multipart/form-data encoding"
+ );
      return undef;
    }
    if ( $POST_MAX != -1 and $length > $POST_MAX ) {
        $self->cgi_error( "$length bytes on STDIN exceeds POST_MAX!" )
+;
      return undef;
    }
    if ( $method eq 'POST') {
        read( STDIN, $data, $length );
        unless ( $length == length $data ) {
            $self->cgi_error( "Bad read! wanted $length, got ".(length
+ $data) );
          return undef;
        }
        # uncomment this if you want to use query string and POST at t
+he same time (not recommended)
        # $data .= $ENV{'QUERY_STRING'};
    }
    elsif ( $method =~/^(GET|HEAD)$/ ) {
        $data = $ENV{'QUERY_STRING'};
        $data ||= $ENV{'REDIRECT_QUERY_STRING'} || '';
    }
    else {
        $self->cgi_error("Unknown method $method");
      return undef;
    }
    unless ( $data ) {
        $self->cgi_error("No data recieved via $method");
       return undef;
    }
    $data =~ s/%00//g;   # prevent null byte hacks
    $data =~ tr/\000//d;
    $self->parse_params($data);
}

sub parse_params {
    my ( $self, $data ) = @_;
    unless ($data =~ /[&=;]/) {
        $self->{'keywords'} = [$self->parse_keywordlist($data)];
      return;
    }
    my @pairs = split /[&;]/, $data;
    for my $pair(@pairs) {
        my ( $param, $value ) = split '=', $pair, 2;
      next unless $param;
        $value = '' unless defined $value;
        $param = url_decode( $self, $param );
        $value = url_decode( $self, $value );
        push @{$self->{$param}}, $value;
    }
}

sub parse_keywordlist {
    my( $self, $keywords ) = @_;
    $keywords = $self->url_decode($keywords);
    my @keywords = split /\s+/, $keywords;
  return @keywords;
}

sub param {
    my ( $self, $param, @values ) = @_;
    # set values using -name=>'foo',-value=>'bar' syntax
    if ( defined $param and $param eq '-name' ) {
        my ( $param, undef, $value ) = @values;
        $self->{$param} = (ref $value) ? $value : [$value];
      return;
    }
    # if multiple values passed we also assume set param
    if ( @values ) {
        $self->{$param} = [@values];
      return;
    }
    unless ( defined $param ) {
        my @params = grep { ! /^\.cgi_error/ } keys %{$self};
      return sort @params;
    }
    if (defined $self->{$param}) {
       my @values = @{$self->{$param}};
     return wantarray ? @values : $values[0];
    }
  return undef;
}

sub url_decode {
    my ( $self, $decode ) = @_;
  return undef unless defined $decode;
    $decode =~ tr/+/ /;
    $decode =~ s/%([a-fA-F0-9]{2})/ pack "C", hex $1 /eg;
  return $decode;
}

sub cgi_error {
    my ( $self, $err ) = @_;
    $self->{'.cgi_error'} = $err if defined $err;
  return $self->{'.cgi_error'};
}

sub init_from_file {
    my ( $self, $fh ) = @_;
    local $/ = "\n";
    while (my $pair = <$fh>) {
        chomp $pair;
      return if $pair eq '=';
        $self->parse_params($pair);
    }
}

# these next subs will only be loaded on demand by Selfloader
# they can be safely deleted if you do not call them
__DATA__
sub url_encode {
    my ( $self, $encode ) = @_;
  return undef unless defined $encode;
    $encode =~ s/([^A-Za-z0-9\-_.!~*'() ])/ uc sprintf "%%%02x",ord $1
+ /eg;
    $encode =~ tr/ /+/;
  return $encode;
}

sub Vars {
    my $self = shift;
    my @hash_list = ();
    my @params = $self->param;
    for my $param(@params) {
        my @values = $self->param($param);
        push @hash_list, ($param, (join "\0", @values));
    }
  return @hash_list;
}        

sub append {
    my ( $self, undef, $param, undef, $value ) = @_;
    my @values = ref $value ? @{$value} : ($value);
    push @{$self->{$param}}, $_ for @values;
}
    
sub keywords {
    my $self = shift;
  return @{$self->{'keywords'}} if defined $self->{'keywords'};
  return undef;
}

sub delete {
    my ( $self, $param ) = @_;
  return undef unless defined $self->{$param};
    delete $self->{$param};
}   

sub delete_all {
    my $self = shift;
    undef %{$self};
}

sub escapeHTML {
    my ( $self, $escape ) = @_;
  return undef unless defined $escape ;
    # make the required escapes
    $escape =~ s/&/&amp/g;
    $escape =~ s/"/&quot;/g;
    $escape =~ s/</&lt;/g;
    $escape =~ s/>/&gt;/g;
    # change tabs to 4 spaces
    $escape =~ s/\t/    /g;
    # make the whitespace escapes  
    $escape =~ s/( {2,})/"&nbsp;" x length $1/eg;
    # make the brower bugfix escapes as seen on source of
    # CGI.pm. Doing this globally should do no harm
    $escape =~ s/\x8b/&#139;/g;
    $escape =~ s/\x9b/&#155;/g;
    # uncomment to change newlines to <br> if desired
    # $escape =~  s/\n/<br>\n/g;
  return $escape;
}
    
sub save {
    my ( $self, $fh ) = @_;
    local ( $,, $\ ) = ( '', '' );
    unless ( $fh and fileno $fh ) {
        $self->cgi_error('Invalid filehandle');
      return undef;
    }
    for my $param($self->param) {
        for my $value ( $self->param($param) ) {;
            print $fh $self->url_encode($param), '=', $self->url_encod
+e($value), "\n";
        }
    }
    print $fh "=\n";
}
__END__
[download]

Patches

See the POD Japhy rocks so what's new. .tar.gz is not atomic with PM. Priorities. PM....->....->....CPAN

cheers

tachyon

s&&rsenoyhcatreve&&&s&n.+t&"$'$`$\"$\&"&ee&&y&srve&&d&&print