#!/usr/bin/perl # # sendforth.cgi # # performs redirect(s) for the old library/TPL and infosearch # # requires perl5 and CGI module # # Use the CGI modules for HTML processing. # use CGI; use Carp; push(@INC, '/var/www/htdocs/library/tpl/lib'); require 'util.lib'; # Set the path for security and taint checking. # $ENV{'PATH'} = '/usr/bin:/bin'; # Create a new CGI object for examining variables # my($qry) = new CGI; my($s,$tmp) = ''; my(@c) = (); # base url string, up to question mark # my($url) = $qry->url() || ''; # everything that follows the question mark # my($qstr) = $qry->query_string() || ''; if($qstr ne '') { $qstr =~ s/^keywords=//g; $qstr =~ s/%2F/\//g; } if($url =~ /nph-dynaweb\.cgi/) { $url .= $ENV{'PATH_INFO'}; } if($url ne '' && $url =~ /infosrch\.cgi/) { $s = &infosearch_redirect($qry); } elsif( $url =~ /\.cgi/ ) { if( $url =~ /makepage\.cgi/ || $url =~ /makepspage\.cgi/ ) { if( $url =~ /makepage\.cgi/ ) { $tmp = 'summary'; } else { $tmp = 'download'; } # summary or download page # if( $qstr =~ /\d\d\d-\d\d\d\d-\d\d\d/ ) { $s = "$CGI_DIR/$tmp.cgi?db=bks&docnumber=$qstr"; } else { @c = split('\/', $qstr); $s = "$CGI_DIR/$tmp.cgi?coll=$c[0]&db=bks&pth=/$c[1]/$c[2]"; } } elsif( $url =~ /nph-dynaweb\.cgi/ && $url =~ /dynaweb_bin/ ) { @c = split('\/', $url); while($c[0] ne 'dynaweb_bin') { shift(@c); } shift(@c); # now we have something like 0620/bin/nph-d../dynaweb/// # if( $c[5] =~ /Generic__CollectionView/ ) { $s = "$CGI_DIR/browse.cgi?coll=$c[0]&db=bks&pth=/$c[4]"; } else { if( $c[6] =~ /BookTextView/ ) { $c[7] =~ s/\;[\!-\~]+//g; $s = "$CGI_DIR/getdoc.cgi?coll=$c[0]&db=bks&" . "fname=/$c[4]/$c[5]/$c[7]"; } else { $s = "$CGI_DIR/browse.cgi?coll=$c[0]&db=bks&" . "cmd=toc&pth=/$c[4]/$c[5]"; } } } elsif( $url =~ /librarian\.cgi/ ) { $s = "$CGI_DIR/help.cgi"; } } # fallback - everything else goes to the top # if( $ENV{'SERVER_URL'} ne '' ) { $SVR_URL = $ENV{'SERVER_URL'}; } if($s eq '') { $s = $SVR_URL; } elsif($s =~ /^\//) { $s = $SVR_URL . $s; } # print $qry->header(-nph=>1); # print "\n\n\n", # "

page has moved to: $s

\n"; $s =~ s/\ /%20/g; print $qry->redirect(-url=>$s, -nph=>(($url =~ /nph-/) ? 1 : 0)); exit; # # string infosearch_redirect(CGI qry) # # work on infosearch-related cgi cmds # sub infosearch_redirect { my($qry) = @_; my($s) = ''; my($cmd) = $qry->param('cmd') || ''; my($coll) = $qry->param('coll') || ''; my($db) = $qry->param('db') || ''; my($fname) = $qry->param('fname') || ''; if( $cmd eq '' ) { return $s; } if( $db eq 'help' || $db eq 'hwdi' ) { $db = 'bks'; } if( $cmd eq 'init' ) { $s = "$CGI_DIR/init.cgi?coll=$coll"; } elsif( $cmd eq 'browse' ) { $s = "$CGI_DIR/browse.cgi?coll=$coll&db=$db"; if( $fname ne '' ) { $fname =~ s/\/TOC//; $s .= "&fname=$fname"; } } elsif( $cmd eq 'search' ) { $s = "$CGI_DIR/search.cgi?coll=$coll&srch=" . $qry->param('srch') . "&sort=" . $qry->param('sort'); } elsif( $cmd eq 'getdoc' ) { $s = "$CGI_DIR/getdoc.cgi?coll=$coll&db=$db&fname=$fname"; } return $s; }