#!/usr/bin/perl use warnings; use strict; use CGI qw/:standard/; use CGI::Carp qw/fatalsToBrowser/; use File::Slurp; use YAML; use Search::Estraier; use Data::Page; use Data::Dump qw/dump/; my $range_around = 5; my $entries_per_page = 30; print header; sub dump_yaml { my $name = shift; print qq|
# $name\n|, YAML::Dump( @_ ), qq||; } sub show_pager { my ($pager,$coderef) = @_; my @show_pages; my $after_current = 0; if ( $pager->current_page <= $range_around + 2 ) { @show_pages = ( $pager->first_page .. $pager->current_page ); $after_current = $range_around - $pager->current_page; } else { @show_pages = ( $pager->first_page, '', $pager->current_page - $range_around .. $pager->current_page ); } if ( $pager->current_page + $after_current + $range_around + 1 >= $pager->last_page ) { push @show_pages, ( $pager->current_page + 1 .. $pager->last_page ); } else { push @show_pages, ( $pager->current_page + 1 .. $pager->current_page + $after_current + $range_around, '', $pager->last_page ); } dump_yaml( 'show_pages', \@show_pages ); return '' unless $#show_pages; my ( $prev, $next ) = ( '<<', '>>' ); return $pager->previous_page ? $coderef->( $pager->previous_page, $prev ) : $prev , join( ' ', map { if ( $_ == $pager->current_page ) { qq|$_|; } elsif ( $_ eq '' ) { qq|...|; } else { $coderef->( $_ ); } } @show_pages ) , $pager->next_page ? $coderef->( $pager->next_page, $next ) : $next ; } my $path = $ENV{PATH_INFO} || 'ecas'; my $dir = $0; $dir =~ s{/[^/]+.cgi}{}; my $config = YAML::LoadFile( "$dir/$path/config.yml" ); my $database = (keys %{ $config->{databases} })[0]; die "$database not in $path" unless $path =~ m{\Q$database\E}; my $html_markup = "$dir/$path/html.pm"; my $html_markup_skip; if ( -e $html_markup ) { require $html_markup; $html_markup = $database . '::html'; } else { undef $html_markup; } my $estraier = YAML::LoadFile( "$dir/../var/estraier/$database.yaml" ); my $db = $config->{databases}->{$database}; my @attr = keys %{ $estraier->{attr} }; # FIXME replace with real gnerated lookup print start_html( -title => $db->{name}, -style => '../../style.css', ), h1( $db->{name} ), qq|