CGI-WebIn
view release on metacpan or search on metacpan
Revision history for Perl extension CGI::WebIn.
1.00 Wed Aug 22 22:29:01 2001
- original version; created by h2xs 1.21 with options
-c -v 1.00 -n CGI::WebIn
1.01 Tue Mar 12 19:34:00 2002
- lots of fixes;
- fixed DropCookie() bug.
1.02 Wed Mar 20 22:21:00 2002
- fixed SetCookie(): if expires time is not /[+-]\d+/, it
is the local time stamp (1.01 used bad /[+-]?\d+/ regexp).
- fixed bug with no URLDecode call for usual cookies.
1.03 Tue Apr 2 22:00:00 2002
- improved algorythm of parse {...} constructions: now you may
write A{'aaa\'bbb'} and even A{'aa}bb'}.
- fixed bug with trailing and invalid % in QUERY_STRING:
no vagueness now.
1.10
- Function loading on demand (as in CGI.pm).
- Improved QUERY_STRING parser: test{'aa\'bc'}, test{'a\\b'} etc.
- Error reporting system now silent (GetError() function added).
- Autoarray handling improved: test[]{abc}=xxx, test[-10]
and test[12345678] are bad and generate errors.
2.01 Wed Mar 10 14:50:00 2004
- Removed all function prototypes.
2.02 Mar 9 2006
- Fixed: SetCookie does not work if CGI::WebOut is not present.
2.03 Oct 19 2006
- Fixed: URLEncode() does not encode "=" and "&" characters (and more).
HISTORY/1.01.txt view on Meta::CPAN
=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
From: Prognozov.NET <webmaster@prognozov.net>
To: chicken@dklab.ru <chicken@dklab.ru>
Date: Tuesday, March 12, 2002, 3:27:12 PM
Subject: CGI::WebIn
Files: <none>
-------------------------------------------------------------------------------
Çäðàâñòâóéòå!
Ó ìåíÿ âîïðîñ ïî ìîäóëþ CGI::WebIn:
ïî÷åìó ôóíêöèÿ DropCookie óäàëÿåò òîëüêî ïåðåìåííóþ, à ñàì êóê
îñòàåòñÿ è ÷èòàåòñÿ äðóãèìè ñêðèïòàìè äî äåõ ïîð ïîêà íå èñòå÷åò?
ó ìåíÿ âî âñÿêîì ñëó÷àå ïðèñõîäèò èìåííî òàê.
çàðàíåå áëàãîäàðåí.
--
Best regards,
Prognozov.NET mailto:webmaster@prognozov.net
HISTORY/1.01.txt view on Meta::CPAN
From: Dmitry Koterov <koterov at cpan dot org>
To: Prognozov.NET <webmaster@prognozov.net>
Date: Tuesday, March 12, 2002, 3:43:32 PM
Subject: CGI::WebIn
Files: <none>
-------------------------------------------------------------------------------
Äîáðûé äåíü.
12.03.2002 15:27. Âû íàïèñàëè:
> ïî÷åìó ôóíêöèÿ DropCookie óäàëÿåò òîëüêî ïåðåìåííóþ, à ñàì êóê
> îñòàåòñÿ è ÷èòàåòñÿ äðóãèìè ñêðèïòàìè äî äåõ ïîð ïîêà íå èñòå÷åò?
> ó ìåíÿ âî âñÿêîì ñëó÷àå ïðèñõîäèò èìåííî òàê.
Êðàéíå ñòðàííî. Äåëî â òîì, ÷òî DropCookie ïðîñòî äîëæåí óñòàíàâëèâàòü
âðåìÿ èñòå÷åíèå Cookie 3 ãîäà íàçàä (òî åñòü, â ïðîøëîì), ÷òî ïðèâîäèò
ê óäàëåíèþ Cookie.
Íåóæåëè ýòî íå ðàáîòàåò?.. Íå ìîãëè áû Âû óòî÷íèòü, à åùå ëó÷øå -
ïðèâåñòè ïðèìåð íåáîëüøîãî ñêðèïòà, â êîòîðîì ýòîò ìåõàíèçì íå
ñðàáàòûâàåò?..
Ñ óâàæåíèåì,
Äìèòðèé Êîòåðîâ (dk@dklab.ru), âåäóùèé ïðîãðàììèñò.
Ëàáîðàòîðèÿ dk, http://www.dklab.ru
-------------------------------------------------------------------------------
HISTORY/1.01.txt view on Meta::CPAN
Files: <none>
-------------------------------------------------------------------------------
Hello Dmitry,
âîò ôðàãìåíò:
use CGI::WebOut;
use CGI::WebIn(1);
if(!$ENV{'QUERY_STRING'}) {
SetCookie("test","yes","+10m","/");
print $test; #ïèøåò 'yes'
}else{
DropCookie("test");
print $test; #íå ïèøåò
print $ENV{'HTTP_COOKIE'}; #ïèøåò
}
--
Best regards,
Prognozov.NET mailto:webmaster@prognozov.net
Tuesday, March 12, 2002, 3:43:32 PM, you wrote:
DK> Äîáðûé äåíü.
DK> 12.03.2002 15:27. Âû íàïèñàëè:
>> ïî÷åìó ôóíêöèÿ DropCookie óäàëÿåò òîëüêî ïåðåìåííóþ, à ñàì êóê
>> îñòàåòñÿ è ÷èòàåòñÿ äðóãèìè ñêðèïòàìè äî äåõ ïîð ïîêà íå èñòå÷åò?
>> ó ìåíÿ âî âñÿêîì ñëó÷àå ïðèñõîäèò èìåííî òàê.
DK> Êðàéíå ñòðàííî. Äåëî â òîì, ÷òî DropCookie ïðîñòî äîëæåí óñòàíàâëèâàòü
DK> âðåìÿ èñòå÷åíèå Cookie 3 ãîäà íàçàä (òî åñòü, â ïðîøëîì), ÷òî ïðèâîäèò
DK> ê óäàëåíèþ Cookie.
DK> Íåóæåëè ýòî íå ðàáîòàåò?.. Íå ìîãëè áû Âû óòî÷íèòü, à åùå ëó÷øå -
DK> ïðèâåñòè ïðèìåð íåáîëüøîãî ñêðèïòà, â êîòîðîì ýòîò ìåõàíèçì íå
DK> ñðàáàòûâàåò?..
DK> Ñ óâàæåíèåì,
DK> Äìèòðèé Êîòåðîâ (dk@dklab.ru), âåäóùèé ïðîãðàììèñò.
DK> Ëàáîðàòîðèÿ dk, http://www.dklab.ru
-------------------------------------------------------------------------------
HISTORY/1.01.txt view on Meta::CPAN
Files: <none>
-------------------------------------------------------------------------------
Äîáðûé äåíü.
12.03.2002 16:14. Âû íàïèñàëè:
> print $test; #íå ïèøåò
> print $ENV{'HTTP_COOKIE'}; #ïèøåò
Äà, äåéñòâèòåëüíî, èìåëà ìåñòî îøèáêà. Îêàçûâàåòñÿ, ìîæíî óäàëèòü
Cookie òîëüêî â òîì ñëó÷àå, åñëè ïðè óäàëåíèè óêàçàòü òå æå ïàðàìåòðû
$path è $domain, ÷òî è ïðè óñòàíîâêå. Ñïàñèáî çà Âàøå ïèñüìî.
ß çàêà÷àë íà ñåðâåð íîâóþ âåðñèþ CGI::WebIn (1.01) ñ èñïðàâëåíèÿìè
îøèáîê. Êðîìå òîãî, èìåéòå â âèäó, ÷òî ðàáîòàòü ñ DropCookie() íóæíî
òåïåðü âîò òàê:
#!/usr/bin/perl -w
use CGI::WebOut;
use CGI::WebIn(1);
if(!$ENV{'QUERY_STRING'}) {
SetCookie("test1","yes","+10m","/");
print $test1; #ïèøåò 'yes'
} else {
DropCookie("test1","/"); # íå çàáóäüòå ïðî "/"!!!
print $test1; #íå ïèøåò
print $ENV{'HTTP_COOKIE'}; # ïèøåò
# dk: â ïåðâûé ðàç - äà, ïèøåò, ïîòîìó ÷òî CGI::WebIn
# íå òðîãàåò ïðèøåäøèå ïåðåìåííûå îêðóæåíèÿ. Çàòî ïðè
# ñëåäóþùåì çàïóñêå Cookie óæå áóäåò óäàëåí.
}
Ìîæíî òàêæå è îïóñêàòü ïàðàìåòð $path è òàì, è òàì, íî òîãäà Cookie
áóäåò äåéñòâîâàòü òîëüêî â òåêóùåé äèðåêòîðèè. Ýòî ñîîòâåòñòâóåò
ñòàíäàðòó, îïèñàííîìó â
http://www.citforum.ru/win/internet/html/cookie.shtml
Ñ óâàæåíèåì,
Äìèòðèé Êîòåðîâ (dk@dklab.ru), âåäóùèé ïðîãðàììèñò.
Ëàáîðàòîðèÿ dk, http://www.dklab.ru
-------------------------------------------------------------------------------
HISTORY/1.50.txt view on Meta::CPAN
# * 16.01.2002:
# - Ýêñïîðòèðóåìûå ïåðåìåííûå (íàïðèìåð, $SCRIPT_NAME) áûëè
# íå ñèíîíèìàìè ($ENV{SCRIPT_NAME}), à êîïèÿìè îðèãèíàëîâ, ïîýòîìó
# èçìåíåíèå îðèãèíàëà íå ïðèâîäèëî ê èçìåíåíèþ "ñèíîíèìîâ".
# * 16.01.2002:
# - Âûçîâ SetCookie() íå çàêàí÷èâàëñÿ âûâîäîì ñîîáùåíèÿ îá
# îøèáêå, åñëè âêëþ÷åí ðåæèì Autoflush() - Cookie ïðîñòî íå
# óñòàíàâëèâàëàñü.
# * 02.04.2002:
# - Óëó÷øåí ìåõàíèçì îáðàáîòêè {}-äàííûõ.
# * 02.04.2002:
# - Èñïðàâëåíà íåòî÷íîñòü îáðàáîòêè çàâåðøàþùåãî %
# * 11.07.2002:
# - Äëÿ óïðîùåíèÿ ìîäóëÿ ïðèíÿòî ðåøåíèå îòêàçàòüñÿ îò Ñè-êîäà
# â ôóíêöèÿõ URLEncode/URLDecode è çàìåíèòü èõ íà Perl-êîä.
# * 21.12.2003
# - Èñïðàâëåíà îøèáêà â tempnam(), èç-çà êîòîðîé íåëüçÿ áûëî
SYNOPSIS
use CGI::WebOut;
use CGI::WebIn;
use Data::Dumper;
print "<pre>".Dumper(\%IN)."</pre>";
DEPENDENCIES
This module may use CGI::WebOut to better handle of SetCookie method.
COPYRIGHT AND LICENCE
COPYRIGHT AND LICENCE
Copyright (C) Dmitry Koterov <koterov at cpan dot org>
http://www.dklab.ru/chicken/6.html
# 5. Ïîääåðæêà undef â Serialize + ïðåäóïðåæäåíèÿ.
package CGI::WebIn;
use strict;
our $VERSION = '2.03';
our @EXPORT=qw(
%IN
%GET
%POST
%COOKIES
SetCookie
DropCookie
);
####################### Êîíñòàíòû, óïðàâëÿþùèå ðàáîòîé #####################
our $CANUPL_FILE = ".can_upload"; # èìÿ ôàéëà, ðàçðåøàþùåãî çàêà÷êó
our $MULTICHUNK_SIZE = 20000; # äëèíà áëîêà ñ÷èòûâàíèÿ STDIN-à
our $MAX_ARRAY_IDX = 10000; # ìàêñèìàëüíî âîçìîæíûé èíäåêñ N â a[N]
our $uniq_tempnam = 0; # temp files counter
our @TempFiles = (); # all temp files (to delete after end)
our @Errors = (); # all query parsing errors
# â êà÷åñòâå êîíñòàíò. Ëó÷øå âñåãî èõ íèêîãäà íå òðîãàòü. Ýòè êîíñòàíòû
# äîëæíû ñîñòîÿòü èç îäíîãî ñèìâîëà!
our $Div1 = "."; # ALWAYS should be one nondigit!!!
our $Div2 = "."; # may be the same as $Div1
####################### Ïðåðåìåííûå ñ äàííûìè áðàóçåðà #####################
our %IN = (); # Äàííûå ôîðìû
our %GET = (); # Äàííûå GET
our %POST = (); # Äàííûå POST
our %COOKIES = (); # Âñå ïðèøåäøèå Cookies
our %IMPORT_MOD = (); # Ìîäóëè, çàòðåáîâàâøèå èìïîðò ïåðåìåííûõ (êëþ÷è)
# void _reparseAll()
# Parses all the input data.
sub _reparseAll {
if($ENV{QUERY_STRING}) {
_parseURLEnc($ENV{QUERY_STRING},"get");
}
if(uc($ENV{REQUEST_METHOD}) eq "POST") {
if(exists($ENV{'CONTENT_TYPE'}) && $ENV{'CONTENT_TYPE'}=~m|^\s*multipart/form-data|i) {
_parseMultipart();
} else {
read(STDIN,my $data,$ENV{CONTENT_LENGTH});
_parseURLEnc($data,"post");
}
}
if($ENV{HTTP_COOKIE} || $ENV{COOKIE}) {
_parseCookies();
}
# use Data::Dumper; print "<pre>".Dumper(\%IN)."</pre>";
}
# void import(...)
# Called on 'use'.
sub import
{ my ($pkg, $opt)=@_;
my $caller = caller();
if(!scalar(@_)) {
# Âûçîâ áåç ïàðàìåòðîâ - îáîéòè è ýêñïîðòèðîâàòü âî âñå ìîäóëè-êëèåíòû
while(my ($mod,$opt)=each(%IMPORT_MOD)) {
export_vars($opt,$mod);
}
} else {
# Âûçîâ ñ ïàðàìåòðàìè - ýêñïîðò ïåðåìåííûõ òîëüêî â óêàêçàííûé ìîäóëü
return if !$opt;
$opt="gpces" if lc($opt) eq "a" || $opt eq "1";
# Ñîõðàíÿåì èíôîðìàöèþ î òîì, ÷òî ìîäóëü "õî÷åò" ýêñïîðòèðîâàíèÿ è
# â äàëüíåéøåì. Íàïðèìåð, ïðè âûçîâå SetCookie() ñîîòâåòñòâóþùàÿ
# ïåðåìåííàÿ ñîçäàñòñÿ íå òîëüêî â %COOKIES, íî è âî âñåõ ìîäóëÿõ.
$IMPORT_MOD{$to}=$opt;
# Ýêñïîðòèðóåì åùå íå ñóùåñòâóþùèå ïåðåìåííûå
no strict;
my $Bad=\%{$to."::"};
foreach my $op (split //,$opt) {
$op=lc($op);
my $Hash =
$op eq "g" && \%GET ||
$op eq "p" && \%POST ||
$hash{size}=-s $temp;
$hash{type}=$Headers{'content-type'} if $Headers{'content-type'};
}
# Äîáàâëÿåì ïàðàìåòð.
_processPar($name,\%hash,"post");
}
}
END_OF_FUNC
'_parseCookies' => <<'END_OF_FUNC',
# Ðàçáèðàåò ïðèøåäøèå cookies
sub _parseCookies
{ my @Pairs = split("; *",$ENV{HTTP_COOKIE} || $ENV{COOKIE} || "");
foreach (@Pairs) {
my ($key,$value);
if(/^([^=]+)=(.*)/) { $key = $1; $value = $2; } else { $key = $_; $value = ''; }
$key=URLDecode($key);
$value=URLDecode($value);
my $v=Unserialize($value);
$value=defined($v)?$v:$value;
_processPar($key,$value,"cookie");
}
$time = ExpireCalc($time); return $time unless $time =~ /^\d+$/;
# cookies use '-' as date separator, HTTP uses ' '
my($sc) = ' '; $sc = '-' if $format eq "cookie";
my($sec,$min,$hour,$mday,$mon,$year,$wday) = gmtime($time);
return sprintf("%s, %02d$sc%s$sc%04d %02d:%02d:%02d GMT",
$WDAY[$wday],$mday,$MON[$mon],$year+1900,$hour,$min,$sec);
}
END_OF_FUNC
'SetCookie' => <<'END_OF_FUNC',
# void SetCookie(string $name, string $value [,int $expire][,$path][,$domain][bool $secure])
# Óñòàíàâëèâàåò cookie ñ èìåíåì $name è çíà÷åíèå $value ($value ìîæåò áûòü ñëîæíûì îáúåêòîì
# - â ÷àñòíîñòè, ññûëêîé íà ìàññèâ èëè õýø).
# Åñëè $value íå çàäàí (undef), cookie óäàëÿåòñÿ.
# Åñëè $expire íå çàäàí, âðåìÿ æèçíè ñòàíîâèòñÿ áåñêîíå÷íûì. Åñëè çàäàí, íî ðàâåí
# íóëþ - ñîçäàåòñÿ one-session cookie.
# Ïàðàìåòð $expire ìîæíî çàäàâàòü â âèäå, êîòîðûé "ïîíèìàåò" ôóíêöèÿ ExpireCalc().
sub SetCookie
{ my ($name,$value,$expires,$path,$domain,$secure)=@_;
my $NeedDel=0;
# [12.03.2002] Ìîæíî è áåç ýòîãî.
# if(!defined $path) {
# $path=$ENV{SCRIPT_NAME};
# $path=~s{/[^/]*$}{}sg;
# $path.="/";
# }
if(!defined $expires) { $expires="+20y"; }
if(!defined $value) { $value=""; $expires="-3y"; $NeedDel=1; }
my @Param;
push(@Param,URLEncode($name)."=".URLEncode(Serialize($value)));
push(@Param,"domain=$domain") if defined $domain;
push(@Param,"path=$path") if defined $path;
push(@Param,"expires=".Expires($expires,"cookie")) if $expires;
push(@Param,'secure') if $secure;
my $cook="Set-Cookie: ".join("; ",@Param);
eval {
local ($SIG{__WARN__},$SIG{__DIE__})=(sub {}, sub {});
require CGI::WebOut;
};
if($@) {
# Åñëè íå âûøëî çàãðóçèòü CGI::WebOut, òî ïðîñòî ïå÷àòàåì.
print $cook . "\r\n";
} else {
CGI::WebOut::Header($cook);
}
if(!$NeedDel) { _processPar($name,$value,"cookie"); }
else { _processPar($name,undef,"cookie"); }
# Ýêñïîðòèðóåì Cookie âî âñå íóæíûå ìîäóëè
export_vars();
}
END_OF_FUNC
'DropCookie' => <<'END_OF_FUNC',
# void DropCookie(string $name [,$path] [,$domain])
# Óäàëÿåò cookie ñ èìåíåì $name. Ïàðàìåòðû $path è $domain
# äîëæíû òî÷íî ñîâïàäàòü ñ òåìè, êîòîðûå áûëè çàäàíû ïðè
# óñòàíîâêå Cookie.
sub DropCookie
{ my ($name,$path,$domain)=@_;
SetCookie($name,undef,undef,$path,$domain);
}
END_OF_FUNC
'Serialize' => <<'END_OF_FUNC',
# string Serialize(mixed @args)
# Óïàêîâûâàåò â ñòðîêó ëþáîé (ïðàêòè÷åñêè) îáúåêò. Òàê ÷òî íå îáÿçàòåëüíî ïåðåäàâàòü
# ýòîé ôóíêöèè ññûëêó - ìîæíî ïðÿìî îáúåêò öåëèêîì.
# ( ýòîì ñëó÷àå îí áóäåò ðàññìîòðåí êàê ñïèñîê).
# Íåëüçÿ óïàêîâûâàòü îáúåêòû, ñîäåðæàùèå ññûëêè íà ôóíêöèè è äåñêðèïòîðû ôàéëîâ.
=head1 SYNOPSIS
use CGI::WebOut;
use CGI::WebIn(1);
# just to avoid "typo warning"
our ($doGo,%Address,$Count);
# count visits
SetCookie("Count",++$Count,"+10y");
# is the button pressed?
if($doGo) {
print "Hello from $Address{Russia}{Moscow}!";
}
print <<EOT;
You have visited this page $Count times.
<form action=$SCRIPT_NAME method=post enctype=multipart/form-data>
<input type=text name="Address{Russia}{Moscow}" value="house">
=head1 OVERVIEW
This module is used to make CGI programmer's work more comfortable.
The main idea is to handle input stream (C<STDIN>) and C<QUERY_STRING>
environment variable sent by browser and parse their correctly
(including multipart forms). Resulting variables are put to C<%GET>,
C<%POST>, C<%COOKIES> and C<%IN> (C<%IN> holds ALL the data). Also
allows you to get/set cookies (any structure, not only scalars!) with
C<SetCookie()> subroutine.
If this module is included without any arguments:
use CGI::WebIn;
it exports the following: C<%IN>, C<%GET>, C<%POST>, C<%COOKIES>,
C<SetCookie()> and C<DropCookie()>
You can specify additional information to be exported by using
include arguments:
use CGI::WebIn 'gpce';
means that all the GET, POST, Cookies and then environment
variables will be exported to "usual" package variables.
You must not be afraid to write everywhere C<'gpce'> - the
following instruction does the same:
use CGI::WebIn 'gpce';
=head1 DESCRIPTION
=over 6
=item C<use CGI::WebIn(1)>
Reads all the CGI input and exports it to the caller module
(like PHP does).
=item C<%IN, %GET, %POST and %COOKIES>
C<%IN> contains all the form data. C<%GET>, C<%POST> and C<%COOKIES>
holds GET, POST and Cookies variables respectively.
=item C<void SetCookie($name, $value [,int $expire][,$path][,$domain][bool $secure])>
Sets the cookie in user browser. Value of that cookie is placed to C<%COOKIES>
and ALL exported client modules immediately. Format for time C<$expire> can be
in any of the forms:
<stamp> - UNIX timestamp
0 - one-session cookie
undef - drop this cookie
"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(!)
=item C<void DropCookie(string $name [,string $path] [,string $domain])>
Destroys the specified cookie. Make sure the C<$path> and C<$domain> parameters are
the same to previous C<SetCookie()> call.
=item C<list of string CGI::WebIn::GetErrors()>
While parsing the form input data errors may appear. For example, these
QUERY_STRINGs are invalid:
test[-10]=abc
test[123456789]=123
test{1}=a&test[1]=100
( run in 1.133 second using v1.01-cache-2.11-cpan-e9199f4ba4c )