<:
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
use open ':std' => ':utf8';
use File::stat 'stat';
use HTTP::Date;
use Shiar_Sheet::KeySigns qw(%sign); # dependant on $get{ascii}
our $style;
our $showkeys = !exists $get{keys} ? undef :
($get{keys} ne '0' && ($get{keys} || 'always'));
$header{content_type} = 'text/html; charset=utf-8';
sub stylesheet {
my %styles = map {$_ => $_} @_;
if (exists $get{style}) {
$style = $styles{ $get{style} };
require CGI::Cookie;
AddCookie(CGI::Cookie->new(
-name => 'style',
-value => $style,
-path => '/', # site-wide; current page is confusing to most users
-expires => $style ? '+5y' : '-1d',
)->as_string);
}
$style ||= exists $cookie{style} && $styles{ $cookie{style} } || $_[0];
return join "\n", map { sprintf(
'',
$_ eq $style ? 'stylesheet' : 'alternate stylesheet', "/$_.css", $_
) } @_;
}
sub checkmodified {
my $lastmod;
for (@_) {
my $mod = stat $_ or next;
$mod = $mod->mtime or next;
$lastmod = $mod if $mod gt $lastmod;
}
for ($ENV{HTTP_IF_MODIFIED_SINCE} || ()) {
next if str2time($_) < $lastmod;
$header{status} = '304 Same old';
exit;
}
$header{'Last-Modified'} = time2str($lastmod);
}
sub Html {
my ($meta) = @_;
# announce and check data modification
checkmodified(
$ENV{SCRIPT_FILENAME},
(grep { /\bShiar_/ } values %INC),
$meta->{data} ? @{ $meta->{data} } : (),
);
# default fallbacks
$meta->{stylesheet} ||= [qw'light dark circus mono red terse'];
$meta->{charset} ||= 'utf-8';
# optional amends
push @{ $meta->{raw} }, (
'',
'',
!$showkeys ? ''
: $showkeys eq 'ghost' ? ''
: (),
'',
) 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->{rawstyle}, $meta->{raw};
ref $_ eq 'ARRAY' and $_ = stylesheet(@$_)."\n" for $meta->{stylesheet};
# other vars
my $sep = $meta->{charset} eq 'utf-8' ? '•' : ' -- ';
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};
# prepare trailing output
PLP_END {
print <<"EOT";
EOT
};
}