abort messages with http error code

[sheet.git] / common.inc.plp
diff --git a/common.inc.plp b/common.inc.plp

index e3316fc439a00246e5454d0f64194b3a1fb460a6..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()];
@@ -132,36 +146,38 @@ sub Html {
                 '<script type="text/javascript" src="/keys.js?1.6" async></script>',
         ) if $meta->{keys};
  
-       # leading output
-       say '<!DOCTYPE html>';
-       say '<html lang="en">';
-       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} }) || ();
-       say sprintf '<meta name="keywords" content="%s">', EscapeHTML($_)
-               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} || ();
-       say '<meta name="robots" content="noindex">' if $Dev;
-       say '</head>';
-       say '';
-       say sprintf '<body id="%s">', $file;
-
-       # development version indicator
-       printf '<p style="%s">beta</p>', join('; ',
-               'position: fixed',
-               'right: 1em',
-               'opacity: .5',
-               'border: 1ex solid red',
-               'border-width: 1ex 0',
-               'z-index: 1',
-               'background: inherit',
-       ) if $Dev;
+       PLP_START {
+               # leading output
+               say '<!DOCTYPE html>';
+               say '<html lang="en">';
+               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} }) || ();
+               say sprintf '<meta name="keywords" content="%s">', EscapeHTML($_)
+                       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} || ();
+               say '<meta name="robots" content="noindex">' if $Dev;
+               say '</head>';
+               say '';
+               say sprintf '<body id="%s">', $file;
+
+               # development version indicator
+               printf '<p style="%s">beta</p>', join('; ',
+                       'position: fixed',
+                       'right: 1em',
+                       'opacity: .5',
+                       'border: 1ex solid red',
+                       'border-width: 1ex 0',
+                       'z-index: 1',
+                       'background: inherit',
+               ) if $Dev;
+       };
  
         # prepare trailing output
         PLP_END {