| 1 |
#======================================================================= |
| 2 |
# Module for using Template-Toolkit for generating output |
| 3 |
# $Id: TemplateToolkit.pm,v 1.2 2001/12/08 21:48:00 whmoseley Exp $ |
| 4 |
# |
| 5 |
#======================================================================= |
| 6 |
package TemplateToolkit; |
| 7 |
use strict; |
| 8 |
|
| 9 |
use Template; |
| 10 |
use vars '$Template'; |
| 11 |
|
| 12 |
|
| 13 |
sub show_template { |
| 14 |
my ( $class, $template_params, $results ) = @_; |
| 15 |
|
| 16 |
my $cgi = $results->CGI; |
| 17 |
|
| 18 |
|
| 19 |
#/* Cached if running under mod_perl */ |
| 20 |
$Template ||= Template->new( $template_params->{options} ); |
| 21 |
|
| 22 |
|
| 23 |
die $Template->error() unless $Template; |
| 24 |
|
| 25 |
|
| 26 |
print $cgi->header; |
| 27 |
|
| 28 |
my $subclass = TemplateToolkit::Helpers->new( $results ); |
| 29 |
|
| 30 |
my $vars = { |
| 31 |
search => $subclass, |
| 32 |
CGI => $results->CGI, |
| 33 |
}; |
| 34 |
|
| 35 |
$Template->process( $template_params->{file}, $vars ) |
| 36 |
|| die "Template process failed for page '$template_params->{file}' ", $Template->error(), "\n"; |
| 37 |
} |
| 38 |
|
| 39 |
|
| 40 |
#================================================================== |
| 41 |
# Form setup for sorts and metas |
| 42 |
# |
| 43 |
# This could be methods of $results object |
| 44 |
# (and then available for Template-Toolkit) |
| 45 |
# But that's too much HTML in the object, perhaps. |
| 46 |
# |
| 47 |
# |
| 48 |
#================================================================== |
| 49 |
package TemplateToolkit::Helpers; |
| 50 |
use strict; |
| 51 |
|
| 52 |
sub new { |
| 53 |
my ( $class, $results ) = @_; |
| 54 |
|
| 55 |
|
| 56 |
@TemplateToolkit::Helpers::ISA = ref $results; # that doesn't look right. |
| 57 |
|
| 58 |
return bless $results, $class; |
| 59 |
} |
| 60 |
|
| 61 |
sub get_meta_name_limits { |
| 62 |
my ( $results ) = @_; |
| 63 |
|
| 64 |
my $metanames = $results->config('metanames'); |
| 65 |
return '' unless $metanames; |
| 66 |
|
| 67 |
|
| 68 |
my $name_labels = $results->config('name_labels'); |
| 69 |
my $q = $results->CGI; |
| 70 |
|
| 71 |
|
| 72 |
return join "\n", |
| 73 |
'Limit search to:', |
| 74 |
$q->radio_group( |
| 75 |
-name =>'metaname', |
| 76 |
-values => $metanames, |
| 77 |
-default=>$metanames->[0], |
| 78 |
-labels =>$name_labels |
| 79 |
), |
| 80 |
'<br>'; |
| 81 |
} |
| 82 |
|
| 83 |
sub get_sort_select_list { |
| 84 |
my ( $results ) = @_; |
| 85 |
|
| 86 |
my $sort_metas = $results->config('sorts'); |
| 87 |
return '' unless $sort_metas; |
| 88 |
|
| 89 |
|
| 90 |
my $name_labels = $results->config('name_labels'); |
| 91 |
my $q = $results->CGI; |
| 92 |
|
| 93 |
|
| 94 |
|
| 95 |
return join "\n", |
| 96 |
'Sort by:', |
| 97 |
$q->popup_menu( |
| 98 |
-name =>'sort', |
| 99 |
-values => $sort_metas, |
| 100 |
-default=>$sort_metas->[0], |
| 101 |
-labels =>$name_labels |
| 102 |
), |
| 103 |
$q->checkbox( |
| 104 |
-name => 'reverse', |
| 105 |
-label => 'Reverse Sort' |
| 106 |
); |
| 107 |
} |
| 108 |
|
| 109 |
|
| 110 |
|
| 111 |
|
| 112 |
sub get_index_select_list { |
| 113 |
my ( $results ) = @_; |
| 114 |
my $q = $results->CGI; |
| 115 |
|
| 116 |
|
| 117 |
my $indexes = $results->config('swish_index'); |
| 118 |
return '' unless ref $indexes eq 'ARRAY'; |
| 119 |
|
| 120 |
my $select_config = $results->config('select_indexes'); |
| 121 |
return '' unless $select_config && ref $select_config eq 'HASH'; |
| 122 |
|
| 123 |
|
| 124 |
# Should return a warning, as this might be a likely mistake |
| 125 |
# This jumps through hoops so that real index file name is not exposed |
| 126 |
|
| 127 |
return '' unless exists $select_config->{labels} |
| 128 |
&& ref $select_config->{labels} eq 'ARRAY' |
| 129 |
&& @$indexes == @{$select_config->{labels}}; |
| 130 |
|
| 131 |
|
| 132 |
my @labels = @{$select_config->{labels}}; |
| 133 |
my %map; |
| 134 |
|
| 135 |
for ( 0..$#labels ) { |
| 136 |
$map{$_} = $labels[$_]; |
| 137 |
} |
| 138 |
|
| 139 |
my $method = $select_config->{method} || 'checkbox_group'; |
| 140 |
my @cols = $select_config->{columns} ? ('-columns', $select_config->{columns}) : (); |
| 141 |
|
| 142 |
return join "\n", |
| 143 |
'<br>', |
| 144 |
( $select_config->{description} || 'Select: '), |
| 145 |
$q->$method( |
| 146 |
-name => 'si', |
| 147 |
-values => [0..$#labels], |
| 148 |
-default=> 0, |
| 149 |
-labels => \%map, |
| 150 |
@cols ); |
| 151 |
} |
| 152 |
|
| 153 |
|
| 154 |
sub get_limit_select { |
| 155 |
my ( $results ) = @_; |
| 156 |
my $q = $results->CGI; |
| 157 |
|
| 158 |
|
| 159 |
my $limit = $results->config('select_by_meta'); |
| 160 |
return '' unless ref $limit eq 'HASH'; |
| 161 |
|
| 162 |
my $method = $limit->{method} || 'checkbox_group'; |
| 163 |
|
| 164 |
my @options = ( |
| 165 |
-name => 'sbm', |
| 166 |
-values => $limit->{values}, |
| 167 |
-labels => $limit->{labels} || {}, |
| 168 |
); |
| 169 |
|
| 170 |
push @options, ( -columns=> $limit->{columns} ) if $limit->{columns}; |
| 171 |
|
| 172 |
|
| 173 |
return join "\n", |
| 174 |
'<br>', |
| 175 |
( $limit->{description} || 'Select: '), |
| 176 |
$q->$method( @options ); |
| 177 |
} |
| 178 |
|
| 179 |
sub stopwords_removed { |
| 180 |
my $results = shift; |
| 181 |
|
| 182 |
my $swr = $results->header('removed stopwords'); |
| 183 |
my $stopwords = ''; |
| 184 |
|
| 185 |
|
| 186 |
if ( $swr && ref $swr eq 'ARRAY' ) { |
| 187 |
$stopwords = @$swr > 1 |
| 188 |
? join( ', ', map { "<b>$_</b>" } @$swr ) . ' are very common words and were not included in your search' |
| 189 |
: join( ', ', map { "<b>$_</b>" } @$swr ) . ' is a very common word and was not included in your search'; |
| 190 |
} |
| 191 |
|
| 192 |
return $stopwords; |
| 193 |
} |
| 194 |
|
| 195 |
|
| 196 |
|
| 197 |
1; |
| 198 |
|
Parent Directory
| 
Revision Log
| 
Revision Graph