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
  12 print header;
  13
  14 sub dump_yaml {
  15         my $name = shift;
  16         print qq|<pre># $name\n|, YAML::Dump( @_ ), qq|</pre>|;
  17 }
  18
  19 my $path = $ENV{PATH_INFO} || 'ecas';
  20 my $dir = $0;
  21 $dir =~ s{/[^/]+.cgi}{};
  22
  23 my $config = YAML::LoadFile( "$dir/$path/config.yml" );
  24
  25 my $database = (keys %{ $config->{databases} })[0];
  26 die "$database not in $path" unless $path =~ m{\Q$database\E};
  27
  28 my $html_markup = "$dir/$path/html.pm";
  29 my $html_markup_skip;
  30 if ( -e $html_markup ) {
  31         require $html_markup;
  32         $html_markup = $database . '::html';
  33 } else {
  34         undef $html_markup;
  35 }
  36
  37 my $estraier = YAML::LoadFile( "$dir/../var/estraier/$database.yaml" );
  38
  39 my $db = $config->{databases}->{$database};
  40
  41 my @attr = keys %{ $estraier->{attr} }; # FIXME replace with real gnerated lookup
  42
  43 print
  44         start_html(
  45                 -title => $db->{name},
  46                 -style => '../../style.css',
  47         ),
  48         h1( $db->{name} ),
  49         qq|<div id=description>|, $db->{description}, qq|</div>|,
  50         start_form,
  51                 radio_group(
  52                         -name => 'attr',
  53                         -values => [ @attr ],
  54 #                       -linebreak => 0,
  55                 ),
  56                 textfield( -name => 'search' ),
  57                 submit
  58 ;
  59
  60 print   end_form;
  61
  62 if ( my $search = param('search') ) {
  63
  64         print qq|<div id="results">|;
  65
  66         my $node = Search::Estraier::Node->new(
  67                 url => $config->{hyperestraier}->{masterurl} . '/node/' . $database,
  68                 croak_on_error => 1,
  69         );
  70
  71         my $cond = Search::Estraier::Condition->new;
  72         $cond->set_phrase( $search );
  73         my $nres = $node->search( $cond, 0 );
  74
  75         if ( ! $nres ) {
  76                 my $no_results = "No results for search '%s'";
  77                 printf qq|<div class="error">$no_results</div>|, $search;
  78         } else {
  79                 my $results = "Got %d results for search '%s'";
  80                 printf qq|<div class="message">$results</div>|, $nres->hits, $search;
  81
  82                 print qq|<ol>|;
  83
  84                 foreach my $i ( 1 .. $nres->doc_num ) {
  85                         my $rdoc = $nres->get_doc( $i - 1 );
  86                         print qq|<li>|;
  87                         foreach my $attr ( @attr ) {
  88                                 my $v = $rdoc->attr( $attr );
  89                                 if ( defined $v && $html_markup && ! $html_markup_skip->{$attr} ) {
  90                                         eval "\$v = $html_markup->$attr( \$v );";
  91                                         if ( $@ ) {
  92                                                 warn "disable html markup for $attr: $@";
  93                                                 $html_markup_skip->{$attr} = $@;
  94                                         }
  95                                 }
  96                                 next unless defined $v;
  97                                 print qq|<div><label>$attr</label><span class=$attr>$v</span></div>\n|;
  98                         }
  99                         print qq|</li>\n|;
 100                 }
 101                 print qq|</ol>|;
 102         }
 103         print qq|</div>|;
 104 }
 105
 106 dump_yaml( 'estraier', $estraier );
 107 dump_yaml( 'db', $db );
 108 dump_yaml( 'html_markup_skip', $html_markup_skip );
 109
 110 print   end_html;