CGI-Easy
view release on metacpan or search on metacpan
This object is also very simple hash - keys are HTTP header names and
values are HTTP header values. When you call new() this hash
populated with few headers (notably 'Status'=>'200 OK' and
'Content-Type'=>'text/html; charset=utf-8'), but you're free to
change these keys/headers and add your own headers. When you ready to
output all headers from this object/hash you should call compose()
method, and it will return string with all HTTP headers suitable for
sending to browser.
There one exception: value for key 'Set-Cookie' is ARRAYREF with
HASHREF, where each HASHREF keep cookie details:
$h->{'Set-Cookie'} = [
{ name=>'mycookie1', value=>'myvalue1' },
{ name=>'x', value=>5,
domain=>'.example.com', expires=>time+86400 }
];
To make it ease for you to work with this key there helper
add_cookie() method available, but you're free to modify this key
manually if you like.
There also some helper methods in this object (like redirect()), but
CGI::Easy::Session object
This object make working with cookies even more ease than already
provided by CGI::Easy::Request and CGI::Easy::Headers way:
my $somevalue = $r->{cookie}{somename};
$h->add_cookie({ name => 'somename', value => $somename });
If you will use CGI::Easy::Session, then it will read/write values
for three cookies: sid, perm and temp. Cookie sid will contain
automatically generated ID unique to this visitor, cookies perm and
temp will contain simple perl hashes (automatically serialized to
strings for storing in cookies) with different lifetime: perm will
expire in 1 year, temp will expire when browser closes.
CGI::Easy::Session object will provide you with three keys:
id undef OR '…unique string…'
perm { x=>5, somename=>'somevalue', … }
temp { y=>7, … }
lib/CGI/Easy.pm view on Meta::CPAN
This object is also very simple hash - keys are HTTP header names and
values are HTTP header values. When you call new() this hash populated
with few headers (notably C<< 'Status'=>'200 OK' >> and
C<< 'Content-Type'=>'text/html; charset=utf-8' >>), but you're free to
change these keys/headers and add your own headers. When you ready to
output all headers from this object/hash you should call compose() method,
and it will return string with all HTTP headers suitable for sending to
browser.
There one exception: value for key 'Set-Cookie' is ARRAYREF with HASHREF,
where each HASHREF keep cookie details:
$h->{'Set-Cookie'} = [
{ name=>'mycookie1', value=>'myvalue1' },
{ name=>'x', value=>5,
domain=>'.example.com', expires=>time+86400 }
];
To make it ease for you to work with this key there helper add_cookie()
method available, but you're free to modify this key manually if you like.
There also some helper methods in this object (like redirect()), but they
all just modify some keys/headers in this hash.
=item CGI::Easy::Session object
This object make working with cookies even more ease than already provided
by CGI::Easy::Request and CGI::Easy::Headers way:
my $somevalue = $r->{cookie}{somename};
$h->add_cookie({ name => 'somename', value => $somename });
If you will use CGI::Easy::Session, then it will read/write values for
three cookies: C<sid>, C<perm> and C<temp>. Cookie C<sid> will contain
automatically generated ID unique to this visitor, cookies C<perm> and
C<temp> will contain simple perl hashes (automatically serialized to
strings for storing in cookies) with different lifetime: C<perm> will
expire in 1 year, C<temp> will expire when browser closes.
CGI::Easy::Session object will provide you with three keys:
id undef OR '…unique string…'
perm { x=>5, somename=>'somevalue', … }
temp { y=>7, … }
lib/CGI/Easy/Headers.pm view on Meta::CPAN
use CGI::Easy::Util qw( date_http make_cookie );
sub new {
my ($class, $opt) = @_;
my $self = {
'Status' => '200 OK',
'Content-Type' => 'text/html; charset=utf-8',
'Date' => q{},
'Set-Cookie' => [],
$opt ? %{$opt} : (),
};
return bless $self, $class;
}
sub add_cookie {
my ($self, @cookies) = @_;
push @{ $self->{'Set-Cookie'} }, @cookies;
return;
}
sub redirect {
my ($self, $url, $status) = @_;
$self->{'Location'} = $url;
if (!defined $status) {
$status = '302 Found';
}
$self->{'Status'} = $status;
lib/CGI/Easy/Headers.pm view on Meta::CPAN
croak "Bad header name '$header' (should be '$expect')";
}
}
my $s = sprintf "Status: %s\r\n", delete $h{'Status'};
$s .= sprintf "Content-Type: %s\r\n", delete $h{'Content-Type'};
my $date = delete $h{'Date'};
if (defined $date) {
$s .= sprintf "Date: %s\r\n", $date || date_http(time);
}
for my $cookie (@{ delete $h{'Set-Cookie'} }) {
$s .= make_cookie($cookie);
}
for my $header (keys %h) {
if (!ref $h{$header}) {
$h{$header} = [ $h{$header} ];
}
for my $value (@{ $h{$header} }) {
$s .= sprintf "%s: %s\r\n", $header, $value;
}
}
lib/CGI/Easy/Headers.pm view on Meta::CPAN
=head2 new
$h = CGI::Easy::Headers->new();
$h = CGI::Easy::Headers->new( \%headers );
Create new CGI::Easy::Headers object/hash with these fields:
'Status' => '200 OK',
'Content-Type' => 'text/html; charset=utf-8',
'Date' => q{},
'Set-Cookie' => [],
If %headers given, it will be appended to default keys and so may
overwrite default values.
See compose() below about special values in 'Date' and 'Set-Cookie' fields.
While you're free to add/modify/delete any fields in this object/hash,
HTTP headers is case-insensitive, and thus it's possible to accidentally
create different keys in this hash for same HTTP header:
$h->{'Content-Type'} = 'text/plain';
$h->{'content-type'} = 'image/png';
To protect against this, compose() allow only keys named in 'Content-Type'
way and will throw exception if it found keys named in other way. There
lib/CGI/Easy/Headers.pm view on Meta::CPAN
Return created CGI::Easy::Headers object.
=head2 add_cookie
$h->add_cookie( \%cookie );
$h->add_cookie( \%cookie1, \%cookie2, ... );
Add new cookies to current HTTP headers. Actually it's just do this:
push @{ $h->{'Set-Cookie'} }, \%cookie, ...;
Possible keys in %cookie:
name REQUIRED STRING
value OPTIONAL STRING (default "")
domain OPTIONAL STRING (default "")
path OPTIONAL STRING (default "/")
expires OPTIONAL STRING or SECONDS
secure OPTIONAL BOOL
lib/CGI/Easy/Headers.pm view on Meta::CPAN
=item Date
You can set it to usual string (like 'Sat, 01 Jan 2000 00:00:00 GMT')
or to unixtime in seconds (as returned by time()) - in later case time
in seconds will be automatically converted to string with date/time.
If it set to empty string (new() will initially set it this way),
then current date/time will be automatically used.
=item Set-Cookie
This field must be ARRAYREF (new() will initially set it to []), and
instead of strings must contain HASHREF with cookie properties (see
add_cookie() above).
=back
Return string with HTTP headers ending with empty line.
Throw exception on keys named with wrong case (see new() about details).
lib/CGI/Easy/Request.pm view on Meta::CPAN
=item {cookie}
Will contain hash with cookie names and values. Example:
cookie => {
some_cookie => 'some value',
other_cookie => 'other value',
}
Cookie names and values will be decoded from UTF8 to Unicode unless
new() called with option C<< raw=>1 >>.
=item {REMOTE_ADDR}
=item {REMOTE_PORT}
User's IP and port.
You may need to use C<< frontend_prefix >> option if you've frontend and
backend web servers.
lib/CGI/Easy/Session.pm view on Meta::CPAN
}
$self->{perm} = unquote_hash($c->{perm}) || {};
$self->{temp} = unquote_hash($c->{temp}) || {};
return;
}
sub save {
my ($self) = @_;
my $h = $self->{_h};
my @other_cookies = grep {$_->{name} ne 'perm' && $_->{name} ne 'temp'}
@{ $h->{'Set-Cookie'} };
$h->{'Set-Cookie'} = [
@other_cookies,
{
name => 'perm',
value => quote_list(%{ $self->{perm} }),
expires => time + SESSION_EXPIRE,
},
{
name => 'temp',
value => quote_list(%{ $self->{temp} }),
},
lib/CGI/Easy/Session.pm view on Meta::CPAN
temp HASHREF (simple hash with scalar-only values)
You can both read existing session data in {perm} and {temp} and
add/update new data there, but keep in mind overall cookie size is limited
(usual limit is few kilobytes and it differ between browsers).
After changing {perm} or {temp} don't forget to call save().
Complex data structures in {perm} and {temp} doesn't supported (you can
manually pack/unpack them using any data serialization tool).
Will set cookie "sid" (with session ID) in 'Set-Cookie' header, which will
expire in 1 YEAR after last visit.
Return created CGI::Easy::Session object.
=head2 save
$sess->save();
Set/update 'Set-Cookie' header with current {perm} and {temp} values.
Should be called before sending reply to user (with C<< $h->compose() >>)
if {perm} or {temp} was modified.
Cookie "perm" (with hash {perm} data) will expire in 1 YEAR after last visit.
Cookie "temp" (with hash {temp} data) will expire when browser will be closed.
Return nothing.
=head1 SUPPORT
=head2 Bugs / Feature Requests
Please report any bugs or feature requests through the issue tracker
at L<https://github.com/powerman/perl-CGI-Easy/issues>.
lib/CGI/Easy/Util.pm view on Meta::CPAN
sub make_cookie :Export {
my ($opt) = @_;
return q{} if !defined $opt->{name};
my $name = $opt->{name};
my $value = defined $opt->{value} ? $opt->{value} : q{};
my $domain = $opt->{domain};
my $path = defined $opt->{path} ? $opt->{path} : q{/}; # IE require it
my $expires = defined $opt->{expires} && $opt->{expires} =~ /\A\d+\z/xms ?
date_cookie($opt->{expires}) : $opt->{expires};
my $set_cookie = 'Set-Cookie: ';
$set_cookie .= uri_escape_utf8($name) . q{=} . uri_escape_utf8($value);
$set_cookie .= "; domain=$domain" if defined $domain; ## no critic(ProhibitPostfixControls)
$set_cookie .= "; path=$path";
$set_cookie .= "; expires=$expires" if defined $expires;## no critic(ProhibitPostfixControls)
$set_cookie .= '; secure' if $opt->{secure}; ## no critic(ProhibitPostfixControls)
$set_cookie .= "\r\n";
return $set_cookie;
}
sub uri_unescape_plus :Export {
lib/CGI/Easy/Util.pm view on Meta::CPAN
This document describes CGI::Easy::Util version v2.0.1
=head1 SYNOPSIS
use CGI::Easy::Util qw( date_http date_cookie make_cookie );
my $mtime = (stat '/some/file')[9];
printf "Last-Modified: %s\r\n", date_http($mtime);
printf "Set-Cookie: a=5; expires=%s\r\n", date_cookie(time+86400);
printf make_cookie({ name=>'a', value=>5, expires=>time+86400 });
use CGI::Easy::Util qw( uri_unescape_plus
burst_urlencoded burst_multipart );
my $s = uri_unescape_plus('a+b%20c'); # $s is 'a b c'
my %param = %{ burst_urlencoded($ENV{QUERY_STRING}) };
lib/CGI/Easy/Util.pm view on Meta::CPAN
Convert given time into text format suitable for sending in HTTP headers.
Return date string.
=head2 date_cookie
$date = date_cookie( $seconds );
Convert given time into text format suitable for sending in HTTP header
Set-Cookie's "expires" option.
Return date string.
=head2 make_cookie
$header = make_cookie( \%cookie );
Convert HASHREF with cookie properties to "Set-Cookie: ..." HTTP header.
Possible keys in %cookie:
name REQUIRED STRING
value OPTIONAL STRING (default "")
domain OPTIONAL STRING (default "")
path OPTIONAL STRING (default "/")
expires OPTIONAL STRING or SECONDS
secure OPTIONAL BOOL
t/examples.t view on Meta::CPAN
######################
# CGI::Easy/SYNOPSIS #
######################
ok 1, '----- CGI::Easy/SYNOPSIS';
###############################
setup_request('https', <<'EOF');
GET /index.php?name=powerman&color[]=red&color%5B%5D=green HTTP/1.0
Host: example.com
Cookie: some=123
EOF
ok 1, '--- access basic GET request details';
my $url = "$r->{scheme}://$r->{host}:$r->{port}$r->{path}";
my $param_name = $r->{GET}{name};
my @param_color = @{ $r->{GET}{'color[]'} };
my $cookie_some = $r->{cookie}{some};
is $url, 'https://example.com:80/index.php', 'scheme/host/port/path';
is $param_name, 'powerman', 'GET scalar';
t/examples.t view on Meta::CPAN
my $avatar_filename = $r->{filename}{avatar};
my $avatar_mimetype = $r->{mimetype}{avatar};
is $avatar_image, "PNG\r\nIMAGE\r\nHERE", 'POST file content';
is $avatar_filename, 'C:\\images\\avatar.png', 'POST file filename';
is $avatar_mimetype, 'image/png', 'POST file mimetype';
###############################
setup_request('http', <<"EOF");
GET / HTTP/1.0
Host: example.com
Cookie: temp=${\uri_escape('a 0 x 5 b 1')}; perm=${\uri_escape("name 'John Smith' y 7")}
EOF
ok 1, '--- easy way to identify visitors and get data stored in cookies';
my $session_id = $sess->{id};
my $tempcookie_x= $sess->{temp}{x};
my $permcookie_y= $sess->{perm}{y};
ok defined $session_id && length $session_id, 'session id';
is $tempcookie_x, 5, 'session temp';
is $permcookie_y, 7, 'session perm';
t/examples.t view on Meta::CPAN
name => 'some',
value => 'custom cookie',
domain => '.example.com',
expires => time+86400,
});
my $headers = $h->compose();
@hdr = split /\r\n/, $headers;
is $hdr[0], 'Status: 200 OK', 'Status:';
is $hdr[1], 'Content-Type: text/html; charset=utf-8', 'Content-Type:';
like $hdr[2], qr/\ADate: \w\w\w, \d\d \w\w\w 20\d\d \d\d:\d\d:\d\d GMT\z/, 'Date:';
like $hdr[3], qr/\ASet-Cookie: sid=/, 'Set=Cookie: sid';
like $hdr[4], qr/\ASet-Cookie: some=custom%20cookie; /, 'Set=Cookie: some';
is $hdr[5], 'Expires: Sat, 01 Jan 2000 00:00:00 GMT', 'Expires:';
is $#hdr, 5, '(no more headers)';
like $headers, qr/\r\n\r\n\z/, 'headers end with empty hdr';
###############################
setup_request('http', <<'EOF');
GET / HTTP/1.0
Host: example.com
EOF
ok 1, '--- easy way to store data in cookies';
$sess->{temp}{x} = 'until browser closes';
$sess->{perm}{y} = 'for 1 year';
$sess->save();
@hdr = split /\r\n/, $h->compose();
is $hdr[0], 'Status: 200 OK', 'Status:';
is $hdr[1], 'Content-Type: text/html; charset=utf-8', 'Content-Type:';
like $hdr[2], qr/\ADate: /, 'Date:';
like $hdr[3], qr/\ASet-Cookie: sid=/, 'Set=Cookie: sid';
like $hdr[4], qr/\ASet-Cookie: perm=${\uri_escape("y 'for 1 year'")}; .*; expires=/,
'Set=Cookie: perm';
like $hdr[5], qr/\ASet-Cookie: temp=${\uri_escape("x 'until browser closes'")}; path=\//,
'Set=Cookie: temp';
is $#hdr, 5, '(no more headers)';
###############################
setup_request('http', <<'EOF');
GET / HTTP/1.0
Host: example.com
EOF
$h->redirect('http://example.com/');
ok 1, '--- output redirect';
@hdr = split /\r\n/, $h->compose();
is $hdr[0], 'Status: 302 Found', 'Status:';
is $hdr[1], 'Content-Type: text/html; charset=utf-8', 'Content-Type:'; # TODO?
like $hdr[2], qr/\ADate: /, 'Date:';
like $hdr[3], qr/\ASet-Cookie: sid=/, 'Set=Cookie: sid';
is $hdr[4], 'Location: http://example.com/', 'Location:';
is $#hdr, 4, '(no more headers)';
###############################
setup_request('http', <<'EOF');
GET / HTTP/1.0
Host: example.com
EOF
ok 1, '--- output custom reply';
$h->{Status} = '500 Internal Server Error';
$h->{'Content-Type'} = 'text/plain; charset=utf-8';
@hdr = split /\r\n/, $h->compose();
is $hdr[0], 'Status: 500 Internal Server Error', 'Status:';
is $hdr[1], 'Content-Type: text/plain; charset=utf-8', 'Content-Type:';
like $hdr[2], qr/\ADate: /, 'Date:';
like $hdr[3], qr/\ASet-Cookie: sid=/, 'Set=Cookie: sid';
is $#hdr, 3, '(no more headers)';
#########################
# CGI::Easy/DESCRIPTION #
#########################
ok 1, '----- CGI::Easy/DESCRIPTION';
###############################
setup_request('http', <<"EOF");
GET /?name=powerman&color[]=red&color[]=green HTTP/1.0
Host: example.com
Cookie: somevar=someval
Authorization: Basic ${\encode_base64('powerman:secret')}
EOF
my $wait_r = {
# -- URL info
scheme => 'http',
host => 'example.com',
port => 80,
path => '/',
# -- CGI parameters
t/examples.t view on Meta::CPAN
error => q{},
};
is_deeply $r, $wait_r, 'CGI::Easy::Request object';
###############################
setup_request('http', <<'EOF');
GET / HTTP/1.0
Host: example.com
EOF
$h->{'Set-Cookie'} = [
{ name=>'mycookie1', value=>'myvalue1' },
{ name=>'x', value=>5,
domain=>'.example.com', expires=>time+86400 }
];
@hdr = split /\r\n/, $h->compose();
is $hdr[0], 'Status: 200 OK', 'Status:';
is $hdr[1], 'Content-Type: text/html; charset=utf-8', 'Content-Type:';
like $hdr[2], qr/\ADate: /, 'Date:';
like $hdr[3], qr/\ASet-Cookie: mycookie1=myvalue1; path=\/\z/,
'Set=Cookie: mycookie1';
like $hdr[4], qr/\ASet-Cookie: x=5; domain=\.example\.com; path=\/; expires=/,
'Set=Cookie: x';
is $#hdr, 4, '(no more headers)';
###############################
setup_request('http', <<'EOF');
GET / HTTP/1.0
Host: example.com
Referer: http://example.com/
EOF
ok !defined $sess->{id}, 'no cookie support';
###############################
setup_request('http', <<"EOF");
GET / HTTP/1.0
Host: example.com
Cookie: temp=${\uri_escape('y 5')}
EOF
ok defined $sess->{id}, 'cookie supported';
$sess->{perm}{x} = 5;
$sess->{perm}{somename} = 'somevalue';
$sess->{temp}{y}++;
$sess->save();
@hdr = split /\r\n/, $h->compose();
is $hdr[0], 'Status: 200 OK', 'Status:';
is $hdr[1], 'Content-Type: text/html; charset=utf-8', 'Content-Type:';
like $hdr[2], qr/\ADate: /, 'Date:';
like $hdr[3], qr/\ASet-Cookie: sid=/, 'Set=Cookie: sid';
like $hdr[4], qr/\ASet-Cookie: perm=(?:somename%20somevalue%20x%205|x%205%20somename%20somevalue); .*; expires=/,
'Set=Cookie: perm';
like $hdr[5], qr/\ASet-Cookie: temp=y%206; path=\//, 'Set=Cookie: temp';
is $#hdr, 5, '(no more headers)';
t/request.t view on Meta::CPAN
EOF
setup_request({}, 'http', $REQUEST);
is_deeply $r->{GET}, {greet=>$hi_str}, 'Unicode param value';
setup_request({raw=>1}, 'http', $REQUEST);
is_deeply $r->{GET}, {greet=>$hi_bin}, 'raw param value';
$REQUEST = <<"EOF";
GET /?${\uri_escape($hi_bin)}=greet HTTP/1.0
Host: example.com
Cookie: greet=${\uri_escape($hi_bin)}; ${\uri_escape($hi_bin)}=greet
EOF
setup_request({}, 'http', $REQUEST);
is_deeply $r->{GET}, {$hi_str=>'greet'}, 'Unicode param name';
is $r->{cookie}{greet}, $hi_str, 'Unicode cookie value';
is $r->{cookie}{$hi_str}, 'greet', 'Unicode cookie name';
setup_request({raw=>1}, 'http', $REQUEST);
is_deeply $r->{GET}, {$hi_bin=>'greet'}, 'raw param name';
is $r->{cookie}{greet}, $hi_bin, 'raw cookie value';
is $r->{cookie}{$hi_bin}, 'greet', 'raw cookie name';
( run in 1.250 second using v1.01-cache-2.11-cpan-e9199f4ba4c )