X-Git-Url: http://git.rot13.org/?a=blobdiff_plain;f=vhost%2Fwebpac2.cgi;h=96cfb859485d37531b830d831a22aa3e3bc55033;hb=6c079657d84ad6b348fc1b268cc9c09b7071abd3;hp=79adc7dfcfb1860a4c09789dec7fd838cb249c0a;hpb=a3c52c3acfb06577bc0541baa00eb5538bcee762;p=webpac2 diff --git a/vhost/webpac2.cgi b/vhost/webpac2.cgi index 79adc7d..96cfb85 100755 --- a/vhost/webpac2.cgi +++ b/vhost/webpac2.cgi @@ -13,7 +13,7 @@ use SWISH::API; use JSON; my $range_around = 5; -my $entries_per_page = 30; +my @entries_per_page = ( 30, 50, 100, 500 ); my $debug = param('debug'); print header( @@ -22,7 +22,7 @@ print header( sub dump_yaml { my $name = shift; - print qq|
# $name\n|, YAML::Dump( @_ ), qq|
| if $debug; + print qq|
$name
|, YAML::Dump( @_ ), qq|
| if $debug; } sub show_pager { @@ -76,9 +76,13 @@ sub show_pager { } my $path = $ENV{PATH_INFO} || 'ecas'; +$path =~ s{^/+}{}; +$path =~ s{/+$}{}; my $dir = $0; $dir =~ s{/[^/]+.cgi}{}; +dump_yaml( 'dir', $dir ); + my $config = YAML::LoadFile( "$dir/$path/config.yml" ); my $database = (keys %{ $config->{databases} })[0]; @@ -102,122 +106,160 @@ my $stats; my $db = $config->{databases}->{$database}; -my @attr = keys %{ $stats->{attr} }; # FIXME replace with real gnerated lookup +sub read_config_txt { + my ( $file ) = @_; + my $input; + my $path ="$dir/$path/$path-$file.txt"; + if ( ! -e $path ) { + warn "missing $path"; + return; + } + foreach ( split(/[\n\r]+/, read_file( $path ) ) ) { + my ( $val,$label ) = split(/\s*\t\s*/,$_,2); + push @{ $input->{ '-values' } }, $val; + $input->{ '-labels' }->{$val} = $label; + } + return $input; +} -# 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_labels = read_config_txt 'labels'; +my $attr_operators = read_config_txt 'operators'; -my $attr_operator; +my @attr = @{ $attr_labels->{'-values'} } if $attr_labels; +@attr = keys %{ $stats->{attr} } unless @attr; -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 ); +warn dump( $attr_labels, $attr_operators ); my $only_input; +my $inputs_available = 0; foreach ( @{ $db->{input} } ) { my $input = $_->{name} || die "no name in ",dump( $_ ); + next unless defined $stats->{input}->{$input}; # skip inputs without data if ( ! $only_input->{'-labels'}->{$input} ) { push @{ $only_input->{'-values'} }, $input; $only_input->{'-labels'}->{$input} = $_->{description} || $input; + $inputs_available++; } } warn "## only_input = ", dump( $only_input ); -print - start_html( - -title => $db->{name}, - -style => '../../style.css', - ), - h1( $db->{name} ), - qq|
|, $db->{description}, qq|
|, +my @style = ( '../../style.css' ); +push @style, "../../$path/$path.css" if -e "$dir/$path/$path.css"; +dump_yaml( 'style', \@style ); + +sub search_form { + qq||, start_form( -action => self_url( query => 0 ) ), - radio_group( + checkbox_group( -name => 'attr', - -values => [ @attr ], + %$attr_labels, # -linebreak => 0, ), textfield( -name => 'search' ), - popup_menu( -name => 'attr_operator', %$attr_operator ), - submit, - hidden( -name => 'entries_per_page', -default => $entries_per_page ), - hidden( -name => 'current_page', -default => 1 ), + $attr_operators ? popup_menu( -name => 'attr_operator', %$attr_operators ) : '', + submit( -value => 'Search' ), +# hidden( -name => 'entries_per_page', -default => $entries_per_page ), + popup_menu( -name => 'entries_per_page', -values => [ @entries_per_page ], -title => 'entries per page' ), + # we need current_page fixed at 1 so that every submit through form will reset it + qq||, checkbox( -name => 'debug', -default => 0 ), # FIXME hidden? qq|
|, - h2( 'Select input' ), + $inputs_available > 1 ? + h2( 'Select input' ) . checkbox_group( -name => 'only_input', %$only_input, -linebreak=> 'true', - ), + ) : '', qq|
|, + end_form, + ; +} -; -print end_form; +print + start_html( + -title => $db->{name}, + -style => [ @style ], + ), + h1( $db->{name} ), + qq|
|, $db->{description}, qq|
|, +; if ( my $search = param('search') ) { - print qq|
|; + 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 = (); + my @attrs = param('attr'); + my $op = param('attr_operator'); + 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; + } elsif ( @attrs ) { + + $op ||= 'Q*'; + my @or; + foreach my $attr ( @attrs ) { + my $v = $search; + $v =~ s/^\s+//; + warn "-- v: $v\n"; + sub rewrite { + my ( $attr, $whitespace, $v ) = @_; + warn "## filter $op $whitespace $v\n"; + my $template = $op; + $template =~ s{Q}{$v}; + $whitespace = " AND " if $whitespace; + + return + $whitespace . + $attr . '="' . $template . '"'; + ; + }; + if ( $op =~ m{\s} ) { + my $template = $op; + $template =~ s{Q}{$v}; + $v = $attr . '="' . $template . '"'; + } else { + $v =~ s{(\s*)(\S+)}{rewrite($attr,$1,$2)}ge; + } + + push @or, $v; + + } + push @search, '(' . join(') OR (', @or) . ')'; + } else { push @search, "all=\"$search\""; } my $q = '(' . join(') AND (', @search) . ')'; - $q =~ s{\(\((.+)\)\)}{($1)}; + + my @only_input = param('only_input'); + $q .= ' AND ((' . join(') OR (', map { "input=\"$_\"" } @only_input) . '))' if @only_input; + warn "# query: $q\n"; my $swish_results = $swish->query( $q ); dump_yaml( 'swish_results', $swish_results ); + my $pager = Data::Page->new; + $pager->$_( param($_) ) foreach ( qw/entries_per_page current_page/ ); $pager->total_entries( $swish_results->hits ); + dump_yaml( 'pager', $pager ); + + $swish_results->seek_result( $pager->first - 1 ); + if ( ! $pager->total_entries ) { my $no_results = 'No results for search %s'; $no_results = $swish->error_string . '
%s' if $swish->error; @@ -231,28 +273,40 @@ if ( my $search = param('search') ) { print qq|\n\n| if $pager_html; - my $start = $pager->first; - print qq|
    \n|; + my $nr = $pager->first; + print qq|
      \n|; + + my $limit = $pager->entries_on_this_page; + + my $nr = 1; while ( my $result = $swish_results->next_result ) { - my $data = from_json $result->property('data'); + + my $data = from_json( $result->property('data'), {utf8 => 1} ); dump_yaml( 'data', $data ); - print qq|
    1. |; + my $li_class = ''; + $li_class = qq| class="z"| if $nr % 2 == 0; + print qq||; 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 );"; + eval "\$v = $html_markup->$attr( \$v, \$data );"; if ( $@ ) { warn "disable html markup for $attr: $@"; $html_markup_skip->{$attr} = $@; } + } else { + $v =~ s{(http://\S+)}{$1}; } - print qq|
      $v
      \n|; + my $label = $attr_labels->{'-labels'}->{$attr} || $attr; + print qq|
      $v
      \n|; } print qq|
      2. \n|; + + last if $nr++ == $pager->last; } print qq|
    \n\n|; @@ -264,6 +318,8 @@ if ( my $search = param('search') ) { } +print search_form; + dump_yaml( "config databases $database", $db ); dump_yaml( 'html_markup_skip', $html_markup_skip );