X-Git-Url: http://git.rot13.org/?a=blobdiff_plain;f=vhost%2Fwebpac2.cgi;h=12ca195d783e7c26f477c48445ae37c4b457f429;hb=f82cbd6b16b44d428d7a1a3876db2766d4521747;hp=812793595bc3f6aa836876a974535940cfb42b62;hpb=69577da33be9ae1baf558413c78037c2ed64189d;p=webpac2 diff --git a/vhost/webpac2.cgi b/vhost/webpac2.cgi index 8127935..12ca195 100755 --- a/vhost/webpac2.cgi +++ b/vhost/webpac2.cgi @@ -7,15 +7,75 @@ 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/; +use SWISH::API; +use JSON; -print header; +my $range_around = 5; +my $entries_per_page = 30; +my $debug = param('debug'); + +print header( + -charset => 'utf-8', +); sub dump_yaml { - print qq|
|, YAML::Dump( @_ ), qq|
|; + my $name = shift; + print qq|
# $name\n|, YAML::Dump( @_ ), qq|
| if $debug; } -my $path = $ENV{PATH_INFO}; +sub show_pager { + my ($pager) = @_; + + 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 ) = ( '<<', '>>' ); + + sub li_a_href { + my ( $page, $label, $attr ) = @_; + param( 'current_page', $page ); + my $url = self_url( -query => 1 ); + $attr ||= ''; + $label ||= $page; + qq|$label|; + } + + return + $pager->previous_page ? li_a_href( $pager->previous_page, $prev ) : qq|| + , ( map { + if ( $_ eq $pager->current_page ) { + qq|
  • $_
  • |; + } elsif ( $_ eq '' ) { + qq||; + } else { + li_a_href( $_ ); + } + } @show_pages ) + , $pager->next_page ? li_a_href( $pager->next_page, $next ) : qq|| + ; + +} + +my $path = $ENV{PATH_INFO} || 'ecas'; my $dir = $0; $dir =~ s{/[^/]+.cgi}{}; @@ -24,12 +84,50 @@ 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 +# XXX pipe delimit list! +my $select_attr_operators = << '__ATTR_OPERATORS__'; +Q* | Bilo koja riječ +BW Q | Početak +BW Q EW | Točan oblik +__ATTR_OPERATORS__ + +my $attr_operator; + +foreach ( split(/[\n\r]+/, $select_attr_operators ) ) { + my ( $operator,$label ) = split(/\s+\|\s+/,$_,2); + push @{ $attr_operator->{ '-values' } }, $operator; + $attr_operator->{ '-labels' }->{$operator} = $label; +} + +warn "## attr_operator = ", dump( $attr_operator ); + +my $only_input; + +foreach ( @{ $db->{input} } ) { + my $input = $_->{name} || die "no name in ",dump( $_ ); + if ( ! $only_input->{'-labels'}->{$input} ) { + push @{ $only_input->{'-values'} }, $input; + $only_input->{'-labels'}->{$input} = $_->{description} || $input; + } +} + +warn "## only_input = ", dump( $only_input ); + print start_html( -title => $db->{name}, @@ -37,49 +135,132 @@ print ), h1( $db->{name} ), qq|
    |, $db->{description}, qq|
    |, - start_form, + start_form( -action => self_url( query => 0 ) ), radio_group( -name => 'attr', - -values => [ 'issn', 'naslov' ], + -values => [ @attr ], # -linebreak => 0, ), textfield( -name => 'search' ), - submit + popup_menu( -name => 'attr_operator', %$attr_operator ), + submit, + hidden( -name => 'entries_per_page', -default => $entries_per_page ), + hidden( -name => 'current_page', -default => 1 ), + checkbox( -name => 'debug', -default => 0 ), # FIXME hidden? + qq|
    |, + h2( 'Select input' ), + checkbox_group( + -name => 'only_input', + %$only_input, + -linebreak=> 'true', + ), + qq|
    |, + ; +dump_yaml( 'inputs', $db->{input} ); +dump_yaml( 'input names', map { $_->{name} } @{ $db->{input} } ); + print end_form; if ( my $search = param('search') ) { - print qq|
    search: $search|; + print qq|
    |; + + my $swish = SWISH::API->new( "$dir/../var/swish/$database" ); + $swish->abort_last_error if $swish->Error; + + param( 'entries_per_page', $entries_per_page ) unless param('entries_per_page'); # FIXME not needed? + my $pager = Data::Page->new; + $pager->total_entries( param('current_page') * param('entries_per_page') ); + $pager->$_( param($_) ) foreach ( qw/entries_per_page current_page/ ); + + dump_yaml( 'pager', $pager ); + + my @search = (); + if ( $search =~ m{(=|"|AND|OR)} ) { + push @search, $search; + } elsif ( my $op = param('attr_operator') ) { + my $attr = param('attr'); + my $v = $search; + $v =~ s/^\s+//; + warn "-- v: $v\n"; + sub rewrite { + my ( $whitespace, $v ) = @_; + warn "## filter $op $whitespace $v\n"; + my $template = $op; + $template =~ s{Q}{$v}; + $whitespace = " AND " if $whitespace; + + return + $whitespace . + $attr . '="' . $template . '"'; + ; + }; + $v =~ s{(\s*)(\S+)}{rewrite($1,$2)}ge; + + push @search, $v; + + my @only_input = param('only_input'); + push @search, '(' . join(') OR (', map { "input=$_" } @only_input) . ')' if @only_input; + } else { + push @search, "all=\"$search\""; + } + + my $q = '(' . join(') AND (', @search) . ')'; + $q =~ s{\(\((.+)\)\)}{($1)}; + warn "# query: $q\n"; + my $swish_results = $swish->query( $q ); - my $node = Search::Estraier::Node->new( - url => $config->{hyperestraier}->{masterurl} . '/node/' . $database, - croak_on_error => 1, - ); + dump_yaml( 'swish_results', $swish_results ); - my $cond = Search::Estraier::Condition->new; - $cond->set_phrase( $search ); - my $nres = $node->search( $cond, 0 ); + $pager->total_entries( $swish_results->hits ); - if ( ! $nres ) { - my $no_results = "No results for search '%s'"; - printf qq|
    $no_results|, $search; + if ( ! $pager->total_entries ) { + my $no_results = 'No results for search %s'; + $no_results = $swish->error_string . '
    %s' if $swish->error; + printf qq|
    $no_results
    \n\n|, $q; } else { - print qq|
      |; - foreach my $i ( 1 .. $nres->doc_num ) { - my $rdoc = $nres->get_doc( $i - 1 ); + + my $results = "%d results for search %s showing results %d - %d"; + printf qq|
      $results
      \n\n|, $pager->total_entries, $q, $pager->first, $pager->last; + + my $pager_html = join("\n", show_pager( $pager )); + + print qq|
        $pager_html
      \n\n| if $pager_html; + + my $start = $pager->first; + print qq|
        \n|; + + while ( my $result = $swish_results->next_result ) { + my $data = from_json $result->property('data'); + print qq|
      1. |; - print qq|
        |, $rdoc->attr( $_ ), qq|
        | - foreach @attr; + foreach my $attr ( @attr ) { + next unless defined $data->{$attr}; + my $v = $data->{$attr}; + if ( $html_markup && ! $html_markup_skip->{$attr} ) { + eval "\$v = $html_markup->$attr( \$v );"; + if ( $@ ) { + warn "disable html markup for $attr: $@"; + $html_markup_skip->{$attr} = $@; + } + } + print qq|
        $v
        \n|; + } print qq|
      2. \n|; } - print qq|
    |; + print qq|\n\n|; + + print qq|
      $pager_html
    \n\n| if $pager_html; } print qq|
    |; + + dump_yaml( 'pager', $pager ); + } -dump_yaml( $estraier ); -dump_yaml( $db ); +dump_yaml( 'db', $db ); +dump_yaml( 'html_markup_skip', $html_markup_skip ); print end_html;