Provided by: libcgi-tiny-perl_1.002-2_all 
NAME
CGI::Tiny::Cookbook - Recipes for advanced CGI::Tiny usage
DESCRIPTION
CGI::Tiny is a minimal interface to the CGI protocol, but common tasks can be simplified
with the use of other CPAN modules and techniques.
RECIPES
Dependencies
CGI scripts which have dependencies, including CGI::Tiny itself, must be run using the
perl which those dependencies have been installed to, and with access to any nonstandard
library installation locations (such as local::lib or Carton).
Since CGI scripts run in the CGI server's environment, which is usually different from
your user's environment, this means that:
• The CGI script shebang should be an absolute path to the appropriate perl executable.
#!/usr/bin/perl
#!/opt/perl/bin/perl
#!/home/youruser/perl5/perlbrew/perls/perl-5.34.0/bin/perl
• Nonstandard library locations where dependencies are installed must either be added to
the "PERL5LIB" environment variable in the CGI server's environment, or added within
the CGI script such as with lib or lib::relative.
# Apache
SetEnv PERL5LIB /home/youruser/perl5/lib/perl5
# Within CGI script
use lib '/home/youruser/perl5/lib/perl5';
# Relative to CGI script
use lib::relative 'local/lib/perl5';
Fatpacking
App::FatPacker can be used to pack CGI::Tiny, as well as any other pure-perl dependencies,
into a CGI script so that it can be deployed to other systems without having to install
the dependencies there. As a bonus, this means the script doesn't have to load those
modules separately from disk on every execution.
Just keep in mind that the script will have to be repacked to update those dependencies,
and CGI scripts greatly benefit from efficient XS tools which cannot be packed this way.
$ fatpack pack script.source.cgi > script.cgi
To pack in optional modules, such as JSON support for Perls older than 5.14:
$ fatpack trace --use=JSON::PP script.source.cgi
$ fatpack packlists-for $(cat fatpacker.trace) > packlists
$ fatpack tree $(cat packlists)
$ fatpack file script.source.cgi > script.cgi
JSON
CGI::Tiny has built in support for parsing and rendering JSON content with JSON::PP. CGI
scripts that deal with JSON content will greatly benefit from installing Cpanel::JSON::XS
version 4.09 or newer for efficient encoding and decoding, which will be used
automatically if available.
Templating
HTML and XML responses are most easily managed with templating. A number of CPAN modules
provide this capability.
Text::Xslate is an efficient template engine designed for HTML/XML with built-in disk
caching.
#!/usr/bin/perl
use strict;
use warnings;
use utf8;
use CGI::Tiny;
use Text::Xslate;
use Data::Section::Simple 'get_data_section';
cgi {
my $cgi = $_;
# from templates/
my $tx = Text::Xslate->new(path => ['templates']);
# or from __DATA__
my $tx = Text::Xslate->new(path => [get_data_section]);
my $foo = $cgi->query_param('foo');
$cgi->render(html => $tx->render('index.tx', {foo => $foo}));
};
__DATA__
@@ index.tx
<html><body><h1><: $foo :></h1></body></html>
Mojo::Template is a lightweight HTML/XML template engine in the Mojo toolkit.
#!/usr/bin/perl
use strict;
use warnings;
use utf8;
use CGI::Tiny;
use Mojo::Template;
use Mojo::File 'curfile';
use Mojo::Loader 'data_section';
cgi {
my $cgi = $_;
my $mt = Mojo::Template->new(auto_escape => 1, vars => 1);
my $foo = $cgi->query_param('foo');
# from templates/
my $template_path = curfile->sibling('templates', 'index.html.ep');
my $output = $mt->render_file($template_path, {foo => $foo});
# or from __DATA__
my $template = data_section __PACKAGE__, 'index.html.ep';
my $output = $mt->render($template, {foo => $foo});
$cgi->render(html => $output);
};
__DATA__
@@ index.html.ep
<html><body><h1><%= $foo %></h1></body></html>
Files
Modules like Path::Tiny and MIME::Types can help with file responses. Be aware that Perl
and some operating systems work with filenames in encoded bytes (usually UTF-8), but this
module works with parameters in Unicode characters, so non-ASCII filenames make things
trickier.
#!/usr/bin/perl
use strict;
use warnings;
use utf8;
use CGI::Tiny;
use Path::Tiny;
use MIME::Types;
use Unicode::UTF8 qw(encode_utf8 decode_utf8);
cgi {
my $cgi = $_;
my $filename = $cgi->query_param('filename');
unless (length $filename) {
$cgi->set_response_status(404)->render(text => 'Not Found');
exit;
}
# get files from public/ next to cgi-bin/
my $public_dir = path(__FILE__)->realpath->parent->sibling('public');
my $encoded_filename = encode_utf8 $filename;
my $filepath = $public_dir->child($encoded_filename);
# ensure file exists, is readable, and is not a directory
unless (-r $filepath and !-d _) {
$cgi->set_response_status(404)->render(text => 'Not Found');
exit;
}
# ensure file path doesn't escape the public/ directory
unless ($public_dir->subsumes($filepath->realpath)) {
$cgi->set_response_status(404)->render(text => 'Not Found');
exit;
}
my $basename = decode_utf8 $filepath->basename;
my $mime = MIME::Types->new->mimeTypeOf($basename);
$cgi->set_response_type($mime->type) if defined $mime;
$cgi->set_response_disposition(attachment => $basename)->render(file => $filepath);
};
Cookies
Cookie values should only consist of ASCII characters and may not contain any control
characters, space characters, or the characters "",;\". More complex strings can be
encoded to UTF-8 and base64 for transport.
#!/usr/bin/perl
use strict;
use warnings;
use utf8;
use CGI::Tiny;
use Unicode::UTF8 qw(decode_utf8 encode_utf8);
use MIME::Base64 qw(decode_base64 encode_base64);
cgi {
my $cgi = $_;
my $value = $cgi->param('cookie_value');
unless (defined $value) {
my $cookie = $cgi->cookie('unicode');
$value = decode_utf8 decode_base64 $cookie if defined $cookie;
}
if (defined $value) {
my $encoded_value = encode_base64 encode_utf8($value), '';
$cgi->add_response_cookie(unicode => $encoded_value, Path => '/');
$cgi->render(text => "Set cookie value: $value");
} else {
$cgi->render(text => "No cookie value set");
}
};
Data structures can be encoded to JSON and base64 for transport.
#!/usr/bin/perl
use strict;
use warnings;
use utf8;
use CGI::Tiny;
use Cpanel::JSON::XS qw(decode_json encode_json);
use MIME::Base64 qw(decode_base64 encode_base64);
cgi {
my $cgi = $_;
my $key = $cgi->param('cookie_key');
my $hashref;
if (defined $key) {
$hashref->{$key} = $cgi->param('cookie_value');
} else {
my $cookie = $cgi->cookie('hash');
$hashref = decode_json decode_base64 $cookie if defined $cookie;
$key = (keys %$hashref)[0] if defined $hashref;
}
if (defined $hashref) {
my $encoded_value = encode_base64 encode_json($hashref), '';
$cgi->add_response_cookie(hash => $encoded_value, Path => '/');
$cgi->render(text => "Set cookie hash key $key: $hashref->{$key}");
} else {
$cgi->render(text => "No cookie value set");
}
};
Sessions
Regardless of the session mechanism, login credentials should only be sent over HTTPS, and
passwords should be stored on the server using a secure one-way hash, such as with
Crypt::Passphrase.
Basic authentication <https://en.wikipedia.org/wiki/Basic_access_authentication> has
historically been used to provide a simplistic login session mechanism which relies on the
client to send the credentials with every subsequent request in that browser session.
However, it does not have a reliable logout or session expiration mechanism.
Basic authentication can be handled by the CGI server itself (e.g. Apache
<https://httpd.apache.org/docs/2.4/howto/auth.html>), which restricts access to a
directory or location to authenticated users, and passes AUTH_TYPE and REMOTE_USER with
the authenticated CGI requests.
If you want to instead handle Basic authentication directly in the CGI script, you may
need to configure the CGI server to forward the "Authorization" header (e.g. Apache
<https://stackoverflow.com/q/17018586/5848200>), as it is commonly stripped from the CGI
request.
#!/usr/bin/perl
use strict;
use warnings;
use utf8;
use CGI::Tiny;
use MIME::Base64 'decode_base64';
use Unicode::UTF8 'decode_utf8';
sub verify_password { my ($user, $pass) = @_; ... }
cgi {
my $cgi = $_;
my $authed_user;
if (defined(my $auth = $cgi->header('Authorization'))) {
if (my ($hash) = $auth =~ m/^Basic (\S+)/i) {
my ($user, $pass) = split /:/, decode_utf8(decode_base64($hash)), 2;
$authed_user = $user if verify_password($user, $pass);
}
}
unless (defined $authed_user) {
$cgi->add_response_header('WWW-Authenticate' => 'Basic realm="My Website", charset="UTF-8"');
$cgi->set_response_status(401)->render;
exit;
}
$cgi->render(text => "Welcome, $authed_user!");
};
A more sophisticated and modern login session mechanism is to store a session cookie in
the client, associated with a server-side session stored in a file or database. Login
credentials only need to be validated once per session, and subsequently the session ID
stored in the cookie will be sent by the client with each request. This type of session
can be ended by expiring the session cookie and invalidating the session data on the
server.
Some HTTP session management modules exist on CPAN, but the author has not yet discovered
any that are suitable for use with CGI::Tiny. In lieu of a generalized mechanism, session
data can be stored to and retrieved from your database of choice manually.
#!/usr/bin/perl
use strict;
use warnings;
use utf8;
use CGI::Tiny;
use Text::Xslate;
use Data::Section::Simple 'get_data_section';
sub verify_password { my ($user, $pass) = @_; ... }
sub store_new_session { my ($user) = @_; ... }
sub get_session_user { my ($session_id) = @_; ... }
sub invalidate_session { my ($session_id) = @_; ... }
cgi {
my $cgi = $_;
my $tx = Text::Xslate->new(path => [get_data_section]);
my ($authed_user, $session_id);
if ($cgi->path eq '/login') {
if ($cgi->method eq 'GET' or $cgi->method eq 'HEAD') {
$cgi->render(html => $tx->render('login.tx', {login_failed => 0}));
exit;
} elsif ($cgi->method eq 'POST') {
my $user = $cgi->body_param('login_user');
my $pass = $cgi->body_param('login_pass');
if (verify_password($user, $pass)) {
$session_id = store_new_session($user);
$authed_user = $user;
} else {
$cgi->render(html => $tx->render('login.tx', {login_failed => 1}));
exit;
}
}
} elsif (defined($session_id = $cgi->cookie('myapp_session'))) {
if ($cgi->path eq '/logout') {
invalidate_session($session_id);
# expire session cookie
$cgi->add_response_cookie(myapp_session => $session_id, 'Max-Age' => 0, Path => '/', HttpOnly => 1);
$cgi->render(redirect => $cgi->script_name . '/login');
exit;
} else {
$authed_user = get_session_user($session_id);
}
}
unless (defined $authed_user) {
$cgi->render(redirect => $cgi->script_name . '/login');
exit;
}
# set/refresh session cookie
$cgi->add_response_cookie(myapp_session => $session_id, 'Max-Age' => 3600, Path => '/', HttpOnly => 1);
$cgi->render(text => "Welcome, $authed_user!");
};
__DATA__
@@ login.tx
<html>
<head>
<title>Login</title>
</head>
<body>
<form method="post">
<input type="text" name="login_user" placeholder="Username">
<input type="password" name="login_pass" placeholder="Password">
<button type="submit">Login</button>
</form>
: if $login_failed {
<p>Login failed</p>
: }
</body>
</html>
Logging
CGI scripts can usually log errors directly to STDERR with the "warn" function, and rely
on the CGI server to log them to a file, but you will likely need to encode errors to
UTF-8 if you expect them to contain non-ASCII text.
Minimal loggers like Log::Any can also be used to redirect errors and warnings to a file
or other logging mechanism specific to the CGI script, encode them to bytes automatically,
and also log debugging information when the log level is set to "debug". Just make sure
the CGI server has permission to create and write to the logging target.
#!/usr/bin/perl
use strict;
use warnings;
use utf8;
use CGI::Tiny;
use Log::Any;
use Log::Any::Adapter
{category => 'cgi-script'}, # only log our category here
File => '/path/to/log/file.log',
binmode => ':encoding(UTF-8)',
log_level => $ENV{MYCGI_LOG_LEVEL} || 'info';
my $log = Log::Any->get_logger(category => 'cgi-script');
local $SIG{__WARN__} = sub {
my ($warning) = @_;
chomp $warning;
$log->warn($warning);
};
cgi {
my $cgi = $_;
$cgi->set_error_handler(sub {
my ($cgi, $error, $rendered) = @_;
chomp $error;
$log->error($error);
});
# only logged if MYCGI_LOG_LEVEL=debug set in CGI server environment
$log->debugf('Method: %s, Path: %s, Query: %s', $cgi->method, $cgi->path, $cgi->query);
my $number = $cgi->param('number');
die "Excessive number\n" if abs($number) > 1000;
my $doubled = $number * 2;
$cgi->render(text => "Doubled: $doubled");
};
Routing
Web applications use routing to serve multiple types of requests from one application.
Routes::Tiny can be used to organize this with CGI::Tiny, using "REQUEST_METHOD" and
"PATH_INFO" (which is the URL path after the CGI script name).
#!/usr/bin/perl
use strict;
use warnings;
use utf8;
use CGI::Tiny;
use Routes::Tiny;
my %dispatch = (
foos => sub {
my ($cgi) = @_;
my $method = $cgi->method;
$cgi->render(text => "$method foos");
},
get_foo => sub {
my ($cgi, $captures) = @_;
my $id = $captures->{id};
$cgi->render(text => "Retrieved foo $id");
},
put_foo => sub {
my ($cgi, $captures) = @_;
my $id = $captures->{id};
$cgi->render(text => "Stored foo $id");
},
);
cgi {
my $cgi = $_;
my $routes = Routes::Tiny->new;
# /script.cgi/foo
$routes->add_route('/foo', name => 'foos');
# /script.cgi/foo/42
$routes->add_route('/foo/:id', method => 'GET', name => 'get_foo');
$routes->add_route('/foo/:id', method => 'PUT', name => 'put_foo');
if (defined(my $match = $routes->match($cgi->path, method => $cgi->method))) {
$dispatch{$match->name}->($cgi, $match->captures);
} else {
$cgi->set_response_status(404)->render(text => 'Not Found');
}
};
AUTHOR
Dan Book <dbook@cpan.org>
COPYRIGHT AND LICENSE
This software is Copyright (c) 2021 by Dan Book.
This is free software, licensed under:
The Artistic License 2.0 (GPL Compatible)
SEE ALSO
CGI::Tiny