#!/usr/bin/perl -w
##########################################################
#
# Pwebrecon.cgi wrapper script
# Version 2.0
#
# 2006-2007, Michael Doran, Systems Librarian
# University of Texas at Arlington
# doran@uta.edu
#
# A tip of the hat to:
# Ere Maijala, The National Library of Finland
#
##########################################################
use strict;
##########################################################
#
my $data_stream;
my %formdata;
# Forego the default header and footer files
my $include_dir = "../html/inc";
my $meta_code = GrabInc("$include_dir/meta.inc");
my $meta_plus = GrabInc("$include_dir/metaplus.inc");
$meta_code .= $meta_plus;
my $head_code = GrabInc("$include_dir/header.inc");
my $foot_code = GrabInc("$include_dir/footer.inc");
my $cgi_app_url = '';
if ($ENV{'HTTP_HOST'} && $ENV{'SCRIPT_NAME'}) {
my $http_prot = "http://";
if ($ENV{'HTTPS'}) {
$http_prot = "https://";
}
$cgi_app_url = "$http_prot$ENV{'HTTP_HOST'}$ENV{'SCRIPT_NAME'}?";
}
my $query_string = $ENV{'QUERY_STRING'};
# URL unencode Query String
$query_string =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
my $form_meth = $ENV{'REQUEST_METHOD'};
# The HTTP request method seems to impact when
if ($form_meth eq 'POST') {
$data_stream = GetOrigDataStream();
ReadParse();
} elsif ($form_meth eq 'GET') {
ReadParse();
$data_stream = GetOrigDataStream();
} else {
$ENV{'QUERY_STRING'} = 'DB=local&PAGE=First';
$data_stream = GetOrigDataStream();
}
##########################################################
#
# Parse opac.ini
#
# Path to WebVoyage opac.ini file
my $opac_ini = "../../etc/webvoyage/local/opac.ini";
# Variables used to identify active search pages
my $tab_text_simple = '';
my $tab_text_advanced = '';
my $tab_text_reserves = '';
my $active_font_color_simple = '';
my $active_font_color_advanced = '';
my $active_font_color_reserves = '';
my $active_tab_color_simple = '';
my $active_tab_color_advanced = '';
my $active_tab_color_reserves = '';
ParseOpacIni();
##########################################################
#
# Munging
#
# Do "all pages" data munging
$data_stream = MungeAllPages($data_stream);
# Do search tab dependent munging
# <font color="#000000"> Search</font>
if ($data_stream =~
/<font color="$active_font_color_simple"> $tab_text_simple</) {
$data_stream = MungeSimpleSearch($data_stream);
} elsif ($data_stream =~
/<font color="$active_font_color_advanced"> $tab_text_advanced</) {
$data_stream = MungeAdvancedSearch($data_stream);
} elsif ($data_stream =~
/<font color="$active_font_color_reserves">.*$tab_text_reserves</) {
}
# Regurgitate the munged data
print $data_stream;
#print $data_stream . DebugIt();
sub DebugIt {
print "\n";
print "\$tab_text_simple = $tab_text_simple" . "\n";
print "\$active_font_color_simple = $active_font_color_simple" . "\n";
print "\$tab_text_advanced = $tab_text_advanced" . "\n";
print "\$tab_text_reserves = $tab_text_reserves" . "\n";
}
##########################################################
# MungeSimpleSearch
##########################################################
sub MungeSimpleSearch {
my ($data_stream) = @_;
# Remove (hide) reset button
$data_stream =~ s#TYPE="RESET"#TYPE="hidden"#i;
$data_stream =~ s#<SELECT NAME="CNT">.*?</SELECT>#<input type="hidden" name="CNT" value="50" />#s;
$data_stream =~ s#<A HREF=.*Search Limits"></A>##i;
# Remove (hide) search button
$data_stream =~ s#TYPE="SUBMIT"#TYPE="hidden"#gi;
$data_stream =~ s#TYPE="RADIO"#TYPE="hidden"#gi;
$data_stream =~ s#(<input .+? name=Search_Arg .+?>)#<nobr>$1 <INPUT
TYPE="SUBMIT" VALUE="Catalog Search"></nobr>#gi;
# strip out extra css
$data_stream =~ s#<.*?webvoyage-extra.css.*?>##;
return $data_stream;
}
##########################################################
# MungeAdvancedSearch
##########################################################
sub MungeAdvancedSearch {
my ($data_stream, $page_value) = @_;
my $pid_value = "";
my $seq_value = "";
if ($data_stream =~ /<INPUT TYPE=HIDDEN NAME=PID VALUE="(.+?)">/i) {
$pid_value = $1;
}
if ($data_stream =~ /<INPUT TYPE=HIDDEN NAME=SEQ VALUE="([\d]+?)">/i) {
$seq_value = $1;
}
my $journal_search = qq(
<div align="center">
<table border="0" width="95%">
<tr>
<td bgcolor="$active_tab_color_advanced">
<b>Journal Search</b>
</td>
<td width="80%">
</td>
</tr>
<tr>
<td colspan="2" bgcolor="$active_tab_color_advanced" align="left">
<FORM NAME="querybox" ACTION="/cgi-bin/Pwebrecon.cgi" METHOD="GET" AUTOCOMPLETE="OFF">
<br />
<input size=40 maxlength=100 name=Search_Arg size=35>
<INPUT TYPE="SUBMIT" VALUE="Journal Title Search">
<INPUT TYPE="hidden" NAME="Search_Code" VALUE="JALL" CHECKED="CHECKED">
<INPUT TYPE=HIDDEN NAME=PID VALUE="$pid_value">
<INPUT TYPE=HIDDEN NAME=SEQ VALUE="$seq_value">
<INPUT TYPE=HIDDEN NAME=CNT VALUE="50">
<INPUT TYPE=HIDDEN NAME=HIST VALUE="1">
</FORM>
</td>
</tr>
<tr>
<td colspan="2" bgcolor="$active_tab_color_advanced" align="center">
Looking for <b><i>articles?</i></b> Try the Library's
<a href="http://library.uta.edu/researchResources/findArticles.jsp">Find Articles</a> page.
<br /><br />
</td>
</tr>
</table>
<br />
</div>
);
$data_stream =~ s#<!-- journal search goes here -->#$journal_search#;
# strip out extra css
$data_stream =~ s#<.*?webvoyage-extra.css.*?>##;
return $data_stream;
}
##########################################################
# MungeAllPages
##########################################################
sub MungeAllPages {
my ($data_stream) = @_;
$data_stream =~ s#(</HEAD>)#$meta_code\n$1#;
$data_stream =~ s#(<BODY.*?>)#$1\n$head_code#;
$data_stream =~ s#</BODY>#\n$foot_code\n</BODY>#;
# Remove database name
$data_stream =~ s#<TD><STRONG>.*?</STRONG>University of Texas at Arlington Library</TD>##g;
# Add some "no print" style sheet class attributes
$data_stream =~ s#<CENTER>#<CENTER class="noprint">#g;
$data_stream =~ s#<CENTER(.*SAVEQUERYPAGE.*</CENTER>)#<CENTER class="noprint"$1#s;
$data_stream =~ s#<CENTER(.*SAVEQUERYPAGE.*</CENTER>)#<CENTER class="noprint"$1#s;
$data_stream =~ s#(alt="next")#$1 class="noprint"#gi;
$data_stream =~ s#(alt="previous")#$1 class="noprint"#gi;
$data_stream =~ s#Search request: (.*)</TD>.*Results: (.*) entries.#<br />$2 entries for <b>$1</b>#s;
# Minimize "Relevance" column in Titles List page
# and "Relevance" row in record View pages
$data_stream =~ s#>[\s]*Relevance\:*[\s]*</T#></T#g;
$data_stream =~ s#<IMG SRC="/images/s-rel[\d]?[h]?\.gif".*>?##g;
$data_stream =~ s#Call Number: (</FONT>)#$1#g;
# $data_stream =~ s#(Location:)(.*)(</FONT>)#$1<b>$2</b>$3#g;
# Remove unneeded image tags
$data_stream =~ s#<IMG ALIGN="MIDDLE" BORDER=0 SRC="/images/Disabled[\w]*\.gif">##gi;
$data_stream =~ s#<IMG ALIGN=MIDDLE BORDER=0 SRC="/images/d-[\w]*\.gif">##gi;
# Remove "Disabled" gif links
$data_stream =~ s#<IMG [^<^>]*SRC="/images/Disabled[\w]+.gif">##i;
# Convert some <th> cells to <td> cells
# Hmmm... too many unintended consequences
#$data_stream =~ s#<th (nowrap .*?)</th>#<td $1</td>#igs;
# Align status in results list
$data_stream =~ s#(<TD)(>.*?hilite[pn][oe][sg].*?)(</TD>)#$1 align="right"$2$3#gi;
# Open contextual help in pop-up window
$data_stream =~ s#HREF="(/help/[\w]*.htm)"#href="\#"
onClick="HelpWindow=window.open('$1','MyWindow','toolbar=yes,location=yes,
directories=yes,status=yes,menubar=yes,scrollbars=yes,resizable=yes,
width=725,height=725'); if (window.focus) {HelpWindow.focus()}
return false;"#gi;
return $data_stream;
}
##########################################################
# ParseOpacIni
##########################################################
sub ParseOpacIni {
my $tab_text_temp = '';
my $active_font_color_temp = '';
my $active_tab_color_temp = '';
open my $OPAC_INI_FILE, '<', $opac_ini
or warn "Can't open '$opac_ini': $!";
my @lines = <$OPAC_INI_FILE>;
while (my $line = pop @lines) {
chomp ($line);
if ($line =~ /^Tab_Text=/) {
$tab_text_temp = $line;
$tab_text_temp =~ s/^Tab_Text=(.*)$/$1/;
} elsif ($line =~ /^ActiveFontColor=/) {
$active_font_color_temp = $line;
$active_font_color_temp =~ s/^ActiveFontColor=(.*)$/$1/;
} elsif ($line =~ /^ActiveTabColor=/) {
$active_tab_color_temp = $line;
$active_tab_color_temp =~ s/^ActiveTabColor=(.*)$/$1/;
} elsif ($line =~ /^\[Combined_Search_Page\]/) {
$tab_text_simple = $tab_text_temp;
$active_font_color_simple = $active_font_color_temp;
$active_tab_color_simple = $active_tab_color_temp;
} elsif ($line =~ /^\[Boolean_Search_Page\]/) {
$tab_text_advanced = $tab_text_temp;
$active_font_color_advanced = $active_font_color_temp;
$active_tab_color_advanced = $active_tab_color_temp;
} elsif ($line =~ /^\[Course_Reserve_Search_Page\]/) {
$tab_text_reserves = $tab_text_temp;
$active_font_color_reserves = $active_font_color_temp;
$active_tab_color_reserves = $active_tab_color_temp;
}
}
close $OPAC_INI_FILE;
}
##########################################################
# GetOrigDataStream
##########################################################
sub GetOrigDataStream {
my $search_arg = $formdata{'Search_Arg'};
# Normal WebVoyage truncation symbol is ?
# Allow for '*' to be used as truncation symbol
$search_arg =~ s/\*/?/g;
# Also fix "double space" no hits bug
$search_arg =~ s/ / /g;
# for debugging
#`echo $search_arg | mailx -s "S arg" doran`;
#`env | grep -i query | mailx -s "Query String" doran`;
if ($ENV{'QUERY_STRING'}) {
# make the Search_Arg URL-ready...
$search_arg =~ s/(\W)/sprintf("%%%X", ord($1))/eg;
$search_arg =~ s/%20/+/g;
$ENV{'QUERY_STRING'} =~ s/Arg=.*?&Search/Arg=$search_arg&Search/;
}
my $data_stream = `./Pwebrecon-orig.cgi`;
return $data_stream;
}
##########################################################
# ReadParse
##########################################################
#
# ReadParse reads in and parses the CGI input.
# It reads / QUERY_STRING ("get" method)
# \ STDIN ("post" method)
sub ReadParse {
my ($meth, $formdata, $pair, $name, $value);
# Retrieve useful ENVIRONMENT VARIABLES
$meth = $ENV{'REQUEST_METHOD'};
# If method unspecified or if method is GET
if ($meth eq '' || $meth eq 'GET') {
# Read in query string
$formdata = $ENV{'QUERY_STRING'};
}
# If method is POST
elsif ($meth eq 'POST') {
read(STDIN, $formdata, $ENV{'CONTENT_LENGTH'});
}
else {
die "Unknown request method: $meth\n";
}
# name-value pairs are separated and put into a list array
my @pairs = split(/&/, $formdata);
foreach $pair (@pairs) {
# names and values are split apart
($name, $value) = split(/=/, $pair);
# pluses (+'s) are translated into spaces
$value =~ tr/+/ /;
# hex values (%xx) are converted to alphanumeric
$name =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
$value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
# The code below attempts to ferret out shell meta-characters
# in the form input. It replaces them with spaces.
# looking for the presence of shell meta-characters in $name
$name =~ s/[{}\!\$;><&\*'\|]/ /g;
# looking for the presence of shell meta-characters in $value
# Allow asterisks in Search_Arg, for conversion to WebVoyage
# truncation symbol (i.e. "?")
if (! $name eq "Search_Arg") {
$value =~ s/[{}\!\$;><&\*'\|]/ /g;
}
# associative array of names and values created
$formdata{$name} = $value;
}
}
############################################################
# GrabInc
############################################################
#
# Returns "include" files to a scalar.
# Usage: GrabInc ("../somefile.inc");
sub GrabInc {
my ($inc_file) = @_;
my $file_contents = '';
open (INCLUDE, "$inc_file") || warn "Can't open file.\n";
while (<INCLUDE>) {
$file_contents = $file_contents . $_ ;
}
return($file_contents);
close (INCLUDE);
}
exit(0);
|
