#!/usr/bin/perl BEGIN { my $base_module_dir = (-d '/home/shlomif/perl' ? '/home/shlomif/perl' : ( getpwuid($>) )[7] . '/perl/'); unshift @INC, map { $base_module_dir . $_ } @INC; } use strict; use warnings; use CGI::Minimal; use DBI; use Encode qw(decode); use File::Spec::Functions qw( catpath splitpath rel2abs ); binmode STDOUT, ':encoding(utf8)'; # We're using rand() later. srand(); # The Directory containing the script. my $script_dir = catpath( ( splitpath( rel2abs $0 ) )[ 0, 1 ] ); my $db_base_name = "fortunes-shlomif-lookup.sqlite3"; my $full_db_path = "$script_dir/$db_base_name"; my $dbh = DBI->connect("dbi:SQLite:dbname=$full_db_path","",""); my $select_sth = $dbh->prepare(<<'EOF'); SELECT f.text, f.title, c.str_id, c.title FROM fortune_cookies AS f, fortune_collections AS c WHERE ((f.str_id = ?) AND (f.collection_id = c.id)) EOF my $select_max_id = $dbh->prepare( q{SELECT MAX(id) FROM fortune_cookies} ); my $lookup_str_id_from_id = $dbh->prepare( q{SELECT str_id FROM fortune_cookies WHERE id = ?} ); my $cgi = CGI::Minimal->new; my $NL = "\015\012"; sub _header { print "Content-Type: text/html; charset=utf-8$NL$NL"; return; } sub _emit_error { my ($args) = @_; print "Status: 404 Not Found$NL"; _header(); _wrap_error_html($args); return; } sub _wrap_error_html { my ($args) = @_; my $title = $args->{title}; my $body = $args->{body}; print <<"ERROR_HTML";
Only valid modes are random and str_id (where str_id is the default).
END_OF_BODY return; } sub _pick_random { my $rv = $select_max_id->execute(); my ($max_id) = $select_max_id->fetchrow_array; if (! $max_id) { _emit_error({ title => "Query failed", body => <<"END_OF_BODY", });Report this problem to the webmaster.
END_OF_BODY return; } $rv = $lookup_str_id_from_id->execute( int(rand() * ($max_id)) + 1 ); my ($str_id) = $lookup_str_id_from_id->fetchrow_array(); if (! $str_id) { _emit_error({ title => q{Unknown fortune ID}, body => <<'EOF'});Report this problem to the webmaster.
EOF return; } # str_id must not contain any strange HTML/URI/etc. characters # If it does - then we suck. print "Location: ./show.cgi?id=$str_id$NL$NL"; return; } sub _display_fortune_from_data { my ($str_id, $html_text, $html_title, $col_str_id, $col_title) = @_; $html_text = decode('utf-8', $html_text); my $title_esc = $cgi->htmlize(decode('utf-8', $html_title)) . " - Fortune" ; _header(); my $base_dir = '../..'; print <<"FORTUNE";The ID parameter must be specified.
END_OF_BODY return; } my $rv = $select_sth->execute($str_id); if (my @data = $select_sth->fetchrow_array) { return _display_fortune_from_data($str_id, @data); } else { _emit_error({ title => q{URL not found}, body => <<"END_OF_BODY"});The fortune ID @{[$cgi->htmlize($str_id)]} is not recognised. If you've reached this URL and think it should be defined please contact Shlomi Fish (the Webmaster) and let him know of this problem.
END_OF_BODY return; } } __END__ =head1 NAME fortune_show.cgi - a Perl 5 , CGI.pm and L