webpac/trunk/WebPac.pm

package WebPac;

use base 'CGI::Application';
use strict;

use HTML::FillInForm;
use SWISH::API;
use Text::Iconv;
use DBI;
use Config::IniFiles;
use Text::Unaccent;
use Data::Pageset;

use lib '..';
use index_DBI_filter;
use back2html;


# read global.conf configuration
my $cfg_global = new Config::IniFiles( -file => '../global.conf' ) || die "can't open 'global.conf'";

# configuration options from global.conf
my $TEMPLATE_PATH = $cfg_global->val('webpac', 'template_html') || die "need template_html in global.conf, section webpac";
my $CHARSET = $cfg_global->val('webpac', 'charset') || 'ISO-8859-1';
my $SWISH = $cfg_global->val('webpac', 'swish') || '/usr/bin/swish-e';
my $INDEX = $cfg_global->val('webpac', 'index') || die "need index in global.conf, section webpac";
my $MAX_HITS = $cfg_global->val('webpac', 'max_hits') || 0;
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', 'my_unac_filter');
my $BASE_PATH =$cfg_global->val('webpac', 'base_path');
# for pager
my $pages_per_set = $cfg_global->val('webpac', 'pages_per_set') || 10;

Text::Iconv->raise_error(0);     # Conversion errors raise exceptions

my $from_utf8 = Text::Iconv->new('UTF8', $CHARSET);

if ($UNAC_FILTER) {
        require $UNAC_FILTER;
} else {
        sub WebPac::my_unac_string {
                my ($charset, $string) = (@_);
                return $string;
        }
}

# 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;
        $self->tmpl_path($TEMPLATE_PATH);
        $self->run_modes(
                'search' => 'show_search_form',
                'results' => 'show_results_list',
#               'user' => 'show_user_detail',
                'index' => 'show_index',
        );
        $self->start_mode('search');
        $self->mode_param('rm');

        $self->header_props(-charset=>$CHARSET);
}

sub in_template {
        my $q = shift || die "need CGI object!";
        my $html = shift || die "This page is left unintentionally blank";
        return $html if (! defined($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",<T>);
                close(T);
                $template_html =~ s/##webpac##/$html/gsi;
                return $template_html;
        } else {
                return "Can't read template '$master_tpl'";
        }
}

#--------------------------------------------------------------------------

#
# make pager navigation and fill template variables
# compatibile with HTML::Pager
#

sub make_pager($$$) {
        my ($q,$tmpl,$pager) = @_;

        #
        # pager navigation
        #
        my ($pager_prev,$pager_next, $pager_jump) = ('','','');

        my $nav_fmt=qq{ <a href="%s">%s</a> };

        if ($pager->current_page() > $pager->first_page) {
                $q->param('PAGER_offset', $pager->current_page - 1);
                $pager_prev .= sprintf($nav_fmt,$q->url(-relative=>1, -query=>1),'&lt;&lt;');
        }

        if ($pager->previous_set) {
                $q->param('PAGER_offset', $pager->previous_set);
                $pager_prev .= sprintf($nav_fmt,$q->url(-relative=>1, -query=>1),'..');
        }


        foreach my $p (@{$pager->pages_in_set()}) {
                next if ($p <= 0);
                if($p == $pager->current_page()) {
                        $pager_jump .= "<b>$p</b> ";
                } else {
                        $q->param('PAGER_offset', $p);
                        $pager_jump .= sprintf($nav_fmt,$q->url(-relative=>1, -query=>1),$p);
                }
        }

        if ($pager->next_set) {
                $q->param('PAGER_offset', $pager->next_set);
                $pager_next .= sprintf($nav_fmt,$q->url(-relative=>1, -query=>1),'..');
        }

        if ($pager->current_page() < $pager->last_page) {
                $q->param('PAGER_offset', $pager->current_page + 1);
                $pager_next .= sprintf($nav_fmt,$q->url(-relative=>1, -query=>1),'&gt;&gt;');
        }

        $tmpl->param('PAGER_PREV', $pager_prev);
        $tmpl->param('PAGER_JUMP', $pager_jump);
        $tmpl->param('PAGER_NEXT', $pager_next);

}

#
# put persisten variables in template
#

sub make_pager_vars {
        my $q = shift @_;
        my $tmpl = shift @_;
        my @persist_vars = @_;
        my $hidden_vars = '';
        my $hidden_search = '';
        foreach my $v (@persist_vars) {
                foreach my $val ($q->param($v)) {
                        next if (! $val || $val eq '');
                        $hidden_vars .= '<input type="hidden" name="'.$v.'" value="'.$val.'"/>'."\n";
                        $hidden_search .= '<input type="hidden" name="'.$v.'" value="'.$val.'"/>'."\n" if ($v ne "rm");
                }
        }

        $tmpl->param('PAGER_HIDDEN', $hidden_vars);
        $tmpl->param('SEARCH_HIDDEN', $hidden_search);
        $tmpl->param('PAGER_JAVASCRIPT', qq#
<SCRIPT LANGUAGE="Javascript">
<!-- Begin
        // dummy emulator for HTML::Pager templates
        function PAGER_set_offset_and_submit() {
                return true;
        }
// End -->
</script>  
        #);
}

#--------------------------------------------------------------------------

sub show_search_form {
        my $self = shift;

        # Get the CGI.pm query object
        my $q = $self->query();

        my $tmpl = $self->load_tmpl(url_ex($q,'search.html'));
        my $html = $tmpl->output;

        my $fif = new HTML::FillInForm;

        return in_template($q,$fif->fill(scalarref => \$html, fobject => $q,
                target => 'search'));
}
 
sub show_results_list {
        my $self = shift;

        my $q = $self->query();

        # submit was reset?
        if ($q->param('reset')) {
                $q->delete_all;
                return $self->show_search_form();
        }

        # load template for this page

        my @s_arr;      # all queries are located here

        my @path_arr = $q->param('path');
        my $full = $q->param('full');

        my @persist_vars = ( 'rm', 'persist_search' );
        my @url_params = ( 'rm=results', 'show_full=1', 'last_PAGER_offset='.($q->param('PAGER_offset') || 0) );

        my @persist_search_vars;
        my @url_params_persist;
        if ($q->param("persist_search")) {
                @persist_search_vars = split(/\s*,\s*/, $q->param("persist_search"));
                push @url_params_persist, "persist_search=".$q->url_param("persist_search");
                push @url_params,"persist_search=".$q->url_param("persist_search");
        }

        # support parametars "f" and "v" for start
        for(my $i = 0; $i <=30; $i++) {

                $i = '' if ($i == 0);

                return show_index($self, $i) if ($q->param("f".$i."_index"));

                next if (! $q->param("v$i") || $q->param("v$i") eq '');
                next if (! $q->param("f$i"));

                my $persist = grep(/^$i$/,@persist_search_vars);
        
                push @persist_vars, "f$i";
                push @persist_vars, "v$i";
                push @persist_vars, "e$i" if ($q->param("e$i"));

                # create url parametars (and persistent ones)

                push @url_params,"f$i=".$q->url_param("f$i");
                push @url_params_persist,"f$i=".$q->url_param("f$i") if ($persist);

                foreach my $v ($q->url_param("v$i")) {
                        push @url_params,"v$i=$v";
                        push @url_params_persist,"v$i=$v" if ($persist);
                }

                if ($q->param("e$i")) {
                        push @url_params,"e$i=".$q->url_param("e$i");
#                       push @url_params_persist,"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
                        $search = my_unac_string($CHARSET,$search);
                        while ($search =~ s/\s*("[^"]+")\s*/ /) {
                                $s .= "$1 ";
                        }
                        $search =~ s/^\s+//;
                        $search =~ s/\s+$//;

                        # filed e[nr] is exact match bitmask
                        # 1 = beginning, 2=end, 3=both
                        my $exact_flag = $q->param("e$i") || 0;
                        $pre = '"xxbxx ' if ($exact_flag & 1);
                        $post = ' xxexx"' if ($exact_flag & 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.$wc." ";
                                } elsif (m/^\s*(and|or|not)\s*$/i) {
                                        $s.=$_." ";
                                # don't add * to words with less than x chars
                                } elsif (length($_) <= $MIN_WILDCARD) {
                                        $s.=$_." ";
                                } else {
                                        $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".$exact."=(".join(" or ",@swish_q).")";
        }

        my $tmpl = $self->load_tmpl(url_ex($q,'results.html'), global_vars => 1, die_on_bad_params => 0);

        $tmpl->param('url_params',"?".join("&",@url_params));

        sub esc_html {
                my $html = shift;
                $html =~ s/</&lt;/g;
                $html =~ s/>/&gt;/g;
                return $html;
        }

        my $sort = 'swishrank';
        if ($q->param("sort")) {
                $sort = 'headline';
                push @persist_vars, "sort";
        }

        my $sortby = $q->param("sortby");
        if ($sortby) {
                $sort = $sortby;
                push @persist_vars, "sortby";
        }
        $tmpl->param('url_params_paths',"?".join("&",@url_params).'&'.join("&",map { my $t = $_; $t =~ s/\#/%23/g; "path=$t"; } @path_arr));

        # construct swish query
        my $sw_q = join(" and ",@s_arr);
        if (@path_arr && $q->param('show_full')) {
                $sw_q .= "and (swishdocpath=\"";
                $sw_q .= join("\" or swishdocpath=\"",@path_arr);
                $sw_q .= "\")";
                $tmpl->param('full',1); # show full records
        } elsif ($q->param('show_full')) {
                # just show full path, no path defined
                $tmpl->param('full',1);
        } else {
                $tmpl->param('full',0);
        }

        my $swish_msg = ' ';

        # create new swish instance
        my $swish = SWISH::API->new($INDEX);
        $swish_msg .= $swish->ErrorString." ".$swish->LastErrorMsg if $swish->Error;

        # execute query and get number of results from SWISH-E
        my $search = $swish->New_Search_Object;

        $search->SetSort($sort);

        my $results = $search->Execute($sw_q);
        $swish_msg .= $swish->ErrorString." ".$swish->LastErrorMsg if $swish->Error;

        my $hits = $results->Hits;

        $tmpl->param('hits',$hits);
        my $search_msg = $sw_q;
        $search_msg .= '<em>'.$swish_msg.'</em>' if ($swish_msg);
        $tmpl->param('search', $search_msg);

        $tmpl->param('PAGER_offset',$q->param("PAGER_offset") || 0);
        $tmpl->param('last_PAGER_offset',$q->param("last_PAGER_offset") || 0);

        #
        # build pager
        #

        my $current_page = $q->param('PAGER_offset') || 1;

        my $pager = Data::Pageset->new({
                'total_entries' => $hits,
                'entries_per_page' => $ON_PAGE,
                'current_page' => $current_page,
                'pages_per_set' => $pages_per_set,
        });

        $results->SeekResult( $pager->first - 1 );

        # get number of entries on this page
        my $i = $pager->entries_on_this_page;

        # results from swish for template
        my @pager_data_list;

        for(my $i=$pager->first; $i<=$pager->last; $i++) {

                my $result = $results->NextResult;
                last if (! $result);

                my $r = {
                        nr => $i,
                        path => $result->Property('swishdocpath'),
                        headline => esc_html($from_utf8->convert($result->Property('headline'))),
                        rank => $result->Property('swishrank')
                };

                $r->{html} = back2html($from_utf8->convert($result->Property('html')), join("&",@url_params_persist)) if ($q->param('show_full'));

                push @pager_data_list, $r;
        }


        # put something in template
        make_pager($q, $tmpl, $pager);
        make_pager_vars($q, $tmpl, @persist_vars);
        $tmpl->param('PAGER_DATA_LIST', \@pager_data_list);

        my $html = $tmpl->output;

        return in_template($q,$html);
}
 
sub show_index {
        my $self = shift;
        my $i = shift;          # field number

        my $q = $self->query();

        my $field = $q->param("f$i");
        my $limit = $q->param("v$i");

        my $filter = $q->param("filter");

        my $html;

        my $index = new index_DBI(
                $cfg_global->val('global', 'dbi_dbd'),
                $cfg_global->val('global', 'dbi_dsn'),
                $cfg_global->val('global', 'dbi_user'),
                $cfg_global->val('global', 'dbi_passwd') || ''
        );

        my $total = $index->count($field,$limit,$filter);

        if (! defined($total)) {
                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(url_ex($q,'index_res.html'), global_vars => 1, die_on_bad_params => 0);
        $tmpl->param('field',$field);
        $tmpl->param('limit',$limit);
        $tmpl->param('total',$total);

# FIXME I should set offset and leave out limit from fetch!!
#       if (! $q->param("PAGER_offset") {
#               $q->param("Pager_offet)
#       }


        #
        # build pager
        #
        my $pager = Data::Pageset->new({
                'total_entries' => $total,
                'entries_per_page' => $ON_PAGE,
                'current_page' => $q->param('PAGER_offset') || 1,
                'pages_per_set' => $pages_per_set
        });

        my @persist_vars = qw{rm f$i v$i f$i_index offset};

        make_pager($q, $tmpl, $pager);
        make_pager_vars($q, $tmpl, @persist_vars);

        my @pager_data_list = $index->fetch($field,$limit, $pager->first - 1, $pager->entries_on_this_page, $filter);
        $tmpl->param('PAGER_DATA_LIST', \@pager_data_list);

        return in_template($q,$tmpl->output);
}

1;
1	dpavlin	7	package WebPac;
2
3			use base 'CGI::Application';
4			use strict;
5
6			use HTML::FillInForm;
7	dpavlin	304	use SWISH::API;
8	dpavlin	14	use Text::Iconv;
9	dpavlin	9	use DBI;
10	dpavlin	53	use Config::IniFiles;
11	dpavlin	73	use Text::Unaccent;
12	dpavlin	304	use Data::Pageset;
13	dpavlin	7
14	dpavlin	11	use lib '..';
15	dpavlin	642	use index_DBI_filter;
16	dpavlin	13	use back2html;
17	dpavlin	11
18	dpavlin	7
19	dpavlin	76	# read global.conf configuration
20			my $cfg_global = new Config::IniFiles( -file => '../global.conf' ) \|\| die "can't open 'global.conf'";
21
22			# configuration options from global.conf
23			my $TEMPLATE_PATH = $cfg_global->val('webpac', 'template_html') \|\| die "need template_html in global.conf, section webpac";
24			my $CHARSET = $cfg_global->val('webpac', 'charset') \|\| 'ISO-8859-1';
25			my $SWISH = $cfg_global->val('webpac', 'swish') \|\| '/usr/bin/swish-e';
26			my $INDEX = $cfg_global->val('webpac', 'index') \|\| die "need index in global.conf, section webpac";
27			my $MAX_HITS = $cfg_global->val('webpac', 'max_hits') \|\| 0;
28			my $ON_PAGE =$cfg_global->val('webpac', 'on_page') \|\| 10;
29	dpavlin	120	my $MIN_WILDCARD =$cfg_global->val('webpac', 'min_wildcard') \|\| 1;
30	dpavlin	147	my $TEMPLATE =$cfg_global->val('webpac', 'template');
31	dpavlin	320	my $UNAC_FILTER =$cfg_global->val('global', 'my_unac_filter');
32	dpavlin	198	my $BASE_PATH =$cfg_global->val('webpac', 'base_path');
33	dpavlin	304	# for pager
34			my $pages_per_set = $cfg_global->val('webpac', 'pages_per_set') \|\| 10;
35	dpavlin	76
36	dpavlin	320	Text::Iconv->raise_error(0); # Conversion errors raise exceptions
37	dpavlin	304
38	dpavlin	320	my $from_utf8 = Text::Iconv->new('UTF8', $CHARSET);
39
40	dpavlin	164	if ($UNAC_FILTER) {
41			require $UNAC_FILTER;
42	dpavlin	320	} else {
43			sub WebPac::my_unac_string {
44			my ($charset, $string) = (@_);
45			return $string;
46			}
47	dpavlin	164	}
48	dpavlin	76
49	dpavlin	198	# use path from cgi script to support templates in subdirs
50			sub url_ex {
51			my $q = shift \|\| die "suff2file needs CGI object!";
52			my $tpl = shift \|\| die "url_ex needs template name!";
53	dpavlin	302	return suff2file($BASE_PATH, $q->url(-absolute => 1,-path => 1),$TEMPLATE_PATH,$tpl);
54	dpavlin	198	}
55	dpavlin	53
56	dpavlin	198	sub suff2file($$$$) {
57			my ($base_path, $p, $path, $tpl) = @_;
58
59			return $tpl if (! $base_path);
60
61			# strip everything to and including base path, leaving only
62			# additional (virtual) path
63	dpavlin	302	if ($base_path eq "/") {
64	dpavlin	198	$p =~ s,/*,,g;
65			my ($name,$ext) = split(/\./,$tpl);
66	dpavlin	302	$p = $name . "-" . $p . "." . $ext;
67			} elsif ($p =~ s,^.*?$base_path,,) {
68			$p =~ s,/*,,g;
69			my ($name,$ext) = split(/\./,$tpl);
70	dpavlin	198	$p = $name . $p . "." . $ext;
71			} else {
72			# if unable reset it!
73			$p = $tpl;
74			}
75
76			if ( -e "$path/$p") {
77			return $p;
78			} else {
79			return $tpl;
80			}
81
82			}
83
84	dpavlin	7	sub setup {
85			my $self = shift;
86			$self->tmpl_path($TEMPLATE_PATH);
87			$self->run_modes(
88			'search' => 'show_search_form',
89			'results' => 'show_results_list',
90	dpavlin	9	# 'user' => 'show_user_detail',
91			'index' => 'show_index',
92	dpavlin	7	);
93			$self->start_mode('search');
94			$self->mode_param('rm');
95
96			$self->header_props(-charset=>$CHARSET);
97			}
98
99	dpavlin	147	sub in_template {
100	dpavlin	198	my $q = shift \|\| die "need CGI object!";
101			my $html = shift \|\| die "This page is left unintentionally blank";
102	dpavlin	147	return $html if (! defined($TEMPLATE));
103	dpavlin	198
104			my ($dir,$tpl);
105			if ($TEMPLATE =~ m,^(.?/)([^/]+)$,) {
106			($dir,$tpl) = ($1,$2);
107			} else {
108			die "can't parse TEMPLATE path";
109			}
110
111	dpavlin	302	my $master_tpl = suff2file($BASE_PATH, $q->url(-absolute => 1, -path => 1),$dir,$tpl);
112	dpavlin	198	if (open(T, $master_tpl)) {
113	dpavlin	147	my $template_html = join("\n",<T>);
114			close(T);
115			$template_html =~ s/##webpac##/$html/gsi;
116			return $template_html;
117			} else {
118	dpavlin	198	return "Can't read template '$master_tpl'";
119	dpavlin	147	}
120			}
121
122	dpavlin	304	#--------------------------------------------------------------------------
123
124			#
125			# make pager navigation and fill template variables
126			# compatibile with HTML::Pager
127			#
128
129			sub make_pager($$$) {
130			my ($q,$tmpl,$pager) = @_;
131
132			#
133			# pager navigation
134			#
135			my ($pager_prev,$pager_next, $pager_jump) = ('','','');
136
137			my $nav_fmt=qq{ <a href="%s">%s</a> };
138
139			if ($pager->current_page() > $pager->first_page) {
140			$q->param('PAGER_offset', $pager->current_page - 1);
141			$pager_prev .= sprintf($nav_fmt,$q->url(-relative=>1, -query=>1),'<<');
142			}
143
144			if ($pager->previous_set) {
145			$q->param('PAGER_offset', $pager->previous_set);
146			$pager_prev .= sprintf($nav_fmt,$q->url(-relative=>1, -query=>1),'..');
147			}
148
149
150			foreach my $p (@{$pager->pages_in_set()}) {
151	dpavlin	656	next if ($p <= 0);
152	dpavlin	304	if($p == $pager->current_page()) {
153			$pager_jump .= "<b>$p</b> ";
154			} else {
155			$q->param('PAGER_offset', $p);
156			$pager_jump .= sprintf($nav_fmt,$q->url(-relative=>1, -query=>1),$p);
157			}
158			}
159
160			if ($pager->next_set) {
161			$q->param('PAGER_offset', $pager->next_set);
162			$pager_next .= sprintf($nav_fmt,$q->url(-relative=>1, -query=>1),'..');
163			}
164
165			if ($pager->current_page() < $pager->last_page) {
166			$q->param('PAGER_offset', $pager->current_page + 1);
167			$pager_next .= sprintf($nav_fmt,$q->url(-relative=>1, -query=>1),'>>');
168			}
169
170			$tmpl->param('PAGER_PREV', $pager_prev);
171			$tmpl->param('PAGER_JUMP', $pager_jump);
172			$tmpl->param('PAGER_NEXT', $pager_next);
173
174			}
175
176			#
177			# put persisten variables in template
178			#
179
180			sub make_pager_vars {
181			my $q = shift @_;
182			my $tmpl = shift @_;
183			my @persist_vars = @_;
184			my $hidden_vars = '';
185	dpavlin	675	my $hidden_search = '';
186	dpavlin	304	foreach my $v (@persist_vars) {
187	dpavlin	457	foreach my $val ($q->param($v)) {
188	dpavlin	636	next if (! $val \|\| $val eq '');
189	dpavlin	457	$hidden_vars .= '<input type="hidden" name="'.$v.'" value="'.$val.'"/>'."\n";
190	dpavlin	675	$hidden_search .= '<input type="hidden" name="'.$v.'" value="'.$val.'"/>'."\n" if ($v ne "rm");
191	dpavlin	457	}
192	dpavlin	304	}
193
194			$tmpl->param('PAGER_HIDDEN', $hidden_vars);
195	dpavlin	675	$tmpl->param('SEARCH_HIDDEN', $hidden_search);
196	dpavlin	636	$tmpl->param('PAGER_JAVASCRIPT', qq#
197	dpavlin	304	<SCRIPT LANGUAGE="Javascript">
198			<!-- Begin
199			// dummy emulator for HTML::Pager templates
200			function PAGER_set_offset_and_submit() {
201			return true;
202			}
203			// End -->
204			</script>
205	dpavlin	636	#);
206	dpavlin	304	}
207
208			#--------------------------------------------------------------------------
209
210	dpavlin	7	sub show_search_form {
211			my $self = shift;
212
213			# Get the CGI.pm query object
214			my $q = $self->query();
215
216	dpavlin	198	my $tmpl = $self->load_tmpl(url_ex($q,'search.html'));
217	dpavlin	7	my $html = $tmpl->output;
218
219			my $fif = new HTML::FillInForm;
220
221	dpavlin	198	return in_template($q,$fif->fill(scalarref => \$html, fobject => $q,
222	dpavlin	147	target => 'search'));
223	dpavlin	7	}
224
225			sub show_results_list {
226			my $self = shift;
227
228			my $q = $self->query();
229
230	dpavlin	676	# submit was reset?
231			if ($q->param('reset')) {
232			$q->delete_all;
233			return $self->show_search_form();
234			}
235
236	dpavlin	7	# load template for this page
237
238			my @s_arr; # all queries are located here
239
240	dpavlin	47	my @path_arr = $q->param('path');
241			my $full = $q->param('full');
242
243	dpavlin	636	my @persist_vars = ( 'rm', 'persist_search' );
244	dpavlin	304	my @url_params = ( 'rm=results', 'show_full=1', 'last_PAGER_offset='.($q->param('PAGER_offset') \|\| 0) );
245	dpavlin	112
246	dpavlin	636	my @persist_search_vars;
247			my @url_params_persist;
248			if ($q->param("persist_search")) {
249			@persist_search_vars = split(/\s,\s/, $q->param("persist_search"));
250			push @url_params_persist, "persist_search=".$q->url_param("persist_search");
251			push @url_params,"persist_search=".$q->url_param("persist_search");
252			}
253
254	dpavlin	150	# support parametars "f" and "v" for start
255	dpavlin	636	for(my $i = 0; $i <=30; $i++) {
256	dpavlin	7
257	dpavlin	636	$i = '' if ($i == 0);
258
259	dpavlin	9	return show_index($self, $i) if ($q->param("f".$i."_index"));
260	dpavlin	112
261	dpavlin	636	next if (! $q->param("v$i") \|\| $q->param("v$i") eq '');
262	dpavlin	9	next if (! $q->param("f$i"));
263	dpavlin	7
264	dpavlin	636	my $persist = grep(/^$i$/,@persist_search_vars);
265
266	dpavlin	112	push @persist_vars, "f$i";
267			push @persist_vars, "v$i";
268	dpavlin	186	push @persist_vars, "e$i" if ($q->param("e$i"));
269	dpavlin	112
270	dpavlin	636	# create url parametars (and persistent ones)
271
272	dpavlin	126	push @url_params,"f$i=".$q->url_param("f$i");
273	dpavlin	636	push @url_params_persist,"f$i=".$q->url_param("f$i") if ($persist);
274
275	dpavlin	158	foreach my $v ($q->url_param("v$i")) {
276			push @url_params,"v$i=$v";
277	dpavlin	636	push @url_params_persist,"v$i=$v" if ($persist);
278	dpavlin	158	}
279	dpavlin	126
280	dpavlin	636	if ($q->param("e$i")) {
281			push @url_params,"e$i=".$q->url_param("e$i");
282	dpavlin	639	# push @url_params_persist,"e$i=".$q->url_param("e$i");
283	dpavlin	636	}
284
285	dpavlin	150	my $wc="*"; # swish wildcard
286			$wc="" if ($i eq ""); # don't apply wildcard on field 0
287
288	dpavlin	7	# re-write query from +/- to and/and not
289	dpavlin	73	my @param_vals = $q->param("v$i");
290			my @swish_q;
291	dpavlin	163	my ($pre,$post,$exact) = ('','','');
292	dpavlin	73	while (my $search = shift @param_vals) {
293			my $s;
294			# remove accents
295	dpavlin	320	$search = my_unac_string($CHARSET,$search);
296	dpavlin	73	while ($search =~ s/\s("[^"]+")\s/ /) {
297			$s .= "$1 ";
298			}
299			$search =~ s/^\s+//;
300			$search =~ s/\s+$//;
301	dpavlin	7
302	dpavlin	163	# filed e[nr] is exact match bitmask
303			# 1 = beginning, 2=end, 3=both
304	dpavlin	636	my $exact_flag = $q->param("e$i") \|\| 0;
305			$pre = '"xxbxx ' if ($exact_flag & 1);
306			$post = ' xxexx"' if ($exact_flag & 2);
307	dpavlin	163	# add qotes on other side
308			if ($q->param("e$i")) {
309			$pre = '"' if (! $pre);
310			$post = '"' if (! $post);
311	dpavlin	190	# what about wildcards?
312			$wc = '';
313			$wc = '*' if ($q->param("e$i") & 4);
314	dpavlin	163	$exact = '_exact';
315			}
316
317	dpavlin	73	foreach (split(/\s+/,$search)) {
318			if (m/^([+-])(\S+)/) {
319			$s.= ($s) ? "and " : "";
320			$s.="not " if ($1 eq "-");
321	dpavlin	163	$s.=$2.$wc." ";
322	dpavlin	122	} elsif (m/^\s(and\|or\|not)\s$/i) {
323	dpavlin	163	$s.=$_." ";
324	dpavlin	120	# don't add * to words with less than x chars
325			} elsif (length($_) <= $MIN_WILDCARD) {
326	dpavlin	163	$s.=$_." ";
327	dpavlin	73	} else {
328	dpavlin	163	$s.=$_.$wc." ";
329	dpavlin	73	}
330	dpavlin	7	}
331	dpavlin	73	$s =~ s/\+//g;
332	dpavlin	163	$s = $pre.$s.$post if ($q->param("e$i"));
333	dpavlin	73	push @swish_q,$s;
334	dpavlin	7	}
335	dpavlin	73	# FIXME default operator for multi-value fields is or. There is
336			# no way to change it, except here for now. Is there need?
337	dpavlin	163	push @s_arr, $q->param("f$i")."_swish".$exact."=(".join(" or ",@swish_q).")";
338	dpavlin	7	}
339
340	dpavlin	670	my $tmpl = $self->load_tmpl(url_ex($q,'results.html'), global_vars => 1, die_on_bad_params => 0);
341	dpavlin	9
342	dpavlin	304	$tmpl->param('url_params',"?".join("&",@url_params));
343
344	dpavlin	80	sub esc_html {
345			my $html = shift;
346			$html =~ s/</</g;
347			$html =~ s/>/>/g;
348			return $html;
349			}
350
351	dpavlin	202	my $sort = 'swishrank';
352			if ($q->param("sort")) {
353			$sort = 'headline';
354			push @persist_vars, "sort";
355			}
356	dpavlin	660
357			my $sortby = $q->param("sortby");
358			if ($sortby) {
359			$sort = $sortby;
360			push @persist_vars, "sortby";
361	dpavlin	659	}
362	dpavlin	660	$tmpl->param('url_params_paths',"?".join("&",@url_params).'&'.join("&",map { my $t = $_; $t =~ s/\#/%23/g; "path=$t"; } @path_arr));
363	dpavlin	202
364	dpavlin	47	# construct swish query
365			my $sw_q = join(" and ",@s_arr);
366	dpavlin	636	if (@path_arr && $q->param('show_full')) {
367	dpavlin	47	$sw_q .= "and (swishdocpath=\"";
368			$sw_q .= join("\" or swishdocpath=\"",@path_arr);
369			$sw_q .= "\")";
370	dpavlin	636	$tmpl->param('full',1); # show full records
371			} elsif ($q->param('show_full')) {
372	dpavlin	149	# just show full path, no path defined
373			$tmpl->param('full',1);
374	dpavlin	121	} else {
375			$tmpl->param('full',0);
376	dpavlin	47	}
377	dpavlin	7
378	dpavlin	657	my $swish_msg = ' ';
379
380	dpavlin	304	# create new swish instance
381			my $swish = SWISH::API->new($INDEX);
382	dpavlin	657	$swish_msg .= $swish->ErrorString." ".$swish->LastErrorMsg if $swish->Error;
383	dpavlin	47
384	dpavlin	304	# execute query and get number of results from SWISH-E
385			my $search = $swish->New_Search_Object;
386
387			$search->SetSort($sort);
388
389			my $results = $search->Execute($sw_q);
390	dpavlin	657	$swish_msg .= $swish->ErrorString." ".$swish->LastErrorMsg if $swish->Error;
391	dpavlin	304
392			my $hits = $results->Hits;
393
394	dpavlin	7	$tmpl->param('hits',$hits);
395	dpavlin	657	my $search_msg = $sw_q;
396			$search_msg .= '<em>'.$swish_msg.'</em>' if ($swish_msg);
397			$tmpl->param('search', $search_msg);
398	dpavlin	7
399	dpavlin	76	$tmpl->param('PAGER_offset',$q->param("PAGER_offset") \|\| 0);
400			$tmpl->param('last_PAGER_offset',$q->param("last_PAGER_offset") \|\| 0);
401	dpavlin	51
402	dpavlin	304	#
403			# build pager
404			#
405	dpavlin	126
406	dpavlin	304	my $current_page = $q->param('PAGER_offset') \|\| 1;
407	dpavlin	7
408	dpavlin	304	my $pager = Data::Pageset->new({
409			'total_entries' => $hits,
410			'entries_per_page' => $ON_PAGE,
411			'current_page' => $current_page,
412			'pages_per_set' => $pages_per_set,
413			});
414	dpavlin	7
415	dpavlin	304	$results->SeekResult( $pager->first - 1 );
416	dpavlin	7
417	dpavlin	304	# get number of entries on this page
418			my $i = $pager->entries_on_this_page;
419
420			# results from swish for template
421			my @pager_data_list;
422
423			for(my $i=$pager->first; $i<=$pager->last; $i++) {
424
425			my $result = $results->NextResult;
426			last if (! $result);
427
428			my $r = {
429			nr => $i,
430			path => $result->Property('swishdocpath'),
431			headline => esc_html($from_utf8->convert($result->Property('headline'))),
432			rank => $result->Property('swishrank')
433			};
434
435	dpavlin	636	$r->{html} = back2html($from_utf8->convert($result->Property('html')), join("&",@url_params_persist)) if ($q->param('show_full'));
436	dpavlin	304
437			push @pager_data_list, $r;
438			}
439
440
441
442			# put something in template
443			make_pager($q, $tmpl, $pager);
444			make_pager_vars($q, $tmpl, @persist_vars);
445			$tmpl->param('PAGER_DATA_LIST', \@pager_data_list);
446
447			my $html = $tmpl->output;
448
449	dpavlin	198	return in_template($q,$html);
450	dpavlin	7	}
451
452	dpavlin	9	sub show_index {
453			my $self = shift;
454			my $i = shift; # field number
455
456			my $q = $self->query();
457
458	dpavlin	11	my $field = $q->param("f$i");
459			my $limit = $q->param("v$i");
460
461	dpavlin	643	my $filter = $q->param("filter");
462
463	dpavlin	9	my $html;
464
465	dpavlin	53	my $index = new index_DBI(
466			$cfg_global->val('global', 'dbi_dbd'),
467			$cfg_global->val('global', 'dbi_dsn'),
468			$cfg_global->val('global', 'dbi_user'),
469			$cfg_global->val('global', 'dbi_passwd') \|\| ''
470			);
471	dpavlin	9
472	dpavlin	643	my $total = $index->count($field,$limit,$filter);
473	dpavlin	304
474	dpavlin	643	if (! defined($total)) {
475	dpavlin	198	my $tmpl = $self->load_tmpl(url_ex($q,'no_index.html'));
476	dpavlin	11	$tmpl->param('field',$field);
477			$html = $tmpl->output;
478			return $html;
479			}
480	dpavlin	9
481	dpavlin	670	my $tmpl = $self->load_tmpl(url_ex($q,'index_res.html'), global_vars => 1, die_on_bad_params => 0);
482	dpavlin	12	$tmpl->param('field',$field);
483			$tmpl->param('limit',$limit);
484			$tmpl->param('total',$total);
485	dpavlin	11
486	dpavlin	51	# FIXME I should set offset and leave out limit from fetch!!
487	dpavlin	16	# if (! $q->param("PAGER_offset") {
488			# $q->param("Pager_offet)
489			# }
490
491	dpavlin	11
492	dpavlin	304	#
493			# build pager
494			#
495			my $pager = Data::Pageset->new({
496			'total_entries' => $total,
497			'entries_per_page' => $ON_PAGE,
498			'current_page' => $q->param('PAGER_offset') \|\| 1,
499			'pages_per_set' => $pages_per_set
500			});
501	dpavlin	11
502	dpavlin	304	my @persist_vars = qw{rm f$i v$i f$i_index offset};
503
504			make_pager($q, $tmpl, $pager);
505			make_pager_vars($q, $tmpl, @persist_vars);
506
507	dpavlin	643	my @pager_data_list = $index->fetch($field,$limit, $pager->first - 1, $pager->entries_on_this_page, $filter);
508	dpavlin	304	$tmpl->param('PAGER_DATA_LIST', \@pager_data_list);
509
510			return in_template($q,$tmpl->output);
511	dpavlin	9	}
512
513	dpavlin	7	1;