File Coverage

blib/lib/LibWeb/CGI.pm

Criterion	Covered	Total	%
statement	16	51	31.3
branch	3	18	16.6
condition	1	11	9.0
subroutine	3	11	27.2
pod	3	8	37.5
total	26	99	26.2

#==============================================================================
# LibWeb::CGI -- Extra cgi supports for libweb applications.

package LibWeb::CGI;

# Copyright (C) 2000  Colin Kong
#
# This program is free software; you can redistribute it and/or
# modify it under the terms of the GNU General Public License
# as published by the Free Software Foundation; either version 2
# of the License, or (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.
#=============================================================================

# $Id: CGI.pm,v 1.4 2000/07/18 06:33:30 ckyc Exp $

#-#############################
# Use standard library.
use strict;
use vars qw(@ISA $VERSION $AutoloadClass);

#-#############################
# Use custom library.
require LibWeb::Class;
require LibWeb::Core;

$VERSION = '0.02';

#-#############################
# Inheritance.
# Require CGI.pm version > 2.66.
require CGI;
@ISA = qw( LibWeb::Class CGI );
# This variable tells CGI what type of default object to create when
# called in the function-oriented manner.
$CGI::DefaultClass = __PACKAGE__;
# This tells the CGI autoloader where to look for functions that are
# not defined. If you wish to override CGI's autoloader, set this to
# the name of your own package.
$AutoloadClass = 'CGI';
# Avoid denial of service attacks.
$CGI::POST_MAX = 1024 * 100; # Default: Max 100K posts.
$CGI::DISABLE_UPLOADS = 1;   # Default: No uploads.

#-#############################
# Methods.
sub new {
    #
    # Params: [ -post_max=>, -disable_uploads=>, -auto_escape=> ]
    #
    # Pre:
    # - -post_max is the ceiling on the size of POSTings, in bytes.
    #   The default for LibWeb::CGI is 100 Kilobytes.
    # - -disable_uploads, if non-zero, will disable file uploads completely
    #   which is the default for LibWeb::CGI.
    # - -auto_escape determines whether the text and labels that you provide
    #   for form elements are escaped according to HTML rules.  Non-zero value
    #   will enable auto escape, and undef will disable auto escape (default
    #   for LibWeb::CGI).
    #
    my ($class, $Class, $self, $rc, $post_max, $disable_uploads, $auto_escape);
    $class = shift;
    $Class = ref($class) || $class;

    ($rc, $post_max, $disable_uploads, $auto_escape) =
      $Class->rearrange( ['RC', 'POST_MAX', 'DISABLE_UPLOADS', 'AUTO_ESCAPE'], @_ );

    # Set up base class: CGI accordingly.
    $CGI::POST_MAX = $post_max if defined($post_max);
    $CGI::DISABLE_UPLOADS = $disable_uploads if defined($disable_uploads);

    # Inherit instance variables from the base class.
    $self = $Class->CGI::new();
    bless($self, $Class);

    # This doesn't work.  Some HTMLs still printed
    # out as escaped.  I don't know why.
    ($auto_escape) ? $self->autoEscape( $auto_escape ) :
                     $self->autoEscape( undef );

    # Any necessary initialization.
    #$self->_init($rc);

    # Returns a reference to this object.
    return $self;
}

#sub _init {
#    #
#    # Params: $rc
#    #
#    # Pre:
#    # - $rc is absolute path to the rc file for LibWeb.
#    #
#    # Initialization whenever an object of this class is created.
#    # Put site customizations here to override several CGI.pm's variables.
#    #
#    my ($self, $key, $value);
#    $self = shift;

#    # Instance variables for this class.
#    $self->{__PACKAGE__.'.core'} = new LibWeb::Core(shift);

#    # A work-around to inherit LibWeb.pm instance variables without doing MI.
#    while ( ($key,$value) = each (%LibWeb::Core::RC) ) {
#	$self->{__PACKAGE__.$key} = $value
#	  unless exists $self->{__PACKAGE__.$key};
#    }
#}

sub DESTROY {}

sub header {
    my $self = shift;
    #$self->delete_all();
    #$self->autoEscape(undef);
    if (@_) { return $self->SUPER::header(@_); }
    else {
	my $crlf = $LibWeb::Core::RC{CRLF} || "\n\n";
	return "Content-Type: text/html$crlf$crlf";
    }
}

sub is_param_not_null {
    my $self = shift;
    return ( defined($_[0]) && ($_[0] ne "") && ($_[0] ne " ") );
}

sub parameter {
    #
    # Sample usage: $this->parameter(cgi_parameter).
    #
    # Pre:
    # 1. cgi_parameter is the parameter passed by either `GET' or `POST'.
    #
    # Post:
    # 1. If cgi_parameter is a mandatory form value (the ones without `.' as prefix
    #    in the parameter's name) and it is null, print an error message and abort
    #    the program.
    # 2. Return the value of the parameter.
    #
    my ( $self, $key, $value, $param_is_not_null );
    $self = shift;
    $key = shift;
    $value = $self->CGI::param($key);

    # Check for denial of service attacks.
    # CGI::cgi_error() is available since CGI 2.47.
    # Where is CGI::cgi_error()??  It's supported pre CGI3, but seems to be
    # disappeared in new release of CGI.pm 3.01 alpha (24/04/2000).
    # Need to apply patch here if CGI version is < 2.47 or >= 3.01 alpha.
    eval {
	$self->fatal( -msg => 'Invalid post.  Post too large.',
		      -alertMsg => "413 POST too large for CGI param: $key",
		      -helpMsg => $self->{HHTML}->post_too_large() )
	  if ( !$value && $self->cgi_error() );
    };


    # Check to see if mandatory cgi form values are non-null.
    $param_is_not_null = $self->is_param_not_null($value);
    unless ($key =~ m:^[.].*$:) {
	unless ( $param_is_not_null ) {
	    $key =~ s:[_]+: :g;
	    $self->fatal(-msg => ucfirst($key)." not entered.",
			 -alertMsg => "$key not entered.",
			 -helpMsg => $LibWeb::Core::RC{HHTML}->hit_back_and_edit()
			);
	}
    }

    # Return undef for non-mandatory cgi parameter's value if
    # it's not entered by user.
    return undef unless($param_is_not_null);

    # Sanitize all html tags.
    #$value = $self->sanitize(-html => $value) if defined($value);
    return $value;
}

sub redirect {
    #
    # Params: -url=> [, -cookie=> ].
    # e.g. 'http://www.your_site.org/help.html'  or '/help.html'.
    #
    # Post:
    # 1. Redirect the client Web browser to the specified page.
    #
    my ($self, $url, $cookie);
    $self = shift;
    ($url, $cookie) = $self->rearrange( ['URL', 'COOKIE'], @_ );

    # Append 'http://' to the url to make sure redirect work.
    unless ($url =~ m"^http://") {
	# remove front slash of url.
	#$url =~ s:^[/]::;
	chop $self->{URL_ROOT};
	$url = $self->{URL_ROOT} . $url;
    }

    print $self->SUPER::redirect( -url => $url, -cookie => $cookie );
#    $self->send_cookie($cookie) if defined($cookie);
#    print "Status: 302 Moved\nLocation: $url\n\n" if defined($url);
#    #print "Content-Type: text/html\n\n";
    exit(0);
}

sub send_cookie {
    shift;
    LibWeb::Core->new()->send_cookie(@_);
}

sub fatal {
    shift;
    LibWeb::Core->new()->fatal(@_);
}

sub sanitize {
    shift;
    LibWeb::Core->new()->sanitize(@_);
}

1;
__DATA__