X-Git-Url: http://git.shiar.nl/sheet.git/blobdiff_plain/9522b4e1c44d0ac3dc7aafe54357b0b07c9c87cd..2a99bcdadec88d7483903e2c8420ad3e78fcb805:/common.inc.plp diff --git a/common.inc.plp b/common.inc.plp index f6cd6a6..31c2c22 100644 --- a/common.inc.plp +++ b/common.inc.plp @@ -1,6 +1,6 @@ <: +use 5.014; use utf8; -use strict; use warnings; no warnings 'qw'; # you know what you doing no warnings 'uninitialized'; # save some useless checks for more legible code @@ -8,12 +8,34 @@ use open ':std' => ':utf8'; use File::stat 'stat'; use HTTP::Date; +use Encode qw( decode_utf8 ); + +sub Alert { + my ($html, $debug) = @_; + ref $html eq 'ARRAY' or $html = [$html]; + my ($title, @lines) = @{$html}; + $body = "

$title

"; + $body .= "\n

$_

" for @lines; + $body .= "\n
$debug
" if $Dev and $debug; + say "
$body
\n"; +} $PLP::ERROR = sub { my ($text, $html) = @_; - print '

Fatal error: '.$html."

\n\n"; + Alert("Fatal error: $html."); + warn $text; }; +BEGIN { + require Time::HiRes; + our $Time = [Time::HiRes::gettimeofday]; +} + +# user request +our $Dev = $ENV{HTTP_HOST} =~ /\bdev\./; +our ($file) = $ENV{SCRIPT_FILENAME} =~ m{ ([^/]+) \.plp$ }x; +our $Request = decode_utf8($ENV{PATH_INFO} =~ s{^/}{}r); + our $style; our $showkeys = !exists $get{keys} ? undef : ($get{keys} ne '0' && ($get{keys} || 'always')); @@ -21,7 +43,9 @@ our $showkeys = !exists $get{keys} ? undef : $header{content_type} = 'text/html; charset=utf-8'; sub stylesheet { - my %styles = map {$_ => $_} @_; + my ($avail) = @_; + my @avail = ref $avail eq 'ARRAY' ? @{$avail} : $avail or return; + my %styles = map {$_ => $_} @avail; if (defined( my $setstyle = $get{style} )) { $style = $styles{ $setstyle }; @@ -37,16 +61,16 @@ sub stylesheet { } or warn "Unable to create style cookie: $@"; } - $style ||= exists $cookie{style} && $styles{ $cookie{style} } || $_[0]; + $style ||= exists $cookie{style} && $styles{ $cookie{style} } || $avail[0]; - return join "\n", map { sprintf( + return map { sprintf( '', - $_ eq $style ? 'stylesheet' : 'alternate stylesheet', "/$_.css?1.6", $_ - ) } @_; + $_ eq $style ? 'stylesheet' : 'alternate stylesheet', "/$_.css?1.9", $_ + ) } @avail; } sub checkmodified { - my $lastmod; + my $lastmod = 0; for (@_) { my $mod = stat $_ or next; $mod = $mod->mtime or next; @@ -77,6 +101,10 @@ sub Html { $meta->{stylesheet} ||= [qw'light dark circus mono red terse']; $meta->{charset} ||= 'utf-8'; + # convert options to arrays + ref $_ eq 'ARRAY' or $_ = [$_] + for grep {$_} $meta->{raw}, $meta->{description}, $meta->{keywords}; + # optional amends push @{ $meta->{raw} }, ( '', @@ -87,31 +115,37 @@ sub Html { '', ) if $meta->{keys}; - # flatten arrays - ref $_ eq 'ARRAY' and $_ = join ' ', @$_ for $meta->{description}; - ref $_ eq 'ARRAY' and $_ = join ', ', @$_ for $meta->{keywords}; - ref $_ eq 'ARRAY' and $_ = join "\n", @$_ for $meta->{raw}; - ref $_ eq 'ARRAY' and $_ = stylesheet(@$_)."\n" for $meta->{stylesheet}; - - # other vars - my ($file) = $ENV{SCRIPT_FILENAME} =~ m{ ([^/]+) \.plp$ }x; - # leading output $header{content_type} = "text/html; charset=$meta->{charset}"; - print <<"EOT"; - - - - - -$meta->{title} - - - -EOT - print $_, "\n" for $meta->{stylesheet} || (); - print $_, "\n" for $meta->{raw} || (); - print qq{\n\n\n}; + say ''; + say ''; + say ''; + say ''; + say sprintf '', $header{content_type}; + say sprintf '%s', $meta->{title}; + say sprintf '', EscapeHTML($_) + for join(' ', @{ $meta->{description} }) || (); + say sprintf '', EscapeHTML($_) + for join(', ', @{ $meta->{keywords} }) || (); + say ''; + say ''; + say for stylesheet($meta->{stylesheet}); + say for map { @{$_} } $meta->{raw} || (); + say '' if $Dev; + say ''; + say ''; + say sprintf '', $file; + + # development version indicator + printf '

beta

', 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 { @@ -119,15 +153,16 @@ EOT

sheet.shiar.nl/$file.plp - $meta->{version} created by • AGPLv3 -

- - EOT + say sprintf '• %.3fs', Time::HiRes::tv_interval($Time) if $Dev and $Time; + say '

'; + say ''; + say ''; }; }