branches/tehnika/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 POSIX qw(locale_h);

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;
my $locale = $cfg_global->val('locale') || 'hr_HR';

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

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

setlocale(LC_CTYPE, $locale);
setlocale(LC_COLLATE, $locale);

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 '');
                        $val =~ s/"/&quot;/g;
                        $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")) {
                        # escape quotes so that phrase search work
                        $v =~ s/"/%22/g;
                        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);
        $tmpl->param('filter',$filter);

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