| 1 |
adcroft |
1.1 |
#===================================================================== |
| 2 |
|
|
# These routines format the HTML output. |
| 3 |
|
|
# $Id: TemplateDefault.pm,v 1.6 2002/05/27 15:28:58 whmoseley Exp $ |
| 4 |
|
|
#===================================================================== |
| 5 |
|
|
package TemplateDefault; |
| 6 |
|
|
use strict; |
| 7 |
|
|
|
| 8 |
|
|
use CGI; |
| 9 |
|
|
|
| 10 |
|
|
sub show_template { |
| 11 |
|
|
my ( $class, $template_params, $results ) = @_; |
| 12 |
|
|
|
| 13 |
|
|
|
| 14 |
|
|
my $q = $results->CGI; |
| 15 |
|
|
|
| 16 |
|
|
my $output = $q->header . page_header( $results ); |
| 17 |
|
|
|
| 18 |
|
|
# Show form at top always |
| 19 |
|
|
$output .= show_form( $results ); |
| 20 |
|
|
|
| 21 |
|
|
|
| 22 |
|
|
if ( $results->results ) { |
| 23 |
|
|
$output .= results_header( $results ); |
| 24 |
|
|
$output .= show_result( $results, $_ ) for @{ $results->results }; |
| 25 |
|
|
} |
| 26 |
|
|
|
| 27 |
|
|
# Form after results (or at top if no results) |
| 28 |
|
|
#$output .= show_form( $results ); |
| 29 |
|
|
|
| 30 |
|
|
$output .= footer( $results ); |
| 31 |
|
|
|
| 32 |
|
|
print $output; |
| 33 |
|
|
|
| 34 |
|
|
} |
| 35 |
|
|
|
| 36 |
|
|
#===================================================================== |
| 37 |
|
|
# This generates the header |
| 38 |
|
|
|
| 39 |
|
|
sub page_header { |
| 40 |
|
|
my $results = shift; |
| 41 |
|
|
my $title = $results->config('title') || 'Search our site with Swish-e'; |
| 42 |
|
|
my $message = $results->errstr; |
| 43 |
|
|
|
| 44 |
|
|
$message = $message |
| 45 |
|
|
? qq[<br><font color="red">$message</font>] |
| 46 |
|
|
: '' ; |
| 47 |
|
|
|
| 48 |
|
|
|
| 49 |
|
|
my $html_title = $results->results |
| 50 |
|
|
? ( $results->navigation('hits') |
| 51 |
|
|
. ' Results for [' |
| 52 |
|
|
. CGI::escapeHTML( $results->{query_simple} ) |
| 53 |
|
|
. ']' |
| 54 |
|
|
) |
| 55 |
|
|
|
| 56 |
|
|
: ( $results->errstr || $title ); |
| 57 |
|
|
|
| 58 |
|
|
|
| 59 |
|
|
my $logo = $results->config('on_intranet') |
| 60 |
|
|
? '' |
| 61 |
|
|
: '<a href="http://swish-e.org"><img border="0" alt="Swish-e home page" src="http://swish-e.org/Images/swish-e.gif"></a> ' ; |
| 62 |
|
|
|
| 63 |
|
|
return <<EOF; |
| 64 |
|
|
<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN"> |
| 65 |
|
|
<html> |
| 66 |
|
|
<head> |
| 67 |
|
|
<title> |
| 68 |
|
|
$html_title |
| 69 |
|
|
</title> |
| 70 |
|
|
</head> |
| 71 |
|
|
<body> |
| 72 |
|
|
<h2> |
| 73 |
|
|
$logo$title $message |
| 74 |
|
|
</h2> |
| 75 |
|
|
EOF |
| 76 |
|
|
} |
| 77 |
|
|
|
| 78 |
|
|
#===================================================================== |
| 79 |
|
|
# This generates the form |
| 80 |
|
|
# |
| 81 |
|
|
# Pass: |
| 82 |
|
|
# $results hash |
| 83 |
|
|
|
| 84 |
|
|
sub show_form { |
| 85 |
|
|
|
| 86 |
|
|
my $results = shift; |
| 87 |
|
|
my $q = $results->{q}; |
| 88 |
|
|
|
| 89 |
|
|
|
| 90 |
|
|
my $query = $q->param('query') || ''; |
| 91 |
|
|
|
| 92 |
|
|
$query = CGI::escapeHTML( $query ); # May contain quotes |
| 93 |
|
|
|
| 94 |
|
|
|
| 95 |
|
|
# Here's some form components |
| 96 |
|
|
|
| 97 |
|
|
my $meta_select_list = get_meta_name_limits( $results ); |
| 98 |
|
|
my $sorts = get_sort_select_list( $results ); |
| 99 |
|
|
my $select_index = get_index_select_list( $results ); |
| 100 |
|
|
my $limit_select = get_limit_select( $results ); |
| 101 |
|
|
|
| 102 |
|
|
my $date_ranges_select = $results->get_date_ranges; |
| 103 |
|
|
|
| 104 |
|
|
|
| 105 |
|
|
my $form = $q->script_name; |
| 106 |
|
|
|
| 107 |
|
|
return <<EOF; |
| 108 |
|
|
<form method="get" action="$form" enctype="application/x-www-form-urlencoded" class="form"> |
| 109 |
|
|
<input maxlength="200" value="$query" size="32" type="text" name="query"/> |
| 110 |
|
|
<input value="Search!" type="submit" name="submit"/><br> |
| 111 |
|
|
|
| 112 |
|
|
$meta_select_list |
| 113 |
|
|
$sorts |
| 114 |
|
|
$select_index |
| 115 |
|
|
$limit_select |
| 116 |
|
|
$date_ranges_select |
| 117 |
|
|
</form> |
| 118 |
|
|
EOF |
| 119 |
|
|
} |
| 120 |
|
|
|
| 121 |
|
|
|
| 122 |
|
|
#===================================================================== |
| 123 |
|
|
# This routine creates the results header display |
| 124 |
|
|
# and navigation bar |
| 125 |
|
|
# |
| 126 |
|
|
# |
| 127 |
|
|
# |
| 128 |
|
|
|
| 129 |
|
|
sub results_header { |
| 130 |
|
|
|
| 131 |
|
|
my $results = shift; |
| 132 |
|
|
my $config = $results->{config}; |
| 133 |
|
|
my $q = $results->{q}; |
| 134 |
|
|
|
| 135 |
|
|
|
| 136 |
|
|
|
| 137 |
|
|
my $swr = $results->header('removed stopwords'); |
| 138 |
|
|
my $stopwords = ''; |
| 139 |
|
|
|
| 140 |
|
|
|
| 141 |
|
|
if ( $swr && ref $swr eq 'ARRAY' ) { |
| 142 |
|
|
$stopwords = @$swr > 1 |
| 143 |
|
|
? join( ', ', map { "<b>$_</b>" } @$swr ) . ' are very common words and were not included in your search' |
| 144 |
|
|
: join( ', ', map { "<b>$_</b>" } @$swr ) . ' is a very common word and was not included in your search'; |
| 145 |
|
|
} |
| 146 |
|
|
|
| 147 |
|
|
my $limits = ''; |
| 148 |
|
|
|
| 149 |
|
|
# Ok, this is ugly. |
| 150 |
|
|
|
| 151 |
|
|
|
| 152 |
|
|
if ( $results->{DateRanges_time_low} && $results->{DateRanges_time_high} ) { |
| 153 |
|
|
my $low = scalar localtime $results->{DateRanges_time_low}; |
| 154 |
|
|
my $high = scalar localtime $results->{DateRanges_time_high}; |
| 155 |
|
|
$limits = <<EOF; |
| 156 |
|
|
<tr> |
| 157 |
|
|
<td colspan=2> |
| 158 |
|
|
<font size="-2" face="Geneva, Arial, Helvetica, San-Serif"> |
| 159 |
|
|
Results limited to dates $low to $high |
| 160 |
|
|
</font> |
| 161 |
|
|
</td> |
| 162 |
|
|
</tr> |
| 163 |
|
|
EOF |
| 164 |
|
|
} |
| 165 |
|
|
|
| 166 |
|
|
my $query_href = $results->{query_href}; |
| 167 |
|
|
my $query_simple = CGI::escapeHTML( $results->{query_simple} ); |
| 168 |
|
|
my $pages = $results->navigation('pages'); |
| 169 |
|
|
|
| 170 |
|
|
my $prev = $results->navigation('prev'); |
| 171 |
|
|
my $prev_count = $results->navigation('prev_count'); |
| 172 |
|
|
my $next = $results->navigation('next'); |
| 173 |
|
|
my $next_count = $results->navigation('next_count'); |
| 174 |
|
|
|
| 175 |
|
|
my $hits = $results->navigation('hits'); |
| 176 |
|
|
my $from = $results->navigation('from'); |
| 177 |
|
|
my $to = $results->navigation('to'); |
| 178 |
|
|
|
| 179 |
|
|
my $run_time = $results->navigation('run_time'); |
| 180 |
|
|
my $search_time = $results->navigation('search_time'); |
| 181 |
|
|
|
| 182 |
|
|
|
| 183 |
|
|
|
| 184 |
|
|
|
| 185 |
|
|
|
| 186 |
|
|
my $links = ''; |
| 187 |
|
|
|
| 188 |
|
|
$links .= '<font size="-1" face="Geneva, Arial, Helvetica, San-Serif"> Page:</font>' . $pages |
| 189 |
|
|
if $pages; |
| 190 |
|
|
|
| 191 |
|
|
$links .= qq[ <a href="$query_href&start=$prev">Previous $prev_count</a>] |
| 192 |
|
|
if $prev_count; |
| 193 |
|
|
|
| 194 |
|
|
$links .= qq[ <a href="$query_href&start=$next">Next $next_count</a>] |
| 195 |
|
|
if $next_count; |
| 196 |
|
|
|
| 197 |
|
|
|
| 198 |
|
|
# Save for the bottom of the screen. |
| 199 |
|
|
$results->{LINKS} = $links; |
| 200 |
|
|
|
| 201 |
|
|
$links = qq[<tr><td colspan=2 bgcolor="#EEEEEE">$links</td></tr>] if $links; |
| 202 |
|
|
|
| 203 |
|
|
$query_simple = $query_simple |
| 204 |
|
|
? " Results for <b>$query_simple</b>" |
| 205 |
|
|
: ''; |
| 206 |
|
|
|
| 207 |
|
|
|
| 208 |
|
|
|
| 209 |
|
|
return <<EOF; |
| 210 |
|
|
|
| 211 |
|
|
<table cellpadding=0 cellspacing=0 border=0 width="100%"> |
| 212 |
|
|
<tr> |
| 213 |
|
|
<td height=20 bgcolor="#FF9999"> |
| 214 |
|
|
<font size="-1" face="Geneva, Arial, Helvetica, San-Serif"> |
| 215 |
|
|
$query_simple |
| 216 |
|
|
$from to $to of $hits results. |
| 217 |
|
|
</font> |
| 218 |
|
|
</td> |
| 219 |
|
|
<td align=right bgcolor="#FF9999"> |
| 220 |
|
|
<font size="-2" face="Geneva, Arial, Helvetica, San-Serif"> |
| 221 |
|
|
Run time: $run_time | |
| 222 |
|
|
Search time: $search_time |
| 223 |
|
|
</font> |
| 224 |
|
|
</td> |
| 225 |
|
|
</tr> |
| 226 |
|
|
|
| 227 |
|
|
$links |
| 228 |
|
|
$limits |
| 229 |
|
|
$stopwords |
| 230 |
|
|
|
| 231 |
|
|
</table> |
| 232 |
|
|
|
| 233 |
|
|
EOF |
| 234 |
|
|
|
| 235 |
|
|
} |
| 236 |
|
|
|
| 237 |
|
|
#===================================================================== |
| 238 |
|
|
# This routine formats a single result |
| 239 |
|
|
# |
| 240 |
|
|
# |
| 241 |
|
|
sub show_result { |
| 242 |
|
|
my ($results, $this_result ) = @_; |
| 243 |
|
|
|
| 244 |
|
|
my $conf = $results->{conf}; |
| 245 |
|
|
|
| 246 |
|
|
my $DocTitle = $results->config('title_property') || 'swishtitle'; |
| 247 |
|
|
|
| 248 |
|
|
|
| 249 |
|
|
my $title = $this_result->{$DocTitle} || $this_result->{swishdocpath} || '?'; |
| 250 |
|
|
|
| 251 |
|
|
my $name_labels = $results->config('name_labels'); |
| 252 |
|
|
|
| 253 |
|
|
|
| 254 |
|
|
|
| 255 |
|
|
|
| 256 |
|
|
# The the properties to display |
| 257 |
|
|
|
| 258 |
|
|
my $props = ''; |
| 259 |
|
|
|
| 260 |
|
|
my $display_props = $results->config('display_props'); |
| 261 |
|
|
if ( $display_props ) { |
| 262 |
|
|
|
| 263 |
|
|
|
| 264 |
|
|
$props = join "\n", |
| 265 |
|
|
'<br><table cellpadding=0 cellspacing=0>', |
| 266 |
|
|
map ( { |
| 267 |
|
|
'<tr><td><small>' |
| 268 |
|
|
. ( $name_labels->{$_} || $_ ) |
| 269 |
|
|
. ':</small></td><td><small> ' |
| 270 |
|
|
. '<b>' |
| 271 |
|
|
. $this_result->{$_} |
| 272 |
|
|
. '</b>' |
| 273 |
|
|
. '</small></td></tr>' |
| 274 |
|
|
} @$display_props |
| 275 |
|
|
), |
| 276 |
|
|
'</table>'; |
| 277 |
|
|
} |
| 278 |
|
|
|
| 279 |
|
|
|
| 280 |
|
|
my $description_prop = $results->config('description_prop'); |
| 281 |
|
|
|
| 282 |
|
|
my $description = ''; |
| 283 |
|
|
if ( $description_prop ) { |
| 284 |
|
|
$description = $this_result->{ $description_prop } || ''; |
| 285 |
|
|
} |
| 286 |
|
|
|
| 287 |
|
|
|
| 288 |
|
|
return <<EOF; |
| 289 |
|
|
<dl> |
| 290 |
|
|
<dt>$this_result->{swishreccount} <a href="$this_result->{swishdocpath_href}">$title</a> <small>-- rank: <b>$this_result->{swishrank}</b></small></dt> |
| 291 |
|
|
<dd>$description |
| 292 |
|
|
|
| 293 |
|
|
$props |
| 294 |
|
|
</dd> |
| 295 |
|
|
</dl> |
| 296 |
|
|
|
| 297 |
|
|
EOF |
| 298 |
|
|
|
| 299 |
|
|
} |
| 300 |
|
|
|
| 301 |
|
|
#===================================================================== |
| 302 |
|
|
# This is displayed on the bottom of every page |
| 303 |
|
|
# |
| 304 |
|
|
# |
| 305 |
|
|
|
| 306 |
|
|
|
| 307 |
|
|
sub footer { |
| 308 |
|
|
my $results = shift; |
| 309 |
|
|
|
| 310 |
|
|
my $mod_perl = $ENV{MOD_PERL} |
| 311 |
|
|
? '<br><small>Response brought to you by <a href="http://perl.apache.org"><em>mod_perl</em></a></small>' |
| 312 |
|
|
: ''; |
| 313 |
|
|
|
| 314 |
|
|
my $valid_html_logo = $results->config('on_intranet') |
| 315 |
|
|
? '' |
| 316 |
|
|
: '<p><a href="http://validator.w3.org/check/referer"><img border="0" src="http://www.w3.org/Icons/valid-html401" alt="Valid HTML 4.01!" height="31" width="88"></a></p>'; |
| 317 |
|
|
|
| 318 |
|
|
|
| 319 |
|
|
return <<EOF; |
| 320 |
|
|
|
| 321 |
|
|
<hr> |
| 322 |
|
|
<small>Powered by <em>Swish-e</em> <a href="http://swish-e.org">swish-e.org</a></small> |
| 323 |
|
|
$mod_perl |
| 324 |
|
|
$valid_html_logo |
| 325 |
|
|
</body> |
| 326 |
|
|
</html> |
| 327 |
|
|
EOF |
| 328 |
|
|
} |
| 329 |
|
|
|
| 330 |
|
|
#================================================================== |
| 331 |
|
|
# Form setup for sorts and metas |
| 332 |
|
|
# |
| 333 |
|
|
# This could be methods of $results object |
| 334 |
|
|
# (and then available for Template-Toolkit) |
| 335 |
|
|
# But that's too much HTML in the object, perhaps. |
| 336 |
|
|
# |
| 337 |
|
|
# |
| 338 |
|
|
#================================================================== |
| 339 |
|
|
|
| 340 |
|
|
sub get_meta_name_limits { |
| 341 |
|
|
my ( $results ) = @_; |
| 342 |
|
|
|
| 343 |
|
|
my $metanames = $results->config('metanames'); |
| 344 |
|
|
return '' unless $metanames; |
| 345 |
|
|
|
| 346 |
|
|
|
| 347 |
|
|
my $name_labels = $results->config('name_labels'); |
| 348 |
|
|
my $q = $results->CGI; |
| 349 |
|
|
|
| 350 |
|
|
|
| 351 |
|
|
return join "\n", |
| 352 |
|
|
'Limit search to:', |
| 353 |
|
|
$q->radio_group( |
| 354 |
|
|
-name =>'metaname', |
| 355 |
|
|
-values => $metanames, |
| 356 |
|
|
-default=>$metanames->[0], |
| 357 |
|
|
-labels =>$name_labels |
| 358 |
|
|
), |
| 359 |
|
|
'<br>'; |
| 360 |
|
|
} |
| 361 |
|
|
|
| 362 |
|
|
sub get_sort_select_list { |
| 363 |
|
|
my ( $results ) = @_; |
| 364 |
|
|
|
| 365 |
|
|
my $sort_metas = $results->config('sorts'); |
| 366 |
|
|
return '' unless $sort_metas; |
| 367 |
|
|
|
| 368 |
|
|
|
| 369 |
|
|
my $name_labels = $results->config('name_labels'); |
| 370 |
|
|
my $q = $results->CGI; |
| 371 |
|
|
|
| 372 |
|
|
|
| 373 |
|
|
|
| 374 |
|
|
return join "\n", |
| 375 |
|
|
'Sort by:', |
| 376 |
|
|
$q->popup_menu( |
| 377 |
|
|
-name =>'sort', |
| 378 |
|
|
-values => $sort_metas, |
| 379 |
|
|
-default=>$sort_metas->[0], |
| 380 |
|
|
-labels =>$name_labels |
| 381 |
|
|
), |
| 382 |
|
|
$q->checkbox( |
| 383 |
|
|
-name => 'reverse', |
| 384 |
|
|
-label => 'Reverse Sort' |
| 385 |
|
|
); |
| 386 |
|
|
} |
| 387 |
|
|
|
| 388 |
|
|
|
| 389 |
|
|
|
| 390 |
|
|
sub get_index_select_list { |
| 391 |
|
|
my ( $results ) = @_; |
| 392 |
|
|
my $q = $results->CGI; |
| 393 |
|
|
|
| 394 |
|
|
|
| 395 |
|
|
my $indexes = $results->config('swish_index'); |
| 396 |
|
|
return '' unless ref $indexes eq 'ARRAY'; |
| 397 |
|
|
|
| 398 |
|
|
my $select_config = $results->config('select_indexes'); |
| 399 |
|
|
return '' unless $select_config && ref $select_config eq 'HASH'; |
| 400 |
|
|
|
| 401 |
|
|
|
| 402 |
|
|
# Should return a warning, as this might be a likely mistake |
| 403 |
|
|
# This jumps through hoops so that real index file name is not exposed |
| 404 |
|
|
|
| 405 |
|
|
return '' unless exists $select_config->{labels} |
| 406 |
|
|
&& ref $select_config->{labels} eq 'ARRAY' |
| 407 |
|
|
&& @$indexes == @{$select_config->{labels}}; |
| 408 |
|
|
|
| 409 |
|
|
|
| 410 |
|
|
my @labels = @{$select_config->{labels}}; |
| 411 |
|
|
my %map; |
| 412 |
|
|
|
| 413 |
|
|
for ( 0..$#labels ) { |
| 414 |
|
|
$map{$_} = $labels[$_]; |
| 415 |
|
|
} |
| 416 |
|
|
|
| 417 |
|
|
my $method = $select_config->{method} || 'checkbox_group'; |
| 418 |
|
|
my @cols = $select_config->{columns} ? ('-columns', $select_config->{columns}) : (); |
| 419 |
|
|
|
| 420 |
|
|
return join "\n", |
| 421 |
|
|
'<br>', |
| 422 |
|
|
( $select_config->{description} || 'Select: '), |
| 423 |
|
|
$q->$method( |
| 424 |
|
|
-name => 'si', |
| 425 |
|
|
-values => [0..$#labels], |
| 426 |
|
|
-default=> 0, |
| 427 |
|
|
-labels => \%map, |
| 428 |
|
|
@cols ); |
| 429 |
|
|
} |
| 430 |
|
|
|
| 431 |
|
|
|
| 432 |
|
|
sub get_limit_select { |
| 433 |
|
|
my ( $results ) = @_; |
| 434 |
|
|
my $q = $results->CGI; |
| 435 |
|
|
|
| 436 |
|
|
|
| 437 |
|
|
my $limit = $results->config('select_by_meta'); |
| 438 |
|
|
return '' unless ref $limit eq 'HASH'; |
| 439 |
|
|
|
| 440 |
|
|
my $method = $limit->{method} || 'checkbox_group'; |
| 441 |
|
|
|
| 442 |
|
|
my @options = ( |
| 443 |
|
|
-name => 'sbm', |
| 444 |
|
|
-values => $limit->{values}, |
| 445 |
|
|
-labels => $limit->{labels} || {}, |
| 446 |
|
|
); |
| 447 |
|
|
|
| 448 |
|
|
push @options, ( -columns=> $limit->{columns} ) if $limit->{columns}; |
| 449 |
|
|
|
| 450 |
|
|
|
| 451 |
|
|
return join "\n", |
| 452 |
|
|
'<br>', |
| 453 |
|
|
( $limit->{description} || 'Select: '), |
| 454 |
|
|
$q->$method( @options ); |
| 455 |
|
|
} |
| 456 |
|
|
1; |
| 457 |
|
|
|
Parent Directory
| 
Revision Log
| 
Revision Graph
