<:
use 5.014;
+use strict;
use utf8;
use warnings;
no warnings 'qw'; # you know what you doing
use HTTP::Date;
use Encode qw( decode_utf8 );
+our $Dev;
+
sub Alert {
my ($html, $debug) = @_;
ref $html eq 'ARRAY' or $html = [$html];
my ($title, @lines) = @{$html};
- $body = "<h2>$title</h2>";
+ my $body = "<h2>$title</h2>";
$body .= "\n<p>$_</p>" for @lines;
$body .= "\n<pre>$debug</pre>" if $Dev and $debug;
say "<div class=error>$body</div>\n";
require Time::HiRes;
our $Time = [Time::HiRes::gettimeofday()];
- $PLP::ERROR = sub {
- my ($text, $html) = @_;
- warn $text;
- unless ($PLP::sentheaders and $PLP::sentheaders->[0] !~ m{/PLP\.pm$}) {
- Html({nocache => 1});
- say '<h1>Page unavailable</h1>';
- }
- Alert("<strong>Fatal error</strong>: $html.");
- };
-
push @INC, '.';
# user request
our $Dev = $ENV{HTTP_HOST} =~ /\bdev\./;
- our ($file) = $ENV{SCRIPT_FILENAME} =~ m{ ([^/]+) \.plp$ }x;
}
-our $Request = decode_utf8($ENV{PATH_INFO} =~ s{^/}{}r);
+our $Request //= decode_utf8($ENV{PATH_INFO} =~ s{^/}{}r);
our $style;
-our $showkeys = !exists $get{keys} ? undef :
+our $showkeys //= !exists $get{keys} ? undef :
($get{keys} ne '0' && ($get{keys} || 'always'));
$header{content_type} = 'text/html; charset=utf-8';
return map { sprintf(
'<link rel="%s" type="text/css" media="all" href="%s" title="%s">',
- $_ eq $style ? 'stylesheet' : 'alternate stylesheet', "/$_.css?1.11", $_
+ $_ eq $style ? 'stylesheet' : 'alternate stylesheet', "/$_.css?1.13", $_
) } @avail;
}
$header{'Last-Modified'} = time2str($lastmod);
}
+sub Data {
+ my ($filename) = @_;
+ my @data = eval {
+ open my $cache, '<:raw', "data/$filename.json"
+ or return do "./$filename.inc.pl"; # silent fallback to original code
+ require JSON;
+ local $/; # slurp
+ return JSON::decode_json(readline $cache);
+ };
+ if ($! or $@ or !@data or !$data[0]) {
+ die ['Table data not found', $@ || $!];
+ }
+ if (@data == 1 and ref $data[0] eq 'HASH' and not %{$data[0]}) {
+ die ['Table data missing'];
+ }
+ return wantarray ? @data : $data[0]; # list compatibility like do does
+}
+
sub Html {
my ($meta) = @_;
# default fallbacks
$meta->{stylesheet} ||= [qw( light dark circus mono red )];
$meta->{charset} ||= 'utf-8';
+ $meta->{lang} ||= 'en';
# convert options to arrays
ref $_ eq 'ARRAY' or $_ = [$_]
'<script type="text/javascript" src="/keys.js?1.6" async></script>',
) if $meta->{keys};
+ my ($file) = $ENV{SCRIPT_FILENAME} =~ m{ ([^/]+) \.plp$ }x;
+
PLP_START {
# leading output
say '<!DOCTYPE html>';
- say '<html lang="en">';
+ say qq(<html lang="$meta->{lang}">);
say '';
say '<head>';
say sprintf '<meta http-equiv="content-type" content="%s">', $_
for $header{content_type};
say sprintf '<title>%s</title>', $meta->{title};
say sprintf '<meta name="description" content="%s">', EscapeHTML($_)
- for join(' ', @{ $meta->{description} }) || ();
+ for join(' ', @{ $meta->{description} // [] }) || ();
say sprintf '<meta name="keywords" content="%s">', EscapeHTML($_)
- for join(', ', @{ $meta->{keywords} }) || ();
+ for join(', ', @{ $meta->{keywords} // [] }) || ();
say '<meta name="viewport" content="width=device-width, initial-scale=1">';
say '<link rel="icon" type="image/png" href="/clip.png">';
say for map { @{$_} } $meta->{raw} || ();
title="Licensed under the GNU Affero General Public License, version 3"
rel="license">AGPLv3</a>
EOT
+ our $Time;
say sprintf '• %.3fs', Time::HiRes::tv_interval($Time) if $Dev and $Time;
say '</p>';
say '';
};
}
+BEGIN {
+ $PLP::ERROR = sub {
+ my ($message, $html) = @_;
+ if (ref $message) {
+ warn join ': ', @{$message};
+ $html = shift @{$message};
+ }
+ else {
+ warn $message;
+ $message = [];
+ }
+ unless ($PLP::sentheaders) {
+ Html({nocache => 1});
+ say '<h1>Page unavailable</h1>';
+ }
+ Alert("Fatal error: $html.", @{$message});
+ };
+}
+
sub showlink {
my ($title, $href, $selected) = @_;
- return sprintf(
- !$href ? '%s' :
- $selected ? '<strong>%s</strong>' : '<a href="%2$s">%s</a>',
- EscapeHTML($title), EscapeHTML($href)
- );
+ EscapeHTML($title);
+ return $title if not $href;
+ return "<strong>$title</strong>" if $selected;
+ return sprintf '<a href="%s">%s</a>', EscapeHTML($href), $title;
}