git.rot13.org Git - webpac2/blob - vhost/webpac2.cgi

   1 #!/usr/bin/perl
   2
   3 use warnings;
   4 use strict;
   5
   6 use CGI qw/:standard/;
   7 use CGI::Carp qw/fatalsToBrowser/;
   8 use File::Slurp;
   9 use YAML;
  10 use Search::Estraier;
  11 use Data::Page;
  12 use Data::Dump qw/dump/;
  13
  14 my $range_around = 5;
  15 my $entries_per_page = 30;
  16 my $debug = param('debug');
  17
  18 print header;
  19
  20 sub dump_yaml {
  21         my $name = shift;
  22         print qq|<pre># $name\n|, YAML::Dump( @_ ), qq|</pre>| if $debug;
  23 }
  24
  25 sub show_pager {
  26         my ($pager) = @_;
  27
  28         my @show_pages;
  29         my $after_current = 0;
  30
  31         if ( $pager->current_page <= $range_around + 2 ) {
  32                 @show_pages = ( $pager->first_page .. $pager->current_page );
  33                 $after_current = $range_around - $pager->current_page;
  34         } else {
  35                 @show_pages = ( $pager->first_page, '', $pager->current_page - $range_around .. $pager->current_page );
  36         }
  37
  38         if ( $pager->current_page + $after_current + $range_around + 1 >= $pager->last_page ) {
  39                 push @show_pages, ( $pager->current_page + 1 .. $pager->last_page );
  40         } else {
  41                 push @show_pages, ( $pager->current_page + 1 .. $pager->current_page + $after_current + $range_around, '', $pager->last_page );
  42         }
  43
  44 #       dump_yaml( 'show_pages', \@show_pages );
  45
  46         return '' unless $#show_pages;
  47
  48         my ( $prev, $next ) = ( '&lt;&lt;', '&gt;&gt;' );
  49
  50         sub li_a_href {
  51                 my ( $page, $label, $attr ) = @_;
  52                 param( 'current_page', $page );
  53                 my $url = self_url( -query => 1 );
  54                 $attr ||= '';
  55                 $label ||= $page;
  56                 qq|<li$attr><a href="$url" title="$page">$label</a></li>|;
  57         }
  58
  59         return
  60                   $pager->previous_page ? li_a_href( $pager->previous_page, $prev ) : qq|<li class=skip>$prev</li>|
  61                 , ( map {
  62                         if ( $_ == $pager->current_page ) {
  63                                 qq|<li class=current_page>$_</li>|;
  64                         } elsif ( $_ eq '' ) {
  65                                 qq|<li class=skip>...</li>|;
  66                         } else {
  67                                 li_a_href( $_ );
  68                         }
  69                 } @show_pages )
  70                 , $pager->next_page ? li_a_href( $pager->next_page, $next ) : qq|<li class=skip>$next</li>|
  71                 ;
  72
  73 }
  74
  75 my $path = $ENV{PATH_INFO} || 'ecas';
  76 my $dir = $0;
  77 $dir =~ s{/[^/]+.cgi}{};
  78
  79 my $config = YAML::LoadFile( "$dir/$path/config.yml" );
  80
  81 my $database = (keys %{ $config->{databases} })[0];
  82 die "$database not in $path" unless $path =~ m{\Q$database\E};
  83
  84 my $html_markup = "$dir/$path/html.pm";
  85 my $html_markup_skip;
  86 if ( -e $html_markup ) {
  87         require $html_markup;
  88         $html_markup = $database . '::html';
  89 } else {
  90         undef $html_markup;
  91 }
  92
  93 my $estraier = YAML::LoadFile( "$dir/../var/estraier/$database.yaml" );
  94
  95 my $db = $config->{databases}->{$database};
  96
  97 my @attr = keys %{ $estraier->{attr} }; # FIXME replace with real gnerated lookup
  98
  99 print
 100         start_html(
 101                 -title => $db->{name},
 102                 -style => '../../style.css',
 103         ),
 104         h1( $db->{name} ),
 105         qq|<div id=description>|, $db->{description}, qq|</div>|,
 106         start_form( -action => self_url( query => 0 ) ),
 107                 radio_group(
 108                         -name => 'attr',
 109                         -values => [ @attr ],
 110 #                       -linebreak => 0,
 111                 ),
 112                 textfield( -name => 'search' ),
 113                 submit,
 114                 textfield( -name => 'entries_per_page', -default => $entries_per_page ),
 115                 textfield( -name => 'current_page', -default => 1 ),
 116 ;
 117
 118 print   end_form;
 119
 120 if ( my $search = param('search') ) {
 121
 122         print qq|<div id="results">|;
 123
 124         my $node = Search::Estraier::Node->new(
 125                 url => $config->{hyperestraier}->{masterurl} . '/node/' . $database,
 126                 croak_on_error => 1,
 127         );
 128
 129         param( 'entries_per_page', $entries_per_page ) unless param('entries_per_page'); # FIXME not needed?
 130         my $pager = Data::Page->new;
 131         $pager->total_entries( param('current_page') * param('entries_per_page') );
 132         $pager->$_( param($_) ) foreach ( qw/entries_per_page current_page/ );
 133
 134         dump_yaml( 'pager', $pager );
 135
 136         my $cond = Search::Estraier::Condition->new;
 137         $cond->set_phrase( $search );
 138         $cond->set_skip( $pager->skipped );
 139         $cond->set_max(  $pager->entries_per_page );
 140         my $nres = $node->search( $cond, 0 );
 141         $pager->total_entries( $nres->hits );
 142
 143
 144         dump_yaml( 'cond', $cond );
 145
 146         if ( ! $nres ) {
 147                 my $no_results = "No results for search '%s'";
 148                 printf qq|<div class="error">$no_results</div>\n\n|, $search;
 149         } else {
 150
 151                 my $results = "%d results for search '%s' showing results %d - %d on page %d";
 152                 printf qq|<div class="message">$results</div>\n\n|, $nres->hits, $search, $pager->first, $pager->last, $pager->current_page;
 153
 154                 dump_yaml( 'pager html', show_pager( $pager ));
 155
 156                 my $pager_html = join("\n", show_pager( $pager ));
 157
 158                 print qq|<ul class="pager">$pager_html</ul>\n\n| if $pager_html;
 159
 160                 my $start = $pager->first;
 161                 print qq|<ol start=$start>\n|;
 162
 163                 foreach my $i ( 1 .. $nres->doc_num ) {
 164                         my $rdoc = $nres->get_doc( $i - 1 );
 165                         print qq|<li>|;
 166                         foreach my $attr ( @attr ) {
 167                                 my $v = $rdoc->attr( $attr );
 168                                 if ( defined $v && $html_markup && ! $html_markup_skip->{$attr} ) {
 169                                         eval "\$v = $html_markup->$attr( \$v );";
 170                                         if ( $@ ) {
 171                                                 warn "disable html markup for $attr: $@";
 172                                                 $html_markup_skip->{$attr} = $@;
 173                                         }
 174                                 }
 175                                 next unless defined $v;
 176                                 print qq|<div><label>$attr</label><span class=$attr>$v</span></div>\n|;
 177                         }
 178                         print qq|</li>\n|;
 179                 }
 180                 print qq|</ol>\n\n|;
 181
 182                 print qq|<ul class="pager bottom">$pager_html</ul>\n\n| if $pager_html;
 183         }
 184         print qq|</div>|;
 185
 186         dump_yaml( 'pager', $pager );
 187
 188 }
 189
 190 dump_yaml( 'estraier', $estraier );
 191 dump_yaml( 'db', $db );
 192 dump_yaml( 'html_markup_skip', $html_markup_skip );
 193
 194 print   end_html;