<(common.inc.plp)><: use warnings; no warnings 'qw'; my $intro = 'dieren die in het Nederlands vernoemd zijn naar andere dieren.'; my %subpages = ( standaard => { title => 'dieren', intro => $intro, altlink => 'Zie ook verdergezochte verbanden' . ' of het beknopte overzicht.', }, uitgebreid => { title => 'uitgebreid dieren', intro => "$intro.. en dergelijke.", altlink => 'Zie het populaire overzicht voor minder.', prefix => '#', secrets => 1, }, beknopt => { title => 'beknopt dieren', intro => "een aantal $intro", altlink => 'Zie het populaire overzicht voor meer.', }, ); $Request ||= 'standaard'; my $pageinfo = $subpages{$Request} or Html(), Abort("Onbekende dierenpagina $Request", '404 request not found'); Html({ title => $pageinfo->{title}.' cheat sheet', version => '1.0', description => "Tabeloverzicht met afbeeldingen van $pageinfo->{intro}", keywords => [qw' dier beest naam naamgeving woord taal nederlands gerelateerd relatie vernoemd vernoeming combinatie samenstelling voorvoegsel onverwant land zee lucht animals dutch language '], raw => <<'EOT', EOT }); :>

Dierennamen (Dutch animal names)

<: say ucfirst $pageinfo->{intro}; say $pageinfo->{altlink}; :>

<: my @table = qw( >: origineel: zee-: meer_water: land/aardig: anders: #: >hond: hond zeehond waterhond?? prairiehond vleerhond #rodehond >kat: kat zeekat meerkat cat_325? vliegende_kat #tijgerkat #>haas: haas zeehaas waterhaas koolhaas? ossenhaas? #buidelhaas >muis: muis zeemuis waterspitsmuis aardmuis vleermuis #computermuis >rat: rat zeerat waterrat woestijnrat buidelrat #beverrat >egel: egel zee-egel wateregel? aardegel?? mierenegel # >varken: varken zeevarken waterzwijn aardvarken stekelvarken # >koe: koe zeekoe meerkoetje aardekoe?? koedoe #haiku? >paard: paard zeepaardje nijlpaard aardpaard?? luipaard #tijgerpaard #>hoorn: eenhoorn zeehoorn zee-eenhoorn? bergahorn neushoorn #eekhoorn #>bra: bra(ssière)? zebra - - cobra #sabra #>olifant: olifant zeeolifant olifantsvis kamerolifant? - #olifantsoor >beer: beer zeebeer waterbeertje ijsbeer wasbeer #neusbeer >leeuw: leeuw zeeleeuw waterleeuw?? aardleeuw?? mierenleeuw # >wolf: wolf zeewolf waterwolf?? aardwolf korenwolf #buidelwolf >haan: haan zeehaan waterhaan rotshaan sprinkhaan #wilde_haan?? #>pad: pad zebrapad? waterpad? landpad schildpad #paddenstoel #>draak: draak zeedraak waterdraak - komododraak # #>vlo: vlo zeevlo watervlo aardvlo - #vlok? #>mot: mot marmot watermot bergamot - # #>bij: bij - waterbij aardbei moerbei hommelbij ); @table = qw( >hond zeehond prairiehond >kat zeekat meerkat >muis zeemuis vleermuis >egel zee-egel mierenegel >varken zeevarken stekelvarken >koe zeekoe meerkoetje >paard zeepaardje nijlpaard >olifant zeeolifant olifantsvis >beer zeebeer wasbeer >leeuw zeeleeuw mierenleeuw >wolf zeewolf korenwolf >haan zeehaan sprinkhaan >mot marmot bergamot ) if $Request eq 'beknopt'; if (exists $get{r}) { use List::MoreUtils qw( part ); my @trans = (part { state $col; /^#?>/ ? ($col = 0) : ++$col } @table); @table = (); for (@trans) { unshift @$_, '?:' if $_->[0] !~ /:$/; $_->[0] =~ s/^#?\K>?/>>/; for (@$_) { push @table, s/^#?\K>/$1/r; } } } say ''; while (my $name = shift @table) { if ($name =~ s/^#// and !$pageinfo->{prefix}) { while ($name = shift @table) { last if $name =~ m/^>/; } $name or next; } if ($name =~ s/^>//) { # leading dash starts a new row say '' if $name; print ""; } $name =~ s/^-$//; my ($img) = $name =~ /^([\w-]+)/; $name =~ y/_/ /; if ($name =~ s/:$//) { # trailing colon indicates header text print ""; next; } print ''; } say '
$name'; my $hidden = $name =~ s/\?$//; my $alt = $name; $name = "$name" if $name =~ s/\?$//; printf '', $hidden && !$pageinfo->{secrets} && ' hidden'; if ($img and -e ($img = "data/dieren/$img.jpg")) { my $alt = -l $img && readlink($img) =~ s/\.jpg$//r; if ($alt) { $name .= " ($alt)"; } else { $alt = $name; } printf '%s'; print "
$name
"; } elsif ($hidden) { printf '
%s
', "$name?"; } else { print $name; } print ''; print '
';