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 Html({
  36         title => $pageinfo->{title}.' cheat sheet',
  37         version => '1.2',
  38         lang => 'nl',
  39         description => "Tabeloverzicht met afbeeldingen van $pageinfo->{intro}",
  40         keywords => [qw'
  41                 dier beest naam naamgeving woord taal nederlands gerelateerd
  42                 relatie vernoemd vernoeming combinatie samenstelling voorvoegsel onverwant
  43                 land zee lucht  animals dutch language
  44         '],
  45         image => 'dieren.jpg',
  46         raw => <<"EOT",
  47 <style>
  48 figure[hidden] {
  49         opacity: 0; /* secret */
  50         transition: opacity 1s 0s;
  51         display: block;
  52 }
  53 figure[hidden]:hover {
  54         opacity: 1;
  55         transition-delay: 1s;
  56 }
  57 figure[hidden]:hover > figcaption {
  58         transition-delay: 2s;
  59 }
  60
  61 \@media (max-width: 60em) {
  62         td, th {
  63                 font-size: 50%;
  64         }
  65         figcaption small {
  66                 display: none;
  67         }
  68         th:first-child {
  69                 display: none;
  70         }
  71 }
  72 </style>
  73 EOT
  74 });
  75
  76 :>
  77 <h1>Dierennamen <small lang=en>(Dutch animal names)</small></h1>
  78
  79 <p>
  80 <:
  81 say ucfirst $pageinfo->{intro};
  82 say $pageinfo->{altlink};
  83 :>
  84 </p>
  85
  86 <:
  87 my $table = Data('dieren');
  88
  89 if (exists $get{r}) {
  90         use List::MoreUtils qw( part );
  91         my @trans = (part { state $col; /^#?>/ ? ($col = 0) : ++$col } @{$table});
  92         $table = [];
  93         for (@trans) {
  94                 unshift @$_, '?:' if $_->[0] !~ /:$/;
  95                 $_->[0] =~ s/^#?\K>?/>>/;
  96                 for (@$_) {
  97                         push @$table, s/^#?\K>/$1/r;
  98                 }
  99         }
 100 }
 101
 102 for my $prefix ($pageinfo->{prefix}) {
 103         for my $col ($pageinfo->{colfilter} // ()) {
 104                 @{$table} = grep { $_->[$col] =~ $prefix } @{$table};
 105         }
 106         $_ = [ grep { s/$prefix// } @{$_} ] for @{$table};
 107 }
 108
 109 say '<table class="gallery">';
 110 for my $row (@{$table}) {
 111         print '<tr>';
 112         for my $name (@{$row}) {
 113                 my $hidden = $name =~ s/^\?//;
 114                 $name =~ s/#.*//; # ignore prefixed part
 115                 $name =~ s/^-$//;
 116                 my ($img) = $name =~ /([\w-]+)/;
 117                 $name =~ y/_/ /;
 118                 if ($name =~ s/:$//) {
 119                         # trailing colon indicates header text
 120                         print "<th>$name</th>";
 121                         next;
 122                 }
 123                 print '<td>';
 124                 my $alt = $1 if $name =~ s/=(.*)//;
 125                 $name = "<q>$name</q>" if $name =~ s/\?$//;
 126                 $name .= " <small>($alt)</small>" if $alt;
 127
 128                 printf '<figure%s>', $hidden && !$pageinfo->{secrets} && ' hidden';
 129                 if ($img and -e ($img = lc "data/dieren/$img.jpg")) {
 130                         printf '<img src="/%s"', $img;
 131                         printf ' alt="%s"', $alt || $name;
 132                         print ' />';
 133                         print "<figcaption>$name</figcaption>";
 134                 }
 135                 elsif ($hidden) {
 136                         printf '<figcaption>%s</figcaption>', "$name?";
 137                 }
 138                 else {
 139                         print $name;
 140                 }
 141                 print '</figure>';
 142                 print '</td>';
 143         }
 144         say '</tr>';
 145 }
 146 say '</table>';