abort messages with http error code

Fix success code for various exceptions.

diff --git a/apl.plp b/apl.plp
index 9ca99701ff2ff92f9f32176dbb1b12cdfeb24aef..929c4243cc7d40cf7044c8056275ef0ed59b8a03 100644 (file)
--- a/apl.plp
+++ b/apl.plp
@@ -29,7 +29,7 @@ use Shiar_Sheet::FormatChar;
 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>

diff --git a/chars.plp b/chars.plp
index 04420cd123a3558e7170f43b6e120d40dd20f158..6605ec8c6d051e492ffdae311600b3dc2727e6f6 100644 (file)
--- a/chars.plp
+++ b/chars.plp
@@ -62,8 +62,7 @@ my $query = eval {
 say "<h1>$title</h1>";
 
 if (!$query) {
-       Alert('Unicode group not specified', $@);
-       exit;
+       Abort(["Unicode group not found", $@], '404 no matches');
 };
 
 for ($parent || 'Unicode range') {
@@ -82,15 +81,16 @@ 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

diff --git a/common.inc.plp b/common.inc.plp
index 9b61d52b4416a9c75d1fa74157e758b43c35b4f1..77880495c2be77883e45d013279c0aa296ad9a9e 100644 (file)
--- a/common.inc.plp
+++ b/common.inc.plp
@@ -20,6 +20,20 @@ sub Alert {
        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()];

diff --git a/digits.plp b/digits.plp
index a6a684e6ced5ba4d24d6539b990a8545c1adfcf8..163ee1035a986b706a0f92cab3d151127080197e 100644 (file)
--- a/digits.plp
+++ b/digits.plp
@@ -41,7 +41,7 @@ my $scriptname = do 'writing-script.inc.pl';
 $_ = 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;

diff --git a/digraphs.plp b/digraphs.plp
index af71630b795cbebc7be5825d9449bb54c0fdd129..7106c7f6da3ad411472fdb0798b98b2f9f7a8ab1 100644 (file)
--- a/digraphs.plp
+++ b/digraphs.plp
@@ -39,7 +39,7 @@ say '<p class="aside">Unofficial <span class="u-l2">proposals</span>',
 
 <:
 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)
@@ -60,7 +60,7 @@ my @columns = !exists $get{split} ? \@chars2 :
 
 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

diff --git a/emoji.plp b/emoji.plp
index 2a546b406efe045351345a9e558852ba7735861a..1f4bf0161be18bb400318d3d66b454a60b6d81e6 100644 (file)
--- a/emoji.plp
+++ b/emoji.plp
@@ -23,7 +23,7 @@ say '<div class="section">';
 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} || ();
 

diff --git a/font.plp b/font.plp
index 3a39c2e1e71a0f199e6ae1fd22236aa8e7e369b9..ec612023291030774088846b84e069c3c4020c43 100644 (file)
--- a/font.plp
+++ b/font.plp
@@ -15,7 +15,7 @@ Html({
 
 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;
@@ -39,7 +39,7 @@ if ($font) {
                }
                return \@map;
        };
-       die $@ if $@;
+       Abort($@, '404 invalid query') if $@;
 
        require Unicode::UCD;
 
@@ -52,7 +52,7 @@ if ($font) {
                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});
@@ -218,7 +218,7 @@ my @rows = (
 
 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};
 }
 

diff --git a/sample.plp b/sample.plp
index 33d06e909d878f45197a09bd8b139e6d5c5e64f3..f824e1458e39e4f24356267692f28ac8900090ff 100644 (file)
--- a/sample.plp
+++ b/sample.plp
@@ -10,7 +10,7 @@ Html({
 });
 
 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;

diff --git a/sc.plp b/sc.plp
index 3437f8f4aca51ce2da337d4f36f10682a47a93ab..a282ef4007ebc9e4f74afcd35e9e7fe76f154e91 100644 (file)
--- a/sc.plp
+++ b/sc.plp
@@ -43,9 +43,9 @@ Html({
 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(', ',

diff --git a/source.plp b/source.plp
index 6d6057c5249492803ad32a7c0cabbdd6fcbc10c4..269e342a2c331a31aa2cd3f6f82a13cae54b34a9 100644 (file)
--- a/source.plp
+++ b/source.plp
@@ -58,7 +58,7 @@ else {
        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';
@@ -68,7 +68,7 @@ else {
                        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 {

diff --git a/termcol.plp b/termcol.plp
index c510cd24d1bcdbdcd5bf4e151f8dc6d6d02f2f11..281d33ca5958290a0ecb4fef2787a48057f8767b 100644 (file)
--- a/termcol.plp
+++ b/termcol.plp
@@ -45,7 +45,7 @@ use List::Util qw( min max );
 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";

diff --git a/unicode.plp b/unicode.plp
index 7949edcdfd7763214b90e7d27631f88249cd67aa..ec10a67784c2dfde6fd077aa0c2126cc6a68720c 100644 (file)
--- a/unicode.plp
+++ b/unicode.plp
@@ -144,7 +144,7 @@ $glyphs->print(map {
                $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;