| 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
