common: global Data() to parse perl code includes

Same error reporting and possible upcoming extension.

diff --git a/apl.plp b/apl.plp
index 929c4243cc7d40cf7044c8056275ef0ed59b8a03..d01d3ed6524171bc930b63bd08a2142d4b89c590 100644 (file)
--- a/apl.plp
+++ b/apl.plp
@@ -27,9 +27,7 @@ EOT
 
 use Shiar_Sheet::FormatChar;
 my $glyphs = Shiar_Sheet::FormatChar->new;
-
-my @ops = do 'apl.inc.pl';
-@ops > 1 or Abort("cannot open operator include", 500, $@ // $!);
+my @ops = Data('apl');
 
 :>
 <h1>APL Symbols</h1>

diff --git a/browser.plp b/browser.plp
index 5811594606a9bea5774ba7dd0a1b319803e74272..6d75d4a35dc2023297707a09827bef847fff17aa 100644 (file)
--- a/browser.plp
+++ b/browser.plp
@@ -20,7 +20,7 @@ Html({
 
 say "<h1>Browser compatibility</h1>\n";
 
-my $caniuse = do 'data/browser/support.inc.pl' or die $@ || $!;
+my $caniuse = Data('data/browser/support');
 
 my %CSTATS = (
        'n'   => 'l1',
@@ -94,8 +94,8 @@ given ($get{usage} // 'wm') {
                        'Identifier must be alphanumeric name or <q>0</q>.',
                ]);
        }
-       $canihas = do "data/browser/usage-$_.inc.pl" or do {
-               Alert('Browser usage data not found', $@ || $!);
+       $canihas = eval { Data("data/browser/usage-$_") } or do {
+               Alert('Browser usage data not found', $@);
                break;
        };
        $usage = $_;

diff --git a/chars.plp b/chars.plp
index e43099e523229283acb390e666dd2aa05482b3f2..e106eb425862f9807559e3b9f7abf1753a1d93b5 100644 (file)
--- a/chars.plp
+++ b/chars.plp
@@ -22,7 +22,7 @@ EOT
 use Shiar_Sheet::FormatChar;
 my $glyphs = Shiar_Sheet::FormatChar->new;
 
-my $groupinfo = do 'data/unicode-cover.inc.pl' or die $@ || $!;
+my $groupinfo = Data('data/unicode-cover');
 
 my @ossel = @{ $groupinfo->{osdefault} };
 my @fontlist = map { $_->{file} }
@@ -30,7 +30,7 @@ my @fontlist = map { $_->{file} }
 
 my %font;
 for my $fontid (@fontlist) {
-               my ($fontmeta, @fontrange) = do "data/font/$fontid.inc.pl";
+               my ($fontmeta, @fontrange) = eval { Data("data/font/$fontid") };
                $fontmeta or next;
                $font{$fontid} = {
                        (map { (-$_ => $fontmeta->{$_}) } keys %{$fontmeta}),

diff --git a/charset.plp b/charset.plp
index eb23d7ebe7b3a73b97e161ed25774e5efc3c900a..2eb601f67f6f96aa53672c190802ec2d490ad869 100644 (file)
--- a/charset.plp
+++ b/charset.plp
@@ -79,8 +79,7 @@ use Shiar_Sheet::FormatChar;
 my $glyphs = Shiar_Sheet::FormatChar->new;
 my @request;
 
-my $charsets = do 'charset-encoding.inc.pl'
-       or Alert('Encoding metadata could not be read', $@ || $!);
+my $charsets = Data('charset-encoding');
 
 sub tabinput {
        # generate character table(s)

diff --git a/cli.plp b/cli.plp
index d8653e8207c3b1ad5695b39517badf0707bede2b..96cd4277af7cc40bc2c10f61e3daed31caef9c59 100644 (file)
--- a/cli.plp
+++ b/cli.plp
@@ -9,8 +9,7 @@ Html({
        data => ['data/cli.inc.pl'],
 });
 
-my $cmd = do 'data/cli.inc.pl'
-       or Abort("Error loading program data", 501, $@ // $!);
+my $cmd = Data('data/cli');
 :>
 <h1>CLI options</h1>
 

diff --git a/codec.plp b/codec.plp
index 1ce4611708149f5974fa005e9edcb4dd4121ded6..34246950dcc25c7e27d5c01064993d6ad15b6465 100644 (file)
--- a/codec.plp
+++ b/codec.plp
@@ -20,7 +20,7 @@ Html({
        raw => '<style>td,th {width:8%} tbody th {white-space:nowrap}</style>',
 });
 
-my $info = do "codec-$page.inc.pl";
+my $info = Data("codec-$page");
 $info and %{$info} > 1
        or Abort("Requested codec type <q>$page</q> not available", '404 request not found', $@ // $!);
 

diff --git a/common.inc.plp b/common.inc.plp
index 71c5c1379f29aeb82d6d1211ec53dff69740d2cf..39865bdb55f2ca961da6d7f0ebcaecbc760aab9a 100644 (file)
--- a/common.inc.plp
+++ b/common.inc.plp
@@ -99,6 +99,20 @@ sub checkmodified {
        $header{'Last-Modified'} = time2str($lastmod);
 }
 
+sub Data {
+       my ($filename) = @_;
+       my @data = eval {
+               do "$filename.inc.pl";
+       };
+       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) = @_;
 

diff --git a/countries.plp b/countries.plp
index e404ae5c68cba884bf56a1f6df28ea0757967652..efd2f256407351c0c88973d6d165ccc398e56d32 100644 (file)
--- a/countries.plp
+++ b/countries.plp
@@ -14,7 +14,7 @@ Html({
 <h1>ISO-3166-1α2 Country codes</h1>
 
 <:
-my $cc = do 'data/countries.inc.pl';
+my $cc = Data('data/countries');
 
 {
        printf '<table class="ccmap">';

diff --git a/digits.plp b/digits.plp
index 163ee1035a986b706a0f92cab3d151127080197e..a55b49a8ca6b8af706aa6e617021e4940ea3047b 100644 (file)
--- a/digits.plp
+++ b/digits.plp
@@ -37,11 +37,10 @@ unless (exists $get{v}) {
        $glyphs->{style} = 'univer';
 }
 
-my $scriptname = do 'writing-script.inc.pl';
+my $scriptname = eval { Data('writing-script') };
 $_ = showlink($_, "/latin") for $scriptname->{latn} || ();
 
-my $table = do "writing-digits.inc.pl";
-Abort("Table data not found", 501, $_) for $@ || $! || ();
+my $table = Data("writing-digits");
 
 sub printtable {
        say '<div class=section>', $glyphs->tabletag;

diff --git a/digraphs.plp b/digraphs.plp
index 7106c7f6da3ad411472fdb0798b98b2f9f7a8ab1..2f57b36147f5063b204f8368a25c02e59a2bd33c 100644 (file)
--- a/digraphs.plp
+++ b/digraphs.plp
@@ -38,8 +38,7 @@ say '<p class="aside">Unofficial <span class="u-l2">proposals</span>',
 :>
 
 <:
-my $di = do 'data/digraphs.inc.pl'
-       or Abort("Error loading digraphs data", 501, $@ // $!);
+my $di = Data('data/digraphs');
 
 if (exists $get{v}) {
        # show characters for inverted mnemonics (vim alternatives)
@@ -59,8 +58,7 @@ my @columns = !exists $get{split} ? \@chars2 :
        ([@chars2[0, 1, 3, 4, 6]], [@chars2[2, 5, 7]]);
 
 if ($mode) {
-       my $xorg = do 'data/digraphs-xorg.inc.pl'
-               or Abort("Error loading Xorg data", 501, $@ // $!);
+       my $xorg = Data('data/digraphs-xorg');
        $_ = [ord $_] for values %{$xorg};
        $xorg->{$_}->[2] = # class = compatibility
                $di->{$_} ? $di->{$_}->[0] != $xorg->{$_}->[0] ? 'l1' :  # conflict

diff --git a/emoji.plp b/emoji.plp
index 41e4c129f0b4170a6234e6e52e8870dab4d45769..690f9e379fb66e41f1b44194e2210ad3912aa397 100644 (file)
--- a/emoji.plp
+++ b/emoji.plp
@@ -21,8 +21,8 @@ Html({
 say '<div class="section">';
 
 for my $system (qw'gmail msn yahoo') {
-       my @info = do "emoji-$system.inc.pl";
-       my $meta = shift @info or die $@;
+       my @info = Data("emoji-$system");
+       my $meta = shift @info;
        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 30a4234c5a732fabcbbd1156bfecf52e255fe552..cb6cd358d487369a79f2943f0a8cf6b50206aa08 100644 (file)
--- a/font.plp
+++ b/font.plp
@@ -14,13 +14,13 @@ Html({
 });
 
 if ($font) {
-       my ($fontmeta, @cover) = do "data/font/$font.inc.pl";
-       $fontmeta or Abort("Unknown font $font", '404 font not found');
+       my ($fontmeta, @cover) = eval { Data("data/font/$font") }
+               or Abort("Unknown font $font", '404 font not found', ref $@ && $@->[1]);
 
        my $map = eval {
                $get{map} or return;
 
-               my $groupinfo = do 'data/unicode-cover.inc.pl' or die $@ || $!;
+               my $groupinfo = Data('data/unicode-cover');
 
                my ($cat, $name) = split m{/}, $get{map}, 2 or die "invalid map\n";
                if (!$name) {
@@ -181,7 +181,7 @@ Character support of Unicode
 
 <:
 
-my $cover = do 'data/unicode-cover.inc.pl' or die $@ || $!;
+my $cover = Data('data/unicode-cover');
 
 my @ossel = @{ $cover->{osdefault} };
 my @fontlist = map { @{ $cover->{os}->{$_} } } @ossel;

diff --git a/latin.plp b/latin.plp
index a86f2ca52390c000618aec6baa1c67dbe9baeba9..cac0e92b3fd7b07c756335a53a0e3519fad87c72 100644 (file)
--- a/latin.plp
+++ b/latin.plp
@@ -50,11 +50,8 @@ and <a href="/chars/abc">font comparison</a>.</p>
 <:
 use List::Util qw( pairs );
 
-my @table = do 'writing-latn.inc.pl';
-if ($! or $@ or !@table) {
-       die ["Table data not found", $@ || $!];
-}
-else {
+my @table = Data('writing-latn');
+{
        say '<div>';
        say '<style>';
        for my $row (pairs @table) {

diff --git a/less.plp b/less.plp
index 206de5e85a18e649d1d3554f54daab9b2a24df1f..e40d37c4fa1ed9af98253aae768131ef437baa65 100644 (file)
--- a/less.plp
+++ b/less.plp
@@ -22,7 +22,7 @@ Html({
 
 <:
 use Shiar_Sheet::Keyboard 2.07;
-my $info = do 'less.eng.inc.pl' or die $@;
+my $info = Data('less.eng');
 my $keys = Shiar_Sheet::Keyboard->new($info);
 $keys->map($get{map}) or undef $get{map};
 $keys->print_rows($get{rows}, [1,0]);

diff --git a/mplayer.plp b/mplayer.plp
index 077c7c5c76885594546772a47e3d937db4c81de4..f7b4445cd954500176198632f1643d1b824f8a61 100644 (file)
--- a/mplayer.plp
+++ b/mplayer.plp
@@ -1,7 +1,7 @@
 <(common.inc.plp)><:
 
 my $mode = $Request eq 'mpv' ? $Request : 'MPlayer';
-my $include = "\L$mode.eng.inc.pl";
+my $include = "\L$mode.eng";
 
 Html({
        title => "\L$mode\E cheat sheet",
@@ -16,14 +16,14 @@ Html({
        '],
        stylesheet => [qw( light dark circus mono red )],
        keys => 1,
-       data => [$include],
+       data => ["$include.inc.pl"],
 });
 
 say "<h1>$mode cheat sheet</h1>";
 say '';
 
 use Shiar_Sheet::Keyboard 2;
-my $info = do $include or die $@;
+my $info = Data($include);
 my $keys = Shiar_Sheet::Keyboard->new($info);
 $keys->map($get{map}) or undef $get{map};
 $keys->print_rows($get{rows}, [1,0]);

diff --git a/mutt.plp b/mutt.plp
index bac469f9fd7b42c578794a0b4f35db450beea9ca..09918eee11f6b4389d9c709b19813f598fddf5b6 100644 (file)
--- a/mutt.plp
+++ b/mutt.plp
@@ -21,7 +21,7 @@ Html({
 
 <:
 use Shiar_Sheet::Keyboard 2;
-my $info = do 'mutt.eng.inc.pl' or die $@;
+my $info = Data('mutt.eng');
 my $keys = Shiar_Sheet::Keyboard->new($info);
 $keys->map($get{map}) or undef $get{map};
 $keys->print_rows($get{rows});

diff --git a/nethack.plp b/nethack.plp
index 8a49a3d78e30e23748ead2c1835be8cfc84b0d2d..5e676d9e87fef097c2b4224a47de1802a6d0c369 100644 (file)
--- a/nethack.plp
+++ b/nethack.plp
@@ -21,7 +21,7 @@ Html({
 
 <:
 use Shiar_Sheet::Keyboard 2;
-my $info = do 'nethack.eng.inc.pl' or die $@;
+my $info = Data('nethack.eng');
 my $keys = Shiar_Sheet::Keyboard->new($info);
 $_->{"\e"} = ['me mode'] for values %{ $info->{def} };
        # static reset button, even though it's not (officially) in the game

diff --git a/perl.plp b/perl.plp
index 41768c156d7b228cd74d932f63c3410cb1cddb7a..6f2dd93b7344b3a281684bd0a849873576e263a3 100644 (file)
--- a/perl.plp
+++ b/perl.plp
@@ -17,7 +17,7 @@ Html({
 <p>The most significant features introduced for recent versions of the Perl
 scripting language.
 <:
-my $info = do 'perl.inc.pl' or die $@ // $!;
+my $info = Data('perl');
 
 say "Depending on desired compatibility you'll want to support a minimum of";
 say join(' or ', map {

diff --git a/readline.plp b/readline.plp
index 7c0bcb4756b00038ba8e18dfc5c155dc99179fea..063771e477fd34bf317dfb5bc3da24d4dd2eddc2 100644 (file)
--- a/readline.plp
+++ b/readline.plp
@@ -21,7 +21,7 @@ Html({
 
 <:
 use Shiar_Sheet::Keyboard 2;
-my $info = do 'readline.eng.inc.pl' or die $@;
+my $info = Data('readline.eng');
 my $keys = Shiar_Sheet::Keyboard->new($info);
 $keys->map($get{map}) or undef $get{map};
 $keys->print_rows($get{rows} || '^x=213', [4,3,2]);

diff --git a/sc.plp b/sc.plp
index 87befbd5ec897ab90425e14c846163004d3ace2b..8d021b793a7eec2e2ffdcee31df65a3146077a65 100644 (file)
--- a/sc.plp
+++ b/sc.plp
@@ -34,7 +34,7 @@ if (ref $requestver ne 'HASH') {
 }
 
 my %scver = %{$requestver};
-my $datafile = "sc-units-$Request.inc.pl";
+my $datafile = "sc-units-$Request";
 
 Html({
        title => "$scver{title} unit cheat sheet",
@@ -54,13 +54,12 @@ Html({
        ],
        stylesheet => [qw( light dark )],
        raw => '<link rel="stylesheet" type="text/css" media="all" href="/sc.css?1.2">',
-       data => [$datafile],
+       data => ["$datafile.inc.pl"],
 });
 
 say "<h1>$scver{game} units</h1>\n";
 
-my $units = do $datafile;
-Abort("Cannot open unit data", 501, $_) for $@ || $! || ();
+my $units = Data($datafile);
 my $patch = shift @{$units}
        or Abort("Cannot open unit data: metadata not found", 501);
 

diff --git a/screen.plp b/screen.plp
index 6f88b0a4ae34bb066401a2f581ac7e2ee2f1910c..3e61f0b967c9e7744e38940bbc62e06b417e268d 100644 (file)
--- a/screen.plp
+++ b/screen.plp
@@ -22,7 +22,7 @@ Html({
 
 <:
 use Shiar_Sheet::Keyboard 2;
-my $info = do 'screen.eng.inc.pl' or die $@ // $!;
+my $info = Data('screen.eng');
 my $keys = Shiar_Sheet::Keyboard->new($info);
 $keys->map($get{map}) or undef $get{map};
 $keys->print_rows($get{rows});

diff --git a/shell.plp b/shell.plp
index dd5f295e510176083004b864fa43c6e067d2da1f..75ea57e2ddc97953f612724ad7ad283a04a4678d 100644 (file)
--- a/shell.plp
+++ b/shell.plp
@@ -10,7 +10,7 @@ Html({
 
 say "<h1>Shell compatibility</h1>\n";
 
-my $data = do 'shell.inc.pl' or die $@ || $!;
+my $data = Data('shell');
 my @agents = keys %{ $data->{agents} };
 
 print '<table class="mapped">';

diff --git a/termcol.plp b/termcol.plp
index 1d9095fea9518cef25ab5d0367dd449a51f788d6..0e7c569b80b38b27c5ba8a70ebe616e32265ff95 100644 (file)
--- a/termcol.plp
+++ b/termcol.plp
@@ -44,8 +44,7 @@ use Shiar_Sheet::Colour 1.04;
 use List::Util qw( min max );
 use POSIX qw( ceil );
 
-my $palettes = do 'termcol.inc.pl';
-Abort("Cannot open palette data", 501, $_) for $@ || $! || ();
+my $palettes = Data('termcol');
 
 sub colcell {
        my $name = shift // return "<td>\n";

diff --git a/unicode.plp b/unicode.plp
index d710b0edd85df4a42b1dc873547e46101268ce34..0ba7c3f46cdc8975bea9ec67006ea751062f42c4 100644 (file)
--- a/unicode.plp
+++ b/unicode.plp
@@ -129,7 +129,7 @@ splice @config, 4, 2, qw(
 
 $_ and m{/*+(.+)} and @config = split /[ ]/, $1 for $Request, $get{q};
 
-my $tables = do 'unicode-table.inc.pl' or die $@ || $!;
+my $tables = Data('unicode-table');
 
 $glyphs->print(map {
        $_ = /(.*)\?(.*)/ ? ($verbose ? $2 : $1) : $_;

diff --git a/vi.plp b/vi.plp
index cf4488dc68f0e8f003b4d19bfa09db6ad7821ff6..c5e202528e73899fe46b00f73ced2ccc2f1b88f7 100644 (file)
--- a/vi.plp
+++ b/vi.plp
@@ -21,7 +21,7 @@ Html({
 
 <:
 use Shiar_Sheet::Keyboard 2.07;
-my $info = do 'vi.eng.inc.pl' or die $@;
+my $info = Data('vi.eng');
 my $keys = Shiar_Sheet::Keyboard->new($info);
 $keys->map($get{map}) or undef $get{map};
 $keys->print_rows($get{rows});

diff --git a/vimperator.plp b/vimperator.plp
index 08ea859b47b15126d8b097eb9d40783730c8b462..624f4129f034a75d15e0c0e677727f8f8a3ca82e 100644 (file)
--- a/vimperator.plp
+++ b/vimperator.plp
@@ -22,7 +22,7 @@ Html({
 
 <:
 use Shiar_Sheet::Keyboard 2.07;
-my $info = do 'vimperator.eng.inc.pl' or die $@;
+my $info = Data('vimperator.eng');
 my $keys = Shiar_Sheet::Keyboard->new($info);
 $keys->map($get{map}) or undef $get{map};
 $keys->print_rows($get{rows});

diff --git a/word.plp b/word.plp
index 977545f74e847200d87e42eacc1586aebee74be5..6b42866629fa8fccc8cda75e26252604868767a7 100644 (file)
--- a/word.plp
+++ b/word.plp
@@ -13,7 +13,6 @@ if ($Request and $Request =~ m{\A([^/]+)}) {
        }
 }
 
-my $wordlist = "$wordlistbase.inc.pl";
 my $limit = $get{v} // (exists $get{v} ? 5 : 3);
 
 Html({
@@ -23,7 +22,7 @@ Html({
        keywords => [qw'
                language
        '],
-       data => [$wordlist],
+       data => ["$wordlistbase.inc.pl"],
        raw => exists $get{q} ? <<'EOT' : undef,
 <style>
 .gallery figure {
@@ -62,7 +61,7 @@ Zie ook <a href="/dieren">dieren</a>.
 </p>
 
 <:
-my $table = do $wordlist or die $@ // $!;
+my $table = Data($wordlistbase);
 
 sub showimg {
        my ($id, $name) = @_;

diff --git a/writing.plp b/writing.plp
index fc0a923112dbf0f9e9058ffd5a6a70bfd8b9c875..82049fee1ad1853273f85426247793df9a07b1fc 100644 (file)
--- a/writing.plp
+++ b/writing.plp
@@ -35,7 +35,7 @@ unless (exists $get{v}) {
        $glyphs->{style} = 'univer';
 }
 
-my $scriptname = do 'writing-script.inc.pl';
+my $scriptname = eval { Data('writing-script') }; # optional translations
 $_ = showlink($_, "/latin") for $scriptname->{latn} || ();
 
 for (
@@ -43,12 +43,11 @@ for (
        [brah => 'Brahmi'],
 ) {
        my ($source, $title) = @$_;
-       my @table = do "writing-$source.inc.pl";
-       if ($! or $@) {
+       my @table = eval { Data("writing-$source") } or do {
                say "<h2>$title</h2>";
-               printf "<p>Table data not found: <em>%s</em>.</p>\n", $@ || $!;
+               printf "<p>%s: <em>%s</em>.</p>\n", @{$@};
                next;
-       }
+       };
        $glyphs->print($title => [map {
                my $lead = s/^(-)// && $1;
                ref $_ eq 'ARRAY' ? @$_ : map { ".>$lead$_" }