Fix success code for various exceptions.
my $glyphs = Shiar_Sheet::FormatChar->new;
my @ops = do 'apl.inc.pl';
-@ops > 1 or die "cannot open operator include: $@\n";
+@ops > 1 or Abort("cannot open operator include", 500, $@ // $!);
:>
<h1>APL Symbols</h1>
say "<h1>$title</h1>";
if (!$query) {
- Alert('Unicode group not specified', $@);
- exit;
+ Abort(["Unicode group not found", $@], '404 no matches');
};
for ($parent || 'Unicode range') {
my @chars;
for (map { split /[^\d-]/ } $query) {
my @range = split /-/, $_, 2;
- m/^[0-9]+$/ or die "Invalid code point $_ in query $query\n" for @range;
+ m/^[0-9]+$/ or Abort("Invalid code point $_ in query $query", 400)
+ for @range;
push @chars, chr $_ for $range[0] .. ($range[1] // $range[0]);
}
-@chars or die "No match for query $query\n";
+@chars or Abort("No match for query $query", '404 no results');
-@chars <= 1500 or die sprintf(
- 'Too many matches (%d) for query %s'."\n",
- scalar @chars, $query,
+@chars <= 1500 or Abort(
+ sprintf('Too many matches (%d) for query %s', scalar @chars, $query),
+ '403 not allowed',
);
# output character list
say "<div class=error>$body</div>\n";
}
+sub Abort {
+ my ($html, $code, $debug) = @_;
+ unless ($PLP::sentheaders) {
+ $header{Status} = $code || 500;
+ }
+ elsif ($Dev) {
+ ref $html eq 'ARRAY' or $html = [$html];
+ push @{$html}, "Also failed to set HTTP status <q>$code</q>"
+ . " after output!";
+ }
+ Alert($html, $debug);
+ exit;
+}
+
BEGIN {
require Time::HiRes;
our $Time = [Time::HiRes::gettimeofday()];
$_ = showlink($_, "/latin") for $scriptname->{latn} || ();
my $table = do "writing-digits.inc.pl";
-die "Table data not found: $_\n" for $@ || $! || ();
+Abort("Table data not found", 501, $_) for $@ || $! || ();
sub printtable {
say '<div class=section>', $glyphs->tabletag;
<:
my $di = do 'data/digraphs.inc.pl'
- or die "Error loading digraphs data: ", $@ // $!;
+ or Abort("Error loading digraphs data", 501, $@ // $!);
if (exists $get{v}) {
# show characters for inverted mnemonics (vim alternatives)
if ($mode) {
my $xorg = do 'data/digraphs-xorg.inc.pl'
- or die "Error loading Xorg data: ", $@ // $!;
+ or Abort("Error loading Xorg data", 501, $@ // $!);
$_ = [ord $_] for values %{$xorg};
$xorg->{$_}->[2] = # class = compatibility
$di->{$_} ? $di->{$_}->[0] != $xorg->{$_}->[0] ? 'l1' : # conflict
for my $system (qw'gmail msn yahoo') {
my @info = do "emoji-$system.inc.pl";
my $meta = shift @info or die $@;
- ref $meta eq 'HASH' or die "invalid $system definitions";
+ ref $meta eq 'HASH' or Abort("Invalid $system definitions", 404);
my $title = $meta->{name} // $system;
$title = showlink($title, $_) for $meta->{source} || ();
if ($font) {
my ($fontmeta, @cover) = do "data/font/$font.inc.pl";
- $fontmeta or die "Unknown font $font\n";
+ $fontmeta or Abort("Unknown font $font", '404 font not found');
my $map = eval {
$get{map} or return;
}
return \@map;
};
- die $@ if $@;
+ Abort($@, '404 invalid query') if $@;
require Unicode::UCD;
return $_->[0]->[0] for Unicode::UCD::charblock(ucfirst) || (); # block
die "Unknown offset query '$_'\n";
};
- die $@ if $@;
+ Abort($@, '400 invalid offset') if $@;
say "<h1>Font coverage</h1>";
say "<h2>$_</h2>" for EscapeHTML($fontmeta->{name});
if (my $group = $get{q}) {
my $grouprows = $cover->{$group}
- or die "Unknown character category $_\n";
+ or Abort("Unknown character category $_", 404);
@rows = map { "$group/$_" } sort keys %{$grouprows};
}
});
open my $source, '<', $textinc
- or die "Could not open text at $textinc: $!\n";
+ or Abort("Could not open text at $textinc", 501, $!);
local $/ = "\n\n";
my $top = readline $source;
say "<h1>$scver{game} units</h1>\n";
my $units = do $datafile;
-die "Cannot open unit data: $_\n" for $@ || $! || ();
+Abort("Cannot open unit data", 501, $_) for $@ || $! || ();
my $patch = shift @{$units}
- or die "Cannot open unit data: metadata not found\n";
+ or Abort("Cannot open unit data: metadata not found", 501);
say "<p>Unit properties as seen or measured in $scver{name}\n$patch.";
say "Also see the $_ table." for join(', ',
say "<h1>Source of $href</h1>";
if ($source =~ m{(?:/|^)\.}) {
- die "File request not permitted\n";
+ Abort("File request not permitted", '403 source not allowed');
}
elsif ($source =~ s{::}{/}g or !-e $source) {
$source .= '.pm';
last;
}
}
- -r $source or die "Requested file not found\n";
+ -r $source or Abort("Requested file not found", '404 source not found');
my $size = (stat $source)->[7];
if (my $hl = eval {
use POSIX qw( ceil );
my $palettes = do 'termcol.inc.pl';
-die "Cannot open palette data: $_\n" for $@ || $! || ();
+Abort("Cannot open palette data", 501, $_) for $@ || $! || ();
sub colcell {
my $name = shift // return "<td>\n";
$group = $1 if s{^([^/]+)/}{};
my @select = s/=(.*)// ? split(/=/, $1) : ();
my $table = $tables->{$group}->{$_}
- or die "Unknown table specified: $group/$_";
+ or Abort("Unknown table specified: $group/$_", 404);
if (@select) {
my $rowlen;