--- trunk/WebPac.pm 2003/11/16 16:57:11 149 +++ trunk/WebPac.pm 2004/04/04 22:09:57 302 @@ -28,12 +28,51 @@ my $ON_PAGE =$cfg_global->val('webpac', 'on_page') || 10; my $MIN_WILDCARD =$cfg_global->val('webpac', 'min_wildcard') || 1; my $TEMPLATE =$cfg_global->val('webpac', 'template'); +my $UNAC_FILTER =$cfg_global->val('global', 'unac_filter'); +my $BASE_PATH =$cfg_global->val('webpac', 'base_path'); +if ($UNAC_FILTER) { + require $UNAC_FILTER; +} Text::Iconv->raise_error(0); # Conversion errors raise exceptions my $from_utf8 = Text::Iconv->new('UTF8', $CHARSET); +# use path from cgi script to support templates in subdirs +sub url_ex { + my $q = shift || die "suff2file needs CGI object!"; + my $tpl = shift || die "url_ex needs template name!"; + return suff2file($BASE_PATH, $q->url(-absolute => 1,-path => 1),$TEMPLATE_PATH,$tpl); +} + +sub suff2file($$$$) { + my ($base_path, $p, $path, $tpl) = @_; + + return $tpl if (! $base_path); + + # strip everything to and including base path, leaving only + # additional (virtual) path + if ($base_path eq "/") { + $p =~ s,/*,,g; + my ($name,$ext) = split(/\./,$tpl); + $p = $name . "-" . $p . "." . $ext; + } elsif ($p =~ s,^.*?$base_path,,) { + $p =~ s,/*,,g; + my ($name,$ext) = split(/\./,$tpl); + $p = $name . $p . "." . $ext; + } else { + # if unable reset it! + $p = $tpl; + } + + if ( -e "$path/$p") { + return $p; + } else { + return $tpl; + } + +} sub setup { my $self = shift; @@ -51,15 +90,25 @@ } sub in_template { - my $html = shift || "This page is left unintentionally blank"; + my $q = shift || die "need CGI object!"; + my $html = shift || die "This page is left unintentionally blank"; return $html if (! defined($TEMPLATE)); - if (open(T, $TEMPLATE)) { + + my ($dir,$tpl); + if ($TEMPLATE =~ m,^(.*?/*)([^/]+)$,) { + ($dir,$tpl) = ($1,$2); + } else { + die "can't parse TEMPLATE path"; + } + + my $master_tpl = suff2file($BASE_PATH, $q->url(-absolute => 1, -path => 1),$dir,$tpl); + if (open(T, $master_tpl)) { my $template_html = join("\n",); close(T); $template_html =~ s/##webpac##/$html/gsi; return $template_html; } else { - return "Can't read template '$TEMPLATE'"; + return "Can't read template '$master_tpl'"; } } @@ -69,12 +118,12 @@ # Get the CGI.pm query object my $q = $self->query(); - my $tmpl = $self->load_tmpl('search.html'); + my $tmpl = $self->load_tmpl(url_ex($q,'search.html')); my $html = $tmpl->output; my $fif = new HTML::FillInForm; - return in_template($fif->fill(scalarref => \$html, fobject => $q, + return in_template($q,$fif->fill(scalarref => \$html, fobject => $q, target => 'search')); } @@ -95,7 +144,8 @@ my @persist_vars = ( 'rm' ); my @url_params = ( 'rm=results', 'show_full=1', 'last_PAGER_offset='.$q->param('PAGER_offset') || 0 ); - for(my $i = 1; $i <=30; $i++) { + # support parametars "f" and "v" for start + for(my $i = ""; $i <=30; $i++) { return show_index($self, $i) if ($q->param("f".$i."_index")); @@ -104,13 +154,21 @@ push @persist_vars, "f$i"; push @persist_vars, "v$i"; + push @persist_vars, "e$i" if ($q->param("e$i")); push @url_params,"f$i=".$q->url_param("f$i"); - push @url_params,"v$i=".$q->url_param("v$i"); + foreach my $v ($q->url_param("v$i")) { + push @url_params,"v$i=$v"; + } + push @url_params,"e$i=".$q->url_param("e$i"); + + my $wc="*"; # swish wildcard + $wc="" if ($i eq ""); # don't apply wildcard on field 0 # re-write query from +/- to and/and not my @param_vals = $q->param("v$i"); my @swish_q; + my ($pre,$post,$exact) = ('','',''); while (my $search = shift @param_vals) { my $s; # remove accents @@ -121,29 +179,44 @@ $search =~ s/^\s+//; $search =~ s/\s+$//; + # filed e[nr] is exact match bitmask + # 1 = beginning, 2=end, 3=both + $pre = '"xxbxx ' if ($q->param("e$i") & 1); + $post = ' xxexx"' if ($q->param("e$i") & 2); + # add qotes on other side + if ($q->param("e$i")) { + $pre = '"' if (! $pre); + $post = '"' if (! $post); + # what about wildcards? + $wc = ''; + $wc = '*' if ($q->param("e$i") & 4); + $exact = '_exact'; + } + foreach (split(/\s+/,$search)) { if (m/^([+-])(\S+)/) { $s.= ($s) ? "and " : ""; $s.="not " if ($1 eq "-"); - $s.="$2* "; + $s.=$2.$wc." "; } elsif (m/^\s*(and|or|not)\s*$/i) { - $s.="$_ "; + $s.=$_." "; # don't add * to words with less than x chars } elsif (length($_) <= $MIN_WILDCARD) { - $s.="$_ "; + $s.=$_." "; } else { - $s.="$_* "; + $s.=$_.$wc." "; } } $s =~ s/\*+/*/g; + $s = $pre.$s.$post if ($q->param("e$i")); push @swish_q,$s; } # FIXME default operator for multi-value fields is or. There is # no way to change it, except here for now. Is there need? - push @s_arr, $q->param("f$i")."_swish=(".join(" or ",@swish_q).")"; + push @s_arr, $q->param("f$i")."_swish".$exact."=(".join(" or ",@swish_q).")"; } - my $tmpl = $self->load_tmpl('results.html', global_vars => 1); + my $tmpl = $self->load_tmpl(url_ex($q,'results.html'), global_vars => 1); sub esc_html { my $html = shift; @@ -152,6 +225,12 @@ return $html; } + my $sort = 'swishrank'; + if ($q->param("sort")) { + $sort = 'headline'; + push @persist_vars, "sort"; + } + # call swish my $sh = SWISH->connect('Fork', prog => $SWISH, @@ -169,7 +248,8 @@ }, #startnum => 0, - maxhits => $MAX_HITS + maxhits => $MAX_HITS, + sortorder => $sort, ); die $SWISH::errstr unless $sh; @@ -231,7 +311,7 @@ my $html = $pager->output; - return in_template($html); + return in_template($q,$html); } sub show_index { @@ -254,13 +334,13 @@ my $total = $index->count($field,$limit); if (! $total) { - my $tmpl = $self->load_tmpl('no_index.html'); + my $tmpl = $self->load_tmpl(url_ex($q,'no_index.html')); $tmpl->param('field',$field); $html = $tmpl->output; return $html; } - my $tmpl = $self->load_tmpl('index_res.html', global_vars => 1); + my $tmpl = $self->load_tmpl(url_ex($q,'index_res.html'), global_vars => 1); $tmpl->param('field',$field); $tmpl->param('limit',$limit); $tmpl->param('total',$total); @@ -289,7 +369,7 @@ template => $tmpl, ); - return in_template($pager->output); + return in_template($q,$pager->output); } 1;