From: Mischa POSLAWSKY <perl@shiar.org>
Date: Thu, 26 May 2022 12:15:04 +0000 (+0200)
Subject: common: global Data() to parse perl code includes
X-Git-Url: http://git.shiar.nl/sheet.git/commitdiff_plain/58725794d72361cc70cb082476a32d08e22d21d0

common: global Data() to parse perl code includes

Same error reporting and possible upcoming extension.
---

diff --git a/apl.plp b/apl.plp
index 929c424..d01d3ed 100644
--- 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 5811594..6d75d4a 100644
--- 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 e43099e..e106eb4 100644
--- 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 eb23d7e..2eb601f 100644
--- 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 d8653e8..96cd427 100644
--- 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 1ce4611..3424695 100644
--- 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 71c5c13..39865bd 100644
--- 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 e404ae5..efd2f25 100644
--- 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 163ee10..a55b49a 100644
--- 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 7106c7f..2f57b36 100644
--- 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 41e4c12..690f9e3 100644
--- 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 30a4234..cb6cd35 100644
--- 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 a86f2ca..cac0e92 100644
--- 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 206de5e..e40d37c 100644
--- 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 077c7c5..f7b4445 100644
--- 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 bac469f..09918ee 100644
--- 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 8a49a3d..5e676d9 100644
--- 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 41768c1..6f2dd93 100644
--- 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 7c0bcb4..063771e 100644
--- 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 87befbd..8d021b7 100644
--- 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 6f88b0a..3e61f0b 100644
--- 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 dd5f295..75ea57e 100644
--- 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 1d9095f..0e7c569 100644
--- 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 d710b0e..0ba7c3f 100644
--- 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 cf4488d..c5e2025 100644
--- 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 08ea859..624f412 100644
--- 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 977545f..6b42866 100644
--- 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 fc0a923..82049fe 100644
--- 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$_" }