#!/bin/perl5
#-*-perl-*-
#
# A generic perl interface to CGI   /AdA 940921     ada@umu.se
#
# options:
#       all options displayed
#
# revision: 9   960813

$author = 'Hans.Wallberg@umdac.umu.se';       # these must be set!
$wwwtec = 'Ulf.Hultin@umdac.umu.se';
$title = 'Fritextsökning i SUNETTEN';
$authored = '1999-07-23';

$ENV{'PATH'} = ''; $ENV{'IFS'} = ''; umask(027);    # security
@days=('Sun','Mon','Tue','Wed','Thu','Fri','Sat');  # common names, must be set
@months=('Jan','Feb','Mar','Apr','May','Jun','Jul','Aug','Sep','Oct','Nov','Dec');
$script = $ENV{'SCRIPT_NAME'} || &err('SCRIPT_NAME undefined');
&parse_options;

#******************************************************************************
# Begin Handle request (HTML header and footer automatically output)
#   $script = "<www name of script>"
#   $expire = <sec> to expire script after <sec> seconds (else leave it unset)
#   $method = "POST", "GET", "PUT" or "DELETE"
#   $option{"<option name"} = "<option value>"
#   $cookie{"<cookie name"} = "<cookie value>" (set to '' to delete cookie)
#   $expire{"<cookie name"} = <sec> to expire cookie after <sec> seconds,
#     cookie expires at end of user session if not set
#   use $cookie{'COOKIE'} for general option passing into $option{}
#     using the URL option style '/foo=bar/flag' syntax, set
#     /new flag to ignore cookie options
#   %incoming_cookie = copy of %cookie (read-only)
#   set path option /new to ignore cookies
#   use &err("<error message>") in case of errors
#   use &URL("<string>") to URI escape <string>
#******************************************************************************

# Replace the following with your code
# Must set cookie and expire before calling &HTML_header!

#------------------------------------------------------------------------------
&HTML_header;
#------------------------------------------------------------------------------

$keyword = $option{'keyword'};
$word = $option{'word'};
if ($word eq "whole") {
        $word_whole = "CHECKED";
} else {
        $word_part = "CHECKED";
}
    print <<EOF;
<NOBR>
<FORM METHOD=GET ACTION="$script">
Skriv in ditt s&ouml;kord h&auml;r:
<INPUT NAME="keyword" TYPE="text" VALUE="$keyword" MAXLENGTH=60>
<INPUT TYPE="submit" VALUE="S&ouml;k">
<BR>
S&ouml;k p&aring;
del av ord <INPUT TYPE=radio NAME="word" VALUE="part" $word_part>
eller helt ord 
<INPUT TYPE=radio NAME="word" VALUE="whole" $word_whole>
<P>
</FORM>
<HR>
EOF

if (!$keyword) {
#=============================================================================
# Create the MAIN screen.
#=============================================================================
    print <<EOF;
<STRONG>
   F&ouml;ljande nummer av SUNETTEN finns i elektroniskt format (HTML):    
</STRONG>
<P>
EOF
#   SUNETTEN i HTML-format.
    $old_nr = "Nr-1991";
    foreach $nr (split (' ', `/bin/ls Nr-*.html`)) {
        ($nr_noext = $nr) =~ s/.html//;
        $new_nr = substr($nr_noext, 0, 7);
        if ($old_nr ne $new_nr) {
           print "<BR>\n";
           $old_nr = $new_nr;
        }
        print "&nbsp;&nbsp;&nbsp;<A HREF=\"$nr_noext.html\">$nr_noext</A>\n";
    }

#   SUNETTEN i PDF-format.
    print <<EOF;
</P>
<HR>
<STRONG>
   Senaste numren av SUNETTEN i PDF-format (ej s&ouml;kbar):<BR>
</STRONG>
EOF

    $old_nr = "Nr-1991";
    foreach $nr (split (' ', `/bin/ls Nr-*.pdf`)) {
        ($nr_noext = $nr) =~ s/.pdf//;
        $new_nr = substr($nr_noext, 0, 7);
        if ($old_nr ne $new_nr) {
           print "<BR>\n";
           $old_nr = $new_nr;
        }
        print "&nbsp;&nbsp;&nbsp;<A HREF=\"$nr\">$nr</A>\n";
    }

   print <<EOF;
<p>F&ouml;r att l&auml;sa PDF-filer beh&ouml;ver du tex.
<A HREF="http://www.adobe.com/prodindex/acrobat/readstep.html"
   TARGET="NewWindow">
Adobe&reg; Acrobat&reg; Reader&#153;</A>
</P>
</NOBR>
EOF

}else {
#=============================================================================
# Create the SEARCH RESULT screen.
#=============================================================================
    print <<EOF;
<STRONG>Dessa artiklar inneh&aring;ller s&ouml;kordet "$keyword":</STRONG><P>
EOF
    $_ = $keyword;
# Search word to html.
    &iso88591_to_html;
# Search word to lowercase.
    tr/A-Z/a-z/;
    if ($word eq 'whole') {
# Word deleimiters.
        s/[\t\r\,\.\:\-\+\*\/\?\!\_\ ]/ /go;
        $search = ' '.$_.' '; }
    else {
        $search = $_;
    }

# Set pharagraph (article) delimiter;
    $/ = "NAME=";
    $* = 1;

# Loop over all "SUNETTEN"-numbers.
    foreach $nr (split (' ', `/bin/ls Nr-19*.html`)) {
        open (INFILE, "<$nr") || &err("open $nr: $!\n");
        $_ = <INFILE>;         # Skip first pharagrph
        while (<INFILE>) {     # Loop over all the ariticles.
            tr/\n/ /;
            s/\"([^\"]*)\">//o;         # Find the anchar.
            $label = $1;

            ($ddd, $artikel) = split ('<HR[^>]*>'); # Find the name of the article.
            $artikel =~ s/<[^>]+>//g;
            s/<[^>]+>//go;     # Remove all html-directives.

            if ($word eq 'whole') {
                $_ = ' '.$_;
                s/[\t\r\,\.\:\-\+\*\/\?\!\_\ ]/ /go; # Word delimiters.
            }
            tr/A-Z/a-z/;       # Artikel to lowercase
            if (index($_, $search) >= 0) {
                $hits++;
                ($nr_noext = $nr) =~ s/.html//;
                print "Nummer: <A HREF=\"$nr\">$nr_noext</A>";
                print " artikel: <A HREF=\"$nr#$label\">$artikel</A><BR>\n";
            }
        }  # End while (<INFILE>)
        close (INFILE);
    } # End foreach $nr
    if (!$hits) {
        print "Det finns inga artiklar som inneh&aring;ller";
        print " ditt s&ouml;kord!<BR><BR>\n";
    }

    print <<EOI;
<FORM METHOD=POST ACTION="$script">
<INPUT TYPE="submit" VALUE="G&aring; till startsidan">
</FORM>
EOI
}

#******************************************************************************
# End Handle request
#******************************************************************************

&HTML_footer;
exit 0;

sub iso88591_to_html {
#
# Substitute national characters for use i html output.
#
    s/Å/&Aring;/go; s/Ä/&Auml;/go; s/Ö/&Ouml;/go;
    s/Ü/&Uuml;/go; s/É/&Eacute;/go;
    s/å/&aring;/go; s/ä/&auml;/go; s/ö/&ouml;/go;
    s/ü/&uuml;/go; s/é/&eacute;/go;
}

#------------------------------------------------------------------------------

#==============================================================================
# HTML header (change the HTML code to your liking)
#==============================================================================

sub HTML_header {
    return if ($HTML_header++);

    print "Content-type: text/html;charset=iso-8859-1\n";
    &header_options;
    print <<EOF;

<HTML><HEAD>
<TITLE>
    $title
</TITLE>
</HEAD><BODY>
<BODY>
<IMG BORDER=0 ISMAP NAME="logo" USEMAP="#title" ALT="SUNETTEN" SRC="sunetten-logo.gif">
<MAP NAME="title">
   <AREA SHAPE=POLY COORDS="42,14, 128,14, 99,110, 13,110" HREF="http://basun.sunet.se/" ALT="">
</MAP>
<H2><FONT FACE="Arial, Helvetica">$title</FONT></H2>
EOF
}

#==============================================================================
# HTML footer (change the HTML code to your liking)
#==============================================================================

sub HTML_footer {
    print <<EOF;
<HR>
<ADDRESS>
    <STRONG>Redakt&ouml;r:</STRONG> <A HREF="MailTo:$author">$author</A> <BR>
    <STRONG>Webbtekniker:</STRONG> <A HREF="MailTo:$wwwtec">$wwwtec</A> 
</ADDRESS>
</BODY></HTML>
EOF
}

#******************************************************************************
# NO USER SERVICABLE PARTS BEYOND THIS POINT
#******************************************************************************

#==============================================================================
# Option parser
#==============================================================================

sub parse_options#()
{
    local($opt, $val, $cl);
#
#   Parse COOKIEs
#
    $_ = $ENV{'HTTP_COOKIE'};
    for (split('; ')) {
	($opt, $_) = split('=');
	s/\+/ /g;
	s/%(..)/pack('C',hex($1))/ego;
	$cookie{$opt} = $_;
    }
    %incoming_cookie = %cookie;
#
#   Parse 'path' options on form "/x=y/z" etc.
#    and QUERY_STRING options on form 'x=y&z etc.
#
    for (split(/[\/&]/, $ENV{'QUERY_STRING'}.$ENV{'PATH_INFO'})) {
	next unless ($_);
	s/\+/ /g;
	s/%(..)/pack('C',hex($1))/ego;
	($opt, $val) = split('=', $_, 2);
	#&err("Option '$opt' already set") if ($option{$opt});
	$option{$opt} = $val || ! /=/;
    }
#
#   Parse cookie options on form "/x=y/z" or "x=y&z" etc.
#
    unless ($option{'new'}) {
	for (split(/[\/&]/, $cookie{'COOKIE'})) {
	    next unless ($_);
	    s/\+/ /g;
	    s/%(..)/pack('C',hex($1))/ego;
	    ($opt, $val) = split('=', $_, 2);
	    #&err("Option '$opt' already set") if ($option{$opt});
	    $option{$opt} = $val || ! /=/;
	}
    }
#
#   Parse 'POST' options
#
    $method = $ENV{'REQUEST_METHOD'};
    if ($method eq 'POST') {
	%override = %option;
	$_ = $ENV{'CONTENT_TYPE'};
	#&err("Unknown CONTENT_TYPE '$_'") unless
	#    ($_ eq 'application/x-www-form-urlencoded');
	$cl = $ENV{'CONTENT_LENGTH'};
	while (($cl > 0) && ($_ = <STDIN>)) {
	    s/\s*$//;
	    $cl -= length;
	    for (split('&')) {
		($opt, $_) = split('=');
		s/\+/ /g;
		s/%(..)/pack('C',hex($1))/ego;
		if ($override{$opt}) { $override{$opt} = $option{$opt} = ''; }
		$_ = ';'.$_ if ($option{$opt});
		$option{$opt} .= $_;
	    }
	}
	undef %override;
    }
}

#==============================================================================
# Header options
#==============================================================================

sub header_options#()
{
    local($sec,$min,$hour,$mday,$mon,$year,$wday,$c,$_);

    if (defined($expire)) {
	($sec,$min,$hour,$mday,$mon,$year,$wday) = gmtime(time+$expire);
	$year += 100 if ($year < 96);   # Aargh!
	printf("Expires: %s, %02d %s %04d %02d:%02d:%02d -0000\n",
	    $days[$wday], $mday, $months[$mon], 1900+$year, $hour, $min, $sec);
    }

    for $c (keys %cookie) {
	next if (($_ = $cookie{$c}) eq $incoming_cookie{$c});
	s/[%=;,\s]/sprintf('%%%2x',unpack('C',$&))/ego;
	print "Set-cookie: $c=$_;PATH=$script";
	$expire{$c} = 0 if ($_ eq '');
	if (defined($expire{$c})) {
	    ($sec,$min,$hour,$mday,$mon,$year,$wday) = gmtime(time+$expire{$c});
	    printf(';EXPIRES=%s, %02d-%s-%02d %02d:%02d:%02d GMT',
		$days[$wday], $mday, $months[$mon], $year, $hour, $min, $sec);
	}
	#print ";SECURE";   # SSL paths only
	print "\n";
    }
}

#==============================================================================
# URL escaper
#==============================================================================

sub URL#(string)
{
    local($_) = $_[0];

    s/[%;?:@=&+\r\n\t\/]/sprintf('%%%02x',unpack('C',"$&"))/ego;
    s/ /+/go;

    $URL = $_;
}

#==============================================================================
# Error handler
#==============================================================================

sub err#(message)
{
    $err = $_[0];

    select(STDOUT);
    &HTML_header;

    print <<EOF;
<HR>
    The CGI script supposed to produce this page of information
    caught an internal error.
<P>
    Please contact the script author, <A HREF="MailTo:$author">$author</A>,
    and inform him of the time the error occurred, and anything you might
    have done that may have caused the error.
<P>
    The error message was:
<P>
    <TT>$err</TT>
EOF
    &HTML_footer;
    exit 1;
}