CGI-Lite
view release on metacpan or search on metacpan
lib/CGI/Lite.pm view on Meta::CPAN
##++
## CGI Lite v3.03
##
## see separate CHANGES file for detailed history
##
## Changes in versions 2.03 and newer copyright
## (c) 2014-2015, 2017-2018, 2021 Pete Houston
##
## Copyright (c) 1995, 1996, 1997 by Shishir Gundavaram
## All Rights Reserved
##
## Permission to use, copy, and distribute is hereby granted,
## providing that the above copyright notice and this permission
## appear in all copies and in supporting documentation.
##--
###############################################################################
=head1 NAME
CGI::Lite - Process and decode WWW forms and cookies
=head1 SYNOPSIS
use CGI::Lite ();
my $cgi = CGI::Lite->new ();
$cgi->set_directory ('/some/dir') or die "Directory cannot be set.\n";
$cgi->add_mime_type ('text/csv');
my $cookies = $cgi->parse_cookies;
my $form = $cgi->parse_new_form_data;
my $status = $cgi->is_error;
if ($status) {
my $message = $cgi->get_error_message;
die $message;
}
=head1 DESCRIPTION
This module can be used to decode form data, query strings, file uploads
and cookies in a very simple manner.
It has only one dependency and is therefore relatively fast to
instantiate. This makes it well suited to a non-persistent CGI scenario.
=head1 METHODS
Here are the methods used to process the forms and cookies:
=head2 new
The constructor takes no arguments and returns a new CGI::Lite object.
=head2 parse_form_data
This handles the following types of requests: GET, HEAD and POST.
By default, CGI::Lite uses the environment variable REQUEST_METHOD to
determine the manner in which the query/form information should be
decoded. However, it may also be passed a valid request
method as a scalar string to force CGI::Lite to decode the information in
a specific manner.
my $params = $cgi->parse_form_data ('GET');
For multipart/form-data, uploaded files are stored in the user selected
directory (see L<set_directory|/set_directory>). If timestamp mode is on (see
L<add_timestamp|/add_timestamp>), the files are named in the following format:
timestamp__filename
where the filename is specified in the "Content-disposition" header.
I<NOTE:>, the browser URL encodes the name of the file. This module
makes I<no> effort to decode the information for security reasons.
However, this can be achieved by creating a subroutine and then using
the L<filter_filename|/filter_filename> method.
Returns either a hash or a reference to the hash, which contains
all of the key/value pairs. For fields that contain file information,
the value contains either the path to the file, or the filehandle
(see the L<set_file_type|/set_file_type> method).
=head2 parse_new_form_data
As for parse_form_data, but clears the CGI object state before processing
the request. This is useful in persistent applications (e.g. FCGI), where
the CGI object is reused for multiple requests. e.g.
my $CGI = CGI::Lite->new ();
while (FCGI::accept > 0)
{
my $query = $CGI->parse_new_form_data ();
# process query
}
=head2 parse_cookies
Decodes and parses cookies passed by the browser. This method works in
much the same manner as L<parse_form_data|/parse_form_data>. As these two data sources
are treated the same internally, users who wish to extract form and
cookie data separately might find it easiest to call
parse_cookies first and then parse_new_form_data in order to retrieve
two distinct hashes (or hashrefs).
=head2 is_error
This method is used to check for any potential errors after calling
either L<parse_form_data|/parse_form_data> or L<parse_cookies|/parse_cookies>.
my $form = $cgi->parse_form_data ();
my $went_wrong = $cgi->is_error ();
Returns 0 if there is no error, 1 otherwise.
=head2 get_error_message
If an error occurs when parsing form/query information or cookies, this
method may be used to retrieve the error message. Remember, the presence
of any errors can be checked by calling the L<is_error|/is_error> method.
my $msg = $cgi->get_error_message ();
Returns the error message as a plain text string.
=head2 set_platform
This method is used to set the platform on which the web server is
running. CGI::Lite uses this information to translate end-of-line
(EOL) characters for uploaded files (see the L<add_mime_type|/add_mime_type> and
L<remove_mime_type|/remove_mime_type> methods) so that they are accounted for properly on
that platform.
$cgi->set_platform ($platform);
$platform can be any of (case insensitive):
Unix EOL: \012 = \n
Windows, Windows95, DOS, NT, PC EOL: \015\012 = \r\n
Mac or Macintosh EOL: \015 = \r
"Unix" is the default.
Returns undef.
=head2 set_size_limit
To set a specific limit on the total size of the request (in bytes) call
this method with that size as the sole argument. A size of zero
effectively disables POST requests. To specify an unlimited size (the
default) use an argument of -1.
my $size_limit = $cgi->set_size_limit (10_000_000);
Returns the new value if provided, otherwise the existing value.
=head2 deny_uploads
To prevent any file uploads simply call this method with an argument of
1. To enable them again, use an argument of zero.
my $deny_uploads = $cgi->deny_uploads (1);
Returns the new value if provided, otherwise the existing value.
=head2 force_unique_cookies
It is generally considered a mistake to send an HTTP request with
multiple cookies of the same name. However, the RFC is somewhat vague
regarding how servers are expected to handle such an eventuality.
CGI::Lite has always allowed such multiple values and returned them as
an arrayref to be entirely consistent with the same treatment of
form/query data.
To override the default behaviour this method may be called with a
single integer argument before the call to L<parse_cookies|/parse_cookies>. An argument
of 1 means that the first cookie value will be used and the others
discarded. An argument of 2 means that the last cookie value will be
used and the others discarded. An argument of 3 means that an arrayref
will be returned as usual but an error raised to indicate the situation.
An argument of 0 (or any other value) sets it back to the default.
$cgi->force_unique_cookies (1);
$cgi->parse_cookies;
Note that if there is already an item of data in the CGI::Lite object
which matches the name of a cookie then the subsequent L<parse_cookies|/parse_cookies>
call will treat the new cookie value as another data item and the resulting
behaviour will be affected by this method. This is another reason to
call L<parse_cookies|/parse_cookies> before L<parse_form_data|/parse_form_data>.
Returns the new value if provided, otherwise the existing value.
=head2 set_directory
Used to set the directory where the uploaded files will be stored
(only applies to the I<multipart/form-data> encoding scheme).
my $tmpdir = '/some/dir';
$cgi->set_directory ($tmpdir) or
die "Directory $tmpdir cannot be used.\n";
This function should be called I<before> L<parse_form_data|/parse_form_data>,
or else the directory defaults to "/tmp". If the application cannot
write to the directory for whatever reason, an error status is returned.
Returns 0 on error, 1 otherwise.
=head2 close_all_files
$cgi->close_all_files;
All uploaded files that are opened as a result of calling L<set_file_type|/set_file_type>
with the "handle" argument can be closed in one shot by calling this
method which takes no arguments and returns undef.
=head2 add_mime_type
By default, EOL characters are translated for all uploaded files
with specific MIME types (i.e. text/plain, text/html, etc.).
This method can be used to add to the list of MIME types. For example,
if you want CGI::Lite to translate EOL characters for uploaded
files of I<application/mac-binhex40>, then you would do this:
$cgi->add_mime_type ('application/mac-binhex40');
Returns 1 if this MIME type is newly added, 0 otherwise.
=head2 remove_mime_type
This method is the converse of L<add_mime_type|/add_mime_type>. It allows for the
removal of a particular MIME type. For example, if you do not want
CGI::Lite to translate EOL characters for uploaded files of type I<text/html>,
then you would do this:
$cgi->remove_mime_type ('text/html');
Returns 1 if this MIME type is newly deleted, 0 otherwise.
=head2 get_mime_types
Returns the list of the
MIME types for which EOL translation is performed.
my @mimelist = $cgi->get_mime_types ();
=head2 get_upload_type
Returns the MIME type of uploaded data. Takes the field name as a scalar
argument. This previously undocumented function was named print_mime_type
prior to version 3.0.
my $this_type = $cgi->get_upload_type ($field);
Returns the MIME type as a scalar string if single valued, an arrayref
if multi-valued or undef if the argument does not exist or has no type.
=head2 set_file_type
The I<names> of uploaded files are returned by default when
the L<parse_form_data|/parse_form_data> method is called . But if this method is passed the string "handle" as its argument beforehand then
the I<handles> to the files are returned instead. However, the name
of each handle still corresponds to the filename.
# $fh has been set to one of 'handle' or 'file'
$cgi->set_file_type ($fh);
This function should be called I<before> any call to L<parse_form_data|/parse_form_data>, or
else it will have no effect.
=head2 add_timestamp
By default, a timestamp is added to the front of uploaded files.
However, there is the option of completely turning off timestamp mode
(value 0), or adding a timestamp only for existing files (value 2).
$cgi->add_timestamp ($tsflag);
# where $tsflag takes one of these values
# 0 = no timestamp
# 1 = timestamp all files (default)
# 2 = timestamp only if file exists
=head2 filter_filename
This method is used to change the manner in which uploaded
files are named. For example, if you want uploaded filenames
to be all upper case, you can use the following code:
$cgi->filter_filename (\&make_uppercase);
$cgi->parse_form_data;
# ...
sub make_uppercase
{
my $file = shift;
$file =~ tr/a-z/A-Z/;
return $file;
}
This method is perhaps best used to sanitise filenames for a specific
O/S or filesystem e.g. by removing spaces or leading hyphens, etc.
=head2 set_buffer_size
This method allows fine-grained control of the buffer size used internally
when dealing with multipart form data. However, the I<actual> buffer
size that the algorithm uses I<can> be up to 3x the value specified
as the argument. This ensures that boundary strings are not "split"
between multiple reads. So, take this into consideration when setting
the buffer size.
my $size = $cgi->set_buffer_size (4096);
The buffer size may not be set below 256 bytes nor above the total amount
of multipart form data. The default value is 1024 bytes.
Returns the buffer size.
=head2 get_ordered_keys
Returns either a reference to an array or an array itself consisting
of the form fields/cookies in the order they were parsed.
my $keys = $cgi->get_ordered_keys;
my @keys = $cgi->get_ordered_keys;
=head2 print_data
Displays all the key/value pairs (either form data or cookie information)
in an ordered fashion to standard output. It is mainly useful for
debugging. There are no arguments and no return values.
=head2 wrap_textarea
This is a method to wrap a long string into one that is separated by EOL
characters (see L<set_platform|/set_platform>) at fixed lengths. The two arguments
to be passed to this method are the string and the length at which the
line separator is to be added.
my $new_string = $cgi->wrap_textarea ($string, $length);
Returns the modified string.
=head2 get_multiple_values
lib/CGI/Lite.pm view on Meta::CPAN
All Rights Reserved.
Changes in versions 2.03 onwards are copyright 2014, 2015, 2017, 2018, 2021
by Pete Houston.
Permission to use, copy, and distribute is hereby granted,
providing that the above copyright notice and this permission
appear in all copies and in supporting documentation.
=head1 LICENCE
This program is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.
=cut
###############################################################################
package CGI::Lite;
use strict;
use warnings;
require 5.6.0;
use Symbol; # For _create_handles and create_variables
##++
## Global Variables
##--
BEGIN {
our @ISA = 'Exporter';
our @EXPORT = qw/browser_escape url_encode url_decode is_dangerous/;
}
our $VERSION = '3.03';
##++
## Start
##--
sub new
{
my $class = shift;
my $self = {
multipart_dir => '/tmp',
file_type => 'name',
platform => 'Unix',
buffer_size => 1024,
timestamp => 1,
filter => undef,
web_data => {},
ordered_keys => [],
all_handles => [],
error_status => 0,
error_message => undef,
file_size_limit => 2097152, # Unused as yet
size_limit => -1,
deny_uploads => 0,
unique_cookies => 0,
};
$self->{convert} = {
'text/html' => 1,
'text/plain' => 1
};
$self->{file} = {Unix => '/', Mac => ':', PC => '\\'};
$self->{eol} = {Unix => "\012", Mac => "\015", PC => "\015\012"};
bless ($self, $class);
return $self;
}
sub Version
{
return $VERSION;
}
sub deny_uploads
{
my ($self, $newval) = @_;
if (defined $newval) {
$self->{deny_uploads} = $newval ? 1 : 0;
}
return $self->{deny_uploads};
}
sub set_size_limit
{
my ($self, $limit) = @_;
return unless defined $limit;
if ($limit =~ /^[0-9]+$/) {
$self->{size_limit} = $limit;
} else {
$self->{size_limit} = -1;
}
return $self->{size_limit};
}
sub set_directory
{
my ($self, $directory) = @_;
return 0 unless $directory;
stat ($directory);
if ((-d _) && (-r _) && (-w _)) {
$self->{multipart_dir} = $directory;
return (1);
} else {
return (0);
}
}
sub add_mime_type
{
my ($self, $mime_type) = @_;
if ($mime_type and not exists $self->{convert}->{$mime_type}) {
return $self->{convert}->{$mime_type} = 1;
}
return 0;
}
sub remove_mime_type
{
my ($self, $mime_type) = @_;
if ($self->{convert}->{$mime_type}) {
delete $self->{convert}->{$mime_type};
return (1);
} else {
return (0);
}
}
sub get_mime_types
{
my $self = shift;
return (sort keys %{$self->{convert}});
}
lib/CGI/Lite.pm view on Meta::CPAN
return ($self->{buffer_size});
}
sub parse_new_form_data
# Reset state before parsing (for persistant CGI objects, e.g. under FastCGI)
# BDL
{
my ($self, @param) = @_;
# close files (should happen anyway when 'all_handles' is cleared...)
$self->close_all_files ();
$self->{web_data} = {};
$self->{ordered_keys} = [];
$self->{all_handles} = [];
$self->{error_status} = 0;
$self->{error_message} = undef;
$self->parse_form_data (@param);
}
sub parse_form_data
{
my ($self, $user_request) = @_;
my ($request_method, $content_length, $content_type, $query_string,
$boundary, $post_data, @query_input);
# Force into object method
unless (ref ($self)) { $self = $self->new; }
$request_method = $user_request || $ENV{REQUEST_METHOD} || '';
$content_length = $ENV{CONTENT_LENGTH} || 0;
$content_type = $ENV{CONTENT_TYPE};
# If we've set a size limit, check that it has not been exceeded
if ($self->{size_limit} > -1 and $content_length > $self->{size_limit}) {
$self->_error ("Content lenth $content_length exceeds limit of "
. $self->{size_limit});
return;
}
if ($request_method =~ /^(get|head)$/i) {
$query_string = $ENV{QUERY_STRING};
$self->_decode_url_encoded_data (\$query_string, 'form');
return wantarray ? %{$self->{web_data}} : $self->{web_data};
} elsif ($request_method =~ /^post$/i) {
if (!$content_type
|| ($content_type =~ /^application\/x-www-form-urlencoded/)) {
read (STDIN, $post_data, $content_length);
$self->_decode_url_encoded_data (\$post_data, 'form');
return wantarray ? %{$self->{web_data}} : $self->{web_data};
} elsif ($content_type =~ /multipart\/form-data/) {
if ($self->{deny_uploads}) {
$self->_error ("multipart/form-data unacceptable when "
. "deny_uploads is set");
return;
}
($boundary) = $content_type =~ /boundary=(\S+)$/;
$self->_parse_multipart_data ($content_length, $boundary);
return wantarray ? %{$self->{web_data}} : $self->{web_data};
} else {
$self->_error ('Invalid content type!');
}
} else {
##++
## Got the idea of interactive debugging from CGI.pm, though it's
## handled a bit differently here. Thanks Lincoln!
##--
print "[ Reading query from standard input. Press ^D to stop! ]\n";
@query_input = <>;
chomp (@query_input);
$query_string = join ('&', @query_input);
$query_string =~ s/\\(.)/sprintf ('%%%02X', ord ($1))/eg;
$self->_decode_url_encoded_data (\$query_string, 'form');
return wantarray ? %{$self->{web_data}} : $self->{web_data};
}
}
sub parse_cookies
{
my $self = shift;
my $cookies;
$cookies = $ENV{HTTP_COOKIE} || return;
$self->_decode_url_encoded_data (\$cookies, 'cookies');
return wantarray ? %{$self->{web_data}} : $self->{web_data};
}
sub get_ordered_keys
{
my $self = shift;
return wantarray ? @{$self->{ordered_keys}} : $self->{ordered_keys};
}
sub print_data
{
my $self = shift;
my $eol = $self->{eol}->{$self->{platform}};
foreach my $key (@{$self->{ordered_keys}}) {
my $value = $self->{web_data}->{$key};
if (ref $value) {
print "$key = @$value$eol";
} else {
print "$key = $value$eol";
}
}
}
sub get_upload_type
{
my ($self, $field) = @_;
return ($self->{'mime_types'}->{$field});
}
sub wrap_textarea
{
my ($self, $string, $length) = @_;
my ($new_string, $platform, $eol);
$length = 70 unless ($length);
$platform = $self->{platform};
$eol = $self->{eol}->{$platform};
$new_string = $string || return;
$new_string =~ s/[\0\r]\n?/ /sg;
$new_string =~ s/(.{0,$length})\s/$1$eol/sg;
return $new_string;
}
sub get_multiple_values
{
my ($self, $array) = @_;
return (ref $array) ? (@$array) : $array;
}
sub create_variables
{
my ($self, $hash) = @_;
my ($package, $key, $value);
$package = $self->_determine_package;
while (($key, $value) = each %$hash) {
my $this = Symbol::qualify_to_ref ($key, $package);
$$$this = $value;
}
}
sub is_error
{
my $self = shift;
if ($self->{error_status}) {
return (1);
} else {
return (0);
}
}
sub get_error_message
{
my $self = shift;
return $self->{error_message} if ($self->{error_message});
}
( run in 0.768 second using v1.01-cache-2.11-cpan-b16cb0d3907 )