X-Git-Url: http://git.shiar.nl/sheet.git/blobdiff_plain/81aefba6ac586eccbe18b4e90efc175e34fff5ad..7713d82f979bdb6eb47c41b4e3b2ce198b6acd2a:/common.inc.plp diff --git a/common.inc.plp b/common.inc.plp index 54356fb..58d0964 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 @@ -12,8 +12,14 @@ use HTTP::Date; $PLP::ERROR = sub { my ($text, $html) = @_; print '

Fatal error: '.$html."

\n\n"; + warn $text; }; +BEGIN { + require Time::HiRes; + our $Time = [Time::HiRes::gettimeofday]; +} + our $style; our $showkeys = !exists $get{keys} ? undef : ($get{keys} ne '0' && ($get{keys} || 'always')); @@ -21,7 +27,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 +45,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.7", $_ - ) } @_; + $_ 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,7 +85,9 @@ sub Html { $meta->{stylesheet} ||= [qw'light dark circus mono red terse']; $meta->{charset} ||= 'utf-8'; - ref $_ eq 'ARRAY' or $_ = [$_] for $meta->{raw}; + # convert options to arrays + ref $_ eq 'ARRAY' or $_ = [$_] + for grep {$_} $meta->{raw}, $meta->{description}, $meta->{keywords}; # optional amends push @{ $meta->{raw} }, ( @@ -89,13 +99,8 @@ 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 $Dev = $ENV{HTTP_HOST} =~ /\bdev\./; my ($file) = $ENV{SCRIPT_FILENAME} =~ m{ ([^/]+) \.plp$ }x; # leading output @@ -107,16 +112,19 @@ sub Html { $meta->{title} - - - - EOT - print $_, "\n" for $meta->{stylesheet} || (); - print $_, "\n" for $meta->{raw} || (); - print qq{\n\n\n}; - - # dev indicator + 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 qq{\n\n}; + + # development version indicator printf '

beta

', join('; ', 'position: fixed', 'right: 1em', @@ -125,7 +133,7 @@ EOT 'border-width: 1ex 0', 'z-index: 1', 'background: inherit', - ) if $ENV{HTTP_HOST} =~ /\bdev\./; + ) if $Dev; # prepare trailing output PLP_END { @@ -133,15 +141,16 @@ EOT - - EOT + say sprintf '• %.3fs', Time::HiRes::tv_interval($Time) if $Dev; + say '

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