#!/usr/local/bin/perl -w

# Web Interface to List Mail Archives
#
# Copyright 1997, 1998 by Jason L. Tibbitts III <tibbs@hpc.uh.edu> and
# David Wolfe <dave_wolfe@computer.org>. May be freely used, modified,
# and redistributed under the same terms as Perl. Absolutely no warranty
# of any kind. Authors are not responsible for any damage or loss caused
# by use of this program.
#
# Generates an index page and search form for mail lists archived and
# HTMLized with MHonArc, with a bias toward Majordomo archives.
#
# This is the entry CGI program to view/search a mail list archive. It
# extracts the list name from the PATH_INFO, e.g.
#  http://server/path/wilma/listname
#
# List configuration files are in the ".wilma" subdirectory of the
# directory where this CGI program is installed (but see CFG_ROOT
# below). They reside in files named in the form listname.cf (but see
# CFG_SUFFIX below), e.g. ".wilma/testlist.cf". The other supporting
# programs are assumed to be in the same directory as this one.
#
# $Revision: 1.10 $


use CGI qw/ :standard :html3 /;
use AppCfg 1.2;
use strict;
use subs qw/
    error_exit
    print_ml_index
    print_search_form
/;
use vars qw/
    $CFG_ROOT
    $CFG_SUFFIX
    @MONTH
    $SEARCH
/;

*CFG_ROOT   = \'.wilma';	# Configuration file root directory
*CFG_SUFFIX = \'.cf';		# Configuration file name suffix
*SEARCH     = \'wilma_glimpse.cgi';	# Search CGI program name
*MONTH      = [qw/ dummy January February March April May June July
		  August September October November December /];
$| = 1; # Autoflush output

# Determine the name of the list. It's assumed that we're running as the
# index, so we don't get any parameters, but we can expect it in the
# path info. If not, display an index of all the lists we can find.

my ($list) = (path_info() =~ m{^/+([^/]+)}) if path_info();

unless ($list)
{
  $list = $ENV{QUERY_STRING} if ! $list && $ENV{QUERY_STRING};
}

print_ml_index() unless defined $list && $list ne "";

# Get the list configuration parameters
eval {
    my $cfg = new AppCfg "$CFG_ROOT/$list$CFG_SUFFIX";
    $cfg->import_variables();
};
error_exit("Configuration File Error", $@) if $@;

$CFG::arc_url   ||= $CFG::arc_dir;
$CFG::mail_name ||= $CFG::mail_addr;

opendir(ARCHIVES, $CFG::arc_dir) ||
    error_exit("Archive Directory Error",
	"Opening directory '$CFG::arc_dir' for list '$list' received the error '$!'");

my @Archives = reverse sort grep {/$CFG::arc_regex/ && -d "$CFG::arc_dir/$_"}
				    readdir(ARCHIVES);
closedir(ARCHIVES);

my %ArcLabels;
foreach (@Archives) {
    my ($year, $month) = m/$CFG::arc_regex/;
    $year += (($year < 70) ? 2000 : 1900) if $year < 100;
    $ArcLabels{$_} = "$MONTH[$month], $year";
}

my %hdr_args = ('-title' => "$CFG::title Mailing List Interface");

if (defined $CFG::index_background && $CFG::index_background ne "" )
{
    $hdr_args{'-background'} = $CFG::index_background;
}
elsif (defined $CFG::index_bg_color && $CFG::index_bg_color ne "")
{
    $hdr_args{'-bgcolor'} = $CFG::index_bg_color;
}

unless ($CFG::title =~ /WNY History/)
{
  print header(),
    start_html(-head=>Link({-rel=>'SHORTCUT ICON',-href=>'/favicon.ico'}),%hdr_args),
    h1("$CFG::title Mail List Archives"),
    hr({'-size' => 4}), "\n";

print p(),
    "The archives are currently being generated.",
    "This happens nightly and occasionally at other times.",
    "Please reload this page for the current status.\n"
	if -f $CFG::flag_file;

print qq~
<center>
<a href="http://EL-List.Railfan.net"><img src="http://www.railfan.net/logos/ellogo-maroon-196.gif" border=0></a>
<br>
Visit the Erie Lackawanna List Page at <a href="http://EL-List.railfan.net"><b>EL-List.railfan.net</b></a>
<br>
Visit the Erie Lackawanna List Photo Archive at <a href="http://lists.railfan.net/erielack-photo/"><b>Lists.Railfan.net/erielack-photo/</b></a>
</center>
<br>
You can view the <a href="http://www.railfan.net/lists/erielack-digest/current.txt">Most Recent EL Digest HERE</a>
~ if $CFG::title =~ /^Erie Lackawanna \(/;

print p(),
    "You can ",
    a({'-href' => "#search"}, "search"),
    " or ",
    a({'-href' => "#browse"}, "browse"),
    " the archives.",
"\n";
#    hr({'-size' => 4}), "\n";

(my $base = script_name()) =~ s([^/]+$)();
print_search_form("$base$SEARCH/$list") unless $CFG::title =~ /WNY History/;

print a({'-name' => "browse"},
    h2("Browse the $CFG::title Archives")),
    table({'-cellpadding' => 0, '-cellspacing' => 0},
	build_archive_links($list)),
    hr(), "\n" unless $CFG::title =~ /WNY History/;
}
else
{
  print header(),
    start_html(%hdr_args),
    h1("The WNY History List is no longer supported at this location."),
    hr({'-size' => 4}), "\n";
}

if (-r "$CFG::arc_dir/info.html") {
    print a({'-href' => "$CFG::arc_url/info.html"}, "[List Info]");
}
elsif (-r "$CFG::arc_dir/info.txt") {
    print a({'-href' => "$CFG::arc_url/info.txt"}, "[List Info]");
}

print p(), address(a({'-href' => "mailto:$CFG::mail_addr"}, $CFG::mail_name))
    if defined $CFG::mail_addr && $CFG::mail_addr ne "" && $CFG::title !~ /^Erie Lackawanna \(/;

my ($nowyear) = localtime() =~ /(\d+)$/;

if ($CFG::title =~ /^Erie Lackawanna \(/)
{
  print qq~
<br>
<center>
<a href="http://elhts.org/"><img src="http://www.railfan.net/logos/ellogo-maroon-196.gif" border=0></a>
</center>
<br>
<font face=arial size=3><b>
This HTML page and all HTML pages generated from this site are 
&copy; 2000-$nowyear Blue Moon Online System and The Railfan Network
<br><br></b><i>
These pages and the data contained therein may not be reproduced 
for any form of redistribution or commercial use without the 
explicit permission of an authorized representative of the above organizations.
</i><br><P>
~;
}
else
{
  print qq~
<br><P><hr width=75%><br><p>
<center>
<a href="http://www.railfan.net/"><img src="http://www.railfan.net/banners/banner.cgi" border=0></a>
</center>
<br><P>
<font face=arial size=3><b>
This HTML page and all HTML pages generated from this site are 
&copy; 2000-$nowyear Blue Moon Online System and The Railfan Network
<br><p></b><i>
These pages and the data contained therein may not be reproduced 
for any form of redistribution or commercial use without the 
explicit permission of J. Henry Priebe Jr. 
</i><br><P>
~ unless $CFG::title =~ /WNY History/;
}

print end_html;

exit 0;

# Appease -w
$CFG::flag_file ||= $CFG::flag_file;

###################################################

sub print_ml_index {

print "Content-type: text/html\n\n";
print qq~<html><head><title>Error!</title></head>

<style type="text/css">
<!--
pre {
 white-space: -moz-pre-wrap;
 white-space: -pre-wrap;
 white-space: -o-pre-wrap;
 white-space: pre-wrap;
 word-wrap: break-word;
}
-->
</style>

<body><h2>
Sorry, the list server could not understand your request.</h2>
If you believe this to be in error, you might try emailing Henry at
<br><br>
<i>wilmacgi</i> AT <i>henry.wny.org </i>
<br><br>
and be sure to include the full URL that produced this error:
<br>
<b>http://$ENV{HTTP_HOST}$ENV{REQUEST_URI}</b>
<br>
<br>
<b>
<a href="javascript:history.go(-1)">Go Back</a>
<br>
<br>
<a href="http://Lists.Railfan.net">Railfan.net Email Lists Main Page</a>
<br>
<br>
</b>
</body>
</html>
~;
exit;

    my $url = script_name();
    local (*DIR);
    my @index;

    opendir(DIR, $CFG_ROOT) || die "Can't open $CFG_ROOT directory: $!\n";
    foreach (sort grep /$CFG_SUFFIX$/, readdir(DIR)) {
	my ($cfg, $list, $title);
	eval {
	    $cfg = new AppCfg "$CFG_ROOT/$_";
	};
	next unless defined $cfg && ($title = $cfg->get_scalar("title"));
	($list = $_) =~ s/$CFG_SUFFIX$//;
	push @index, li(a({'-href' => "$url/$list"}, "$list"),
			" -- $title\n");
    }
    closedir(DIR);

    print header(),
	start_html('-title' => "Mailing List Interface"),
	h1("Archived Mailing Lists"),
	hr(), "\n",
	ul(@index),
	hr(),
	end_html();
    exit 0;
}


###################################################
#
# Outputs the search form

sub print_search_form {
    my ($script) = @_;
    print a({'-name' => "search"}, h2("Search the $CFG::title Archives")),
	startform('-method' => "GET", '-action' => $script),

	b("NOTE: ALL Email Addresses have had \"@\" replaced with \"\_@\_\", ",
	"in order to defeat the web email address harvesting programs." ,
	"To email posters, just delete the underscores on either side of the @ ",
	"symbol."),
	br(),
	p(),
	b("This server supports complex queries:"),
	br(),

	"Words separated by a space are searched for together (",
	b("mailing list"),
	"). To find either one word or the other, separate them with a comma (",
	b("mailing,list"),
	"). To find two words together in the same file, ",
	"separate them with a semicolon (",
	b("mailing;list"),
	"). Note that ",
	strong("all"),
	" spaces are significant; searching for two words separated ",
	"by a space will not find those two words separated by ",
	"anything other than a single space. ";

print qq~Click 
<a href="http://Lists.Railfan.net/glimpsehelp.html#sect7" target=help>
HERE for more help on patterns.</a>
~;

    print p(),
	b("What would you like to search for? "),
	textfield('-name' => "query", '-size' => 50),
	br(),

	submit('-name' => "Search"),
	reset('-name' => "Reset"),
	br(),

	table(
	  Tr(
	    td(checkbox('-name' => "case", '-label' => "")),
	    td(b("Case sensitive")),
	    td({'-colspan' => 2}, "Check this box if you want to find ",
	      "only matches having the exact case as your input. ",
	      "With this, a search for ",
	      b("Mailing"),
	      " would not find ",
	      b("mailing"),
	      ".",
	    ),
	  ),
	  Tr(
	    td(checkbox('-name' => "partial", '-label' => "")),
	    td(b("Word match")),
	    td({'-colspan' => 2}, "Check this box if you want to find ",
	      "only whole-word matches to a word. With this, a search for ",
	      b("mail"),
	      " would not find ",
	      b("mailing"),
	      ".",
	    ),
	  ),
	  Tr(
	    td(checkbox('-name' => "lineonly", '-label' => "")),
	    td(b("Single line match")),
	    td({'-colspan' => 2}, "Check this if you want all terms of your ",
	      "search to be found on the same line.  With this, a search for ",
	      b("mailing;list"),
	      " will only find documents with both ",
	      b("mailing"),
	      " and ",
	      b("list"),
	      " on the same line.",
	    ),
	  ),
	  Tr(
	    td(checkbox('-name' => "restricttofiles", '-label' => "")),
	    td(b("Restrict matched files")),
	    td("Check this if you want to restrict the search to a ",
	      "specific archive or set of archives. If not checked, ",
	      "the search will span all of the individual archives.",
	      "You may only select up to FOUR months, any more will be ignored. NOTE: This option frequently fails to work properly for an unknown reason!",
	      br(),
	      "Choose the archives to search from the following list:",
	    ),
	    br(),
	    td(scrolling_list('-name'     => 'filelist',
			      '-values'   => \@Archives,
			      '-labels'   => \%ArcLabels,
			      '-size'     => 5,
			      '-multiple' => 'true'),
	    ),
	  ),
	),

	table(
	  Tr(
	    td({'-colspan' => 2, '-align' => 'center'},
	      b("Misspellings allowed."),
	    ),
	    td({'-colspan' => 2, '-rowspan' => 2}, br(),
	      "Words can be found even if they are misspelled.  Set this to ",
	      "the number of errors allowed in each match.  With this set to ",
	      b("1"),
	      ", a search for ",
	      b("mailling"),
	      " will find ",
	      b("mailing"),
	      " but not ",
	      b("maling"),
	      ". Note that misspelled matches are not ",
	      "highlighted in the search results.",
	    ),
	  ),
	  Tr(
	    td({'-colspan' => 2, '-align' => 'center'},
	      popup_menu('-name' => 'errors',
		'-values' => [0, 1, 2, 3, 4, 5, 6, 7, 8, 'Best match']),
	    ), 
	  ),
	  Tr(
	    td({'-colspan' => 2, '-align' => 'center'},
	      b("Max. files returned."),
	    ),
	    td({'-colspan' => 2, '-rowspan' => 2}, br(),
	      "This limits the number of matching files that will be ",
	      "reported in the search results.",
	    ),
	  ),
	  Tr(
	    td({'-colspan' => 2, '-align' => 'center'},
	      popup_menu('-name' => 'maxfiles',
		'-values' => [10, 20, 50, 100, 250, 500, 1000, 2000, 5000], '-default' => 500),
	    ),
	  ),
	  Tr(
	    td({'-colspan' => 2, '-align' => 'center'},
	      b("Max. matches per file."),
	    ),
	    td({'-colspan' => 2, '-rowspan' => 2}, br(),
	      "This limits the number of matching lines that will be ",
	      "found in a single file.  Set this to ",
	      b("0"),
	      " if you only want to find matching files.",
	    ),
	  ),
	  Tr(
	    td({'-colspan' => 2, '-align' => 'center'},
	      popup_menu('-name' => 'maxlines',
		'-values' => [0, 5, 10, 25, 50, 100], '-default' => 10),
	    ),
	  ),
	),

	endform(),
	hr(), "\n";
}


###################################################
#
# Returns an array of HTML text for the available archive index links

sub build_archive_links {
    my ($list) = @_;
    my @rows;
    my $mostrecent = $Archives[0];
#my ($arsize, @cols);
#push(@cols, td({'-align' => "right"}, b("Digest: '$CFG::arc_dir/$list.$Archives[0]'")));
    foreach (@Archives) {
	my ($arsize, @cols);
	push(@cols, td({'-align' => "right"}, b("$ArcLabels{$_}:\n")));
	push(@cols, ((-r "$CFG::arc_dir/$_/index.html")
		      ? td(a({'-href' => "$CFG::arc_url/$_/"}, "[Index]\n"))
		      : td()
		    ));
	push(@cols, ((-r "$CFG::arc_dir/$_/threads.html")
		      ? td(a({'-href' => "$CFG::arc_url/$_/threads.html"},
			    "[Thread]\n"))
		      : td()
		    ));
	push(@cols, ((-r "$CFG::arc_dir/$_/home.html")
		      ? td(a({'-href' => "$CFG::arc_url/$_/home.html"},
			    " \&nbsp; [Chronological]\n"))
		      : td()
		    ));
if ($_ eq $Archives[0] && my $ZZZ)
{
	push(@cols, ((-r "$CFG::arc_dir/$list.$_" && ($arsize = -s _))
		      ? td(a({'-href' => "$CFG::arc_url/$list.$_"},
			  " \&nbsp; [Most Recent Digest ($arsize bytes)]\n"))
		      : td()
		    ));
}
	push(@rows, Tr(@cols));
    }

    @rows;
}


###################################################
#
# Generic error display of HTML error message and exit.

sub error_exit {
    my $text = shift || "Unspecified Error Exit";
    my $desc = join(" ", @_) || "";
    unless (defined $desc && $desc =~ /\S/) {
	my ($pkg, $file, $line) = caller();
	$desc = "In package '$pkg' at line $line of '$file'.";
    }

    my $address = "";
    if (defined $CFG::mail_addr && $CFG::mail_addr ne "") {
	$CFG::mail_name ||= $CFG::mail_addr;
	$address          = address(a({'-href' => "mailto:$CFG::mail_addr"},
			    $CFG::mail_name));
    }

    print header(),
	start_html('-title' => "ERROR"),
	h1($text),
	$desc,
	p(),
	$address,
	end_html();

    exit 1;
}