dieren.plp

   1 <(common.inc.plp)><:
   2 use warnings;
   3 no warnings 'qw';
   4
   5 my $intro = 'dieren die in het Nederlands vernoemd zijn naar andere dieren.';
   6 my %subpages = (
   7         standaard => {
   8                 title => 'dieren',
   9                 intro => $intro,
  10                 altlink => 'Zie ook <a href="/dieren/uitgebreid">verdergezochte verbanden</a>' .
  11                            ' of het <a href="/dieren/beknopt">beknopte overzicht</a>.',
  12                 prefix => qr/^(?!#)\+?/, # no # optional +
  13                 colfilter => 0,
  14         },
  15         uitgebreid => {
  16                 title => 'uitgebreid dieren',
  17                 intro => "$intro.. en dergelijke.",
  18                 altlink => 'Zie het <a href="/dieren">populaire overzicht</a> voor minder.',
  19                 prefix => qr/.*?[#]|^[#+]*/, # after optional # or +
  20                 secrets => 1,
  21         },
  22         beknopt => {
  23                 title => 'beknopt dieren',
  24                 intro => "een aantal $intro",
  25                 altlink => 'Zie het <a href="/dieren">populaire overzicht</a> voor meer.',
  26                 prefix => qr/^\+/, # only +
  27                 colfilter => 1,
  28         },
  29 );
  30
  31 $Request ||= 'standaard';
  32 my $pageinfo = $subpages{$Request}
  33         or Html(), Abort("Onbekende dierenpagina <q>$Request</q>", '404 request not found');
  34
  35 my $proto = sprintf('http%s://', !!$ENV{HTTPS} && 's');
  36 my $preview = "$proto$ENV{HTTP_HOST}/dieren.jpg";
  37
  38 Html({
  39         title => $pageinfo->{title}.' cheat sheet',
  40         version => '1.1',
  41         lang => 'nl',
  42         description => "Tabeloverzicht met afbeeldingen van $pageinfo->{intro}",
  43         keywords => [qw'
  44                 dier beest naam naamgeving woord taal nederlands gerelateerd
  45                 relatie vernoemd vernoeming combinatie samenstelling voorvoegsel onverwant
  46                 land zee lucht  animals dutch language
  47         '],
  48         raw => <<"EOT",
  49 <meta property="og:image" content="$preview" />
  50 <style>
  51 figure[hidden] {
  52         opacity: 0; /* secret */
  53         transition: opacity 1s 0s;
  54         display: block;
  55 }
  56 figure[hidden]:hover {
  57         opacity: 1;
  58         transition-delay: 1s;
  59 }
  60 figure[hidden]:hover > figcaption {
  61         transition-delay: 2s;
  62 }
  63
  64 \@media (max-width: 60em) {
  65         td, th {
  66                 font-size: 50%;
  67         }
  68         figcaption small {
  69                 display: none;
  70         }
  71         th:first-child {
  72                 display: none;
  73         }
  74 }
  75 </style>
  76 EOT
  77 });
  78
  79 :>
  80 <h1>Dierennamen <small lang=en>(Dutch animal names)</small></h1>
  81
  82 <p>
  83 <:
  84 say ucfirst $pageinfo->{intro};
  85 say $pageinfo->{altlink};
  86 :>
  87 </p>
  88
  89 <:
  90 my $table = Data('dieren');
  91
  92 if (exists $get{r}) {
  93         use List::MoreUtils qw( part );
  94         my @trans = (part { state $col; /^#?>/ ? ($col = 0) : ++$col } @{$table});
  95         $table = [];
  96         for (@trans) {
  97                 unshift @$_, '?:' if $_->[0] !~ /:$/;
  98                 $_->[0] =~ s/^#?\K>?/>>/;
  99                 for (@$_) {
 100                         push @$table, s/^#?\K>/$1/r;
 101                 }
 102         }
 103 }
 104
 105 for my $prefix ($pageinfo->{prefix}) {
 106         for my $col ($pageinfo->{colfilter} // ()) {
 107                 @{$table} = grep { $_->[$col] =~ $prefix } @{$table};
 108         }
 109         $_ = [ grep { s/$prefix// } @{$_} ] for @{$table};
 110 }
 111
 112 say '<table class="gallery">';
 113 for my $row (@{$table}) {
 114         print '<tr>';
 115         for my $name (@{$row}) {
 116                 my $hidden = $name =~ s/^\?//;
 117                 $name =~ s/#.*//; # ignore prefixed part
 118                 $name =~ s/^-$//;
 119                 my ($img) = $name =~ /([\w-]+)/;
 120                 $name =~ y/_/ /;
 121                 if ($name =~ s/:$//) {
 122                         # trailing colon indicates header text
 123                         print "<th>$name</th>";
 124                         next;
 125                 }
 126                 print '<td>';
 127                 my $alt = $1 if $name =~ s/=(.*)//;
 128                 $name = "<q>$name</q>" if $name =~ s/\?$//;
 129                 $name .= " <small>($alt)</small>" if $alt;
 130
 131                 printf '<figure%s>', $hidden && !$pageinfo->{secrets} && ' hidden';
 132                 if ($img and -e ($img = "data/dieren/$img.jpg")) {
 133                         printf '<img src="/%s"', $img;
 134                         printf ' alt="%s"', $alt || $name;
 135                         print ' />';
 136                         print "<figcaption>$name</figcaption>";
 137                 }
 138                 elsif ($hidden) {
 139                         printf '<figcaption>%s</figcaption>', "$name?";
 140                 }
 141                 else {
 142                         print $name;
 143                 }
 144                 print '</figure>';
 145                 print '</td>';
 146         }
 147         say '</tr>';
 148 }
 149 say '</table>';