xemacsweb / cgi-bin / wilma_hiliter

#!/usr/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.
#
# Edits the specified mail list archive HTML file to highlight the search
# words found and displays it.
#
# This is a CGI program invoked from the wilma search CGI program
# results.
#
# 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$

use CGI qw/ :cgi :html2 /;
use AppCfg 1.2;
use strict;
use integer;
use subs qw/
    error_exit
/;
use vars qw/
    $CFG_ROOT
    $CFG_SUFFIX
/;

*CFG_ROOT   = \'.wilma';	# Configuration file root directory
*CFG_SUFFIX = \'.cf';		# Configuration file name suffix
$| = 1; # Autoflush output

# Import our arguments into the PARAMS namespace.
import_names('PARAMS');

# Determine the name of the list. We should've been invoked with the
# list name in the path info.
my ($list, $msg) = (path_info() =~ m{^/+([^/]+)/(.+)}) if path_info();
error_exit("No List Specified",
    "The list archive name was not found in the path info")
    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 $@;

$msg = "$CFG::arc_dir/$msg";
error_exit("Message File Doesn't Exist", "File '$msg' not found.")
    unless -f $msg;

error_exit("HTML Files Only",
    "Cannot read file '$msg': Only configured to highlight HTML files.")
    unless $msg =~ /.html$/;

error_exit("Cannot Read File '$msg'", "Error opening '$msg': $!"),
    unless open(MSG, $msg);

print header();

my $curline = 0;
my $inbody  = 0;

while (<MSG>) {
  $inbody = 1 if /<!--X-MsgBody-->/;
  $curline++ if $inbody;

  print(($PARAMS::line && $curline == $PARAMS::line)
	? a({'-name' => "hilite"}, b($_))
	: $_
  );
}
close(MSG);
exit 0;

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


###################################################
#
# 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;
}
Tip: Filter by directory path e.g. /media app.js to search for public/media/app.js.
Tip: Use camelCasing e.g. ProjME to search for ProjectModifiedEvent.java.
Tip: Filter by extension type e.g. /repo .js to search for all .js files in the /repo directory.
Tip: Separate your search with spaces e.g. /ssh pom.xml to search for src/ssh/pom.xml.
Tip: Use ↑ and ↓ arrow keys to navigate and return to view the file.
Tip: You can also navigate files with Ctrl+j (next) and Ctrl+k (previous) and view the file with Ctrl+o.
Tip: You can also navigate files with Alt+j (next) and Alt+k (previous) and view the file with Alt+o.