#!/usr/bin/perl

###############################################################################
## Custom Configuration #######################################################

# It's unlikely that any of these should be changed, and if they are,
# update the man page as well.

# default browser and cleanup rules
$use_ns	  = ($ENV{'WB_BROWSER'} =~ /mosaic/i) ? 0 : 1;
$use_sp	  = ($ENV{'WB_SLEEP'}   =~ /at/i)     ? 0 : 1;

# default browser command and directories for temporary files
$netscape = $ENV{'WB_NETSCAPE'}	|| 'netscape';
$nstmp	  = $ENV{'WB_NSTMP'}	|| $ENV{'WB_TMP'} ||
	    ((-d "$ENV{'HOME'}/.mozilla")  ? "$ENV{'HOME'}/.mozilla"  :
	     (-d "$ENV{'HOME'}/.netscape") ? "$ENV{'HOME'}/.netscape" :
	     (-d "$ENV{'HOME'}/tmp")	   ? "$ENV{'HOME'}/tmp" : '/tmp');
$mstmp	  = $ENV{'WB_MSTMP'}	|| $ENV{'WB_TMP'} ||
	    ((-d "$ENV{'HOME'}/tmp")	   ? "$ENV{'HOME'}/tmp" : '/tmp');

# default umask, tmp file hold time, browser window and pwd command
$umask	  = (defined $ENV{'WB_UMASK'}) ? $ENV{'WB_UMASK'} : 077;
$keep	  = (defined $ENV{'WB_KEEP'})  ? $ENV{'WB_KEEP'}  : 10;
$id	  = $ENV{'WB_ID'};
$pwd	  = $ENV{'WB_PWD'} || 'pwd';

###############################################################################
## Usage ######################################################################

# webrowse -- browse the given input in a local web browser, with markup
# Steve Kinzler, kinzler@cs.indiana.edu, May 96/Jan 98
# see website http://www.cs.indiana.edu/~kinzler/webrowse/
# http://www.cs.indiana.edu/~kinzler/home.html#web

$version = '1.6.3';

($Nnote, $Mnote) = ($use_ns) ? (' (default)', '') : ('', ' (default)');
($Pnote, $Anote) = ($use_sp) ? (' (default)', '') : ('', ' (default)');
$usage   = "usage: $0 [ -N | -M ] [ -s | -mq | -u | -c ]
       [ -k MINUTES ] [ -p | -a ] [ -i ID ] [ -w | -t ] [ -rnvo ]
       [ -h ] [ FILE ]
	-N	use a Netscape or Mozilla (NS/Moz) browser$Nnote
	-M	use a Mosaic browser$Mnote
	-s	tag the standard input as HTML (default TEXT)
	-m	link markup a TEXT copy of the input for browsing (heuristic)
	-q	quote markup a TEXT copy of the input for browsing
	-u	take the argument or stdin as a URL to browse
	-c	take the argument or stdin as a remote command (NS/Moz only)
	-k	minutes to keep any temporary input (default $keep)
	-p	use a sleeping process to delete temporary input$Pnote
	-a	use an at job to delete temporary input$Anote
	-i	id of the window or process of the browser to use
	-w	open a new browser window, default use first existing window
	-t	open a new browser tab (newer NS/Moz only)
	-r	don't raise the browser window (NS/Moz only)
	-n	don't actually use the browser at all
	-v	print the browser command to be run (NS/Moz only)
	-o	print the processed input to stdout
	-h	just print this help message
The NS/Moz command that will be used is `$netscape`.
MINUTES is specified with an integer number or the word 'forever'.
Temporary copies of the input (from standard input and/or for markup)
are stored in $nstmp (with NS/Moz)
or $mstmp (with Mosaic).
Version $version\n";

# parse and check command line options
require 'getopts.pl';
&Getopts('NMsmquck:pai:wtrnvoh') || die $usage;
die "Invalid minutes: $opt_k\n", $usage unless $opt_k =~ /(^\d*$|forever)/i;
die $usage if $opt_h || $opt_u && $opt_c;

# let command line options override environmental defaults
$use_ns	= ($opt_N) ? 1 : ($opt_M) ? 0 : $use_ns;
$use_sp	= ($opt_a) ? 0 : ($opt_p) ? 1 : $use_sp;
$keep	= ($opt_k ne '') ? $opt_k : $keep;
$id	= ($opt_i ne '') ? $opt_i : $id;
$cwd	= '';

###############################################################################
## Execution ##################################################################

# browse URLs, commands and files without markup straight-away and exit
$url = (@ARGV) ? $ARGV[0] : <> . '',
$ENV{'WB_RUNURL'} && system("$ENV{'WB_RUNURL'} '$url' &"),
&browse($url,			      'url'),  exit if $opt_u;
&browse((@ARGV) ? $ARGV[0] : <> . '', 'cmd'),  exit if $opt_c;
&browse(&abspath($ARGV[0]),	      'exec'), exit if @ARGV
						    && ! ($opt_m || $opt_q);

# find a temporary filename to use
$tmpdir	= ($use_ns) ? $nstmp : $mstmp;
$ext	= ($opt_s || $opt_m || $opt_q) ? '.html' : '.txt';
$aa	= '';
do {
	$aa  = ($aa) ? ++$aa : 'AA';
	$tmp = "$tmpdir/webrowse${$}$aa$ext";
} while -e $tmp;

# open the temporary file, trapping signals for cleanup
umask $umask;
$SIG{'HUP'} = $SIG{'INT'} = $SIG{'PIPE'} = $SIG{'TERM'} = 'end';
open(TMP, "> $tmp") ||
	do { $keep = 'forever'; &end("$0: cannot open $tmp ($!)\n"); };

# write the temporary file, marking up the text if appropriate
if ($opt_m || $opt_q) {
	($prog = $0) =~ s:.*/::;
	$title = &htmlencode("$prog: " . ((@ARGV) ? "@ARGV" : '-'));
	$base  = (@ARGV) ? &abspath($ARGV[0]) : &abspath('.');
	print TMP "<HTML><HEAD>\n<TITLE>$title</TITLE>\n";
	print TMP "<BASE HREF=\"file:$base\">\n</HEAD><BODY>\n\n<PRE>";
	print TMP &markup(&mailquote(&htmlencode(<>)))	if $opt_m && $opt_q;
	print TMP &markup(&htmlencode(<>))		if $opt_m;
	print TMP &mailquote(&htmlencode(<>))		if $opt_q;
	print TMP "</PRE>\n\n</BODY></HTML>\n";
} else {
	print TMP <>;
}

# close and browse and cleanup the temporary file and exit
close TMP;
&browse(&abspath($tmp));
&end();

###############################################################################
## Subroutines ################################################################

# Print any given warning messages and schedule any temporary file for
# cleanup via the chosen method (sleeping background shell process, at(1)
# job, or no cleanup) then exit.
sub end {
	warn @_ if @_;
	exit if $keep =~ /forever/i || ! -e $tmp;
	unlink($tmp) || warn("$0: cannot unlink $tmp ($!)\n"), exit if ! $keep;
	if ($use_sp) {
		system('(sleep ' . $keep * 60 .
		       '; /bin/rm -f ' . &shencode($tmp) . ') &');
	} else {
		open(AT, "| at now + $keep minutes");
		print AT '/bin/rm -f ', &shencode($tmp), "\n";
		close AT;
		warn("$0: cannot schedule rm at now + $keep minutes ($!)\n"),
			unlink($tmp) || warn("$0: cannot unlink $tmp ($!)\n")
				if $?;
	}
	exit;
}

# Return the absolute filesystem pathname for the given filename.
sub abspath {
	local($_) = @_;
	s:/+:/:g;
	return $_ if /^\//;
	chop($cwd = `$pwd`)	unless $cwd;
	chop($cwd = `/bin/pwd`)	unless $cwd;
	(($cwd =~ /^\/+$/) ? '' : $cwd) . "/$_";
}

###############################################################################
## Subroutines ## Browser Remote Control ######################################

# Direct the browser to load a given target or run a given command,
# and exit if requested.
sub browse {
	local($file, $arg) = @_;
	chop($file) if $file =~ /\n$/;
	local($url, $flush, @args) = ($file, $|, ());
	$url =~ s/^\"(.*)\"$/$1/, $url =~ s/^\'(.*)\'$/$1/,
	$url =~ s/^\((.*)\)$/$1/, $url =~ s/^\<(.*)\>$/$1/,
	$url =~ s/^\[(.*)\]$/$1/, $url =~ s/^\{(.*)\}$/$1/ if $arg eq 'url';
	$url = "file:$url" if $arg ne 'url' && $arg ne 'cmd';

	# construct the netscape/mozilla remote control command to run,
	# and print it if requested
	if ($use_ns) {
		$url =~ s/\(/%28/g; $url =~ s/\)/%29/g; $url =~ s/,/%2C/g;
		# Mozilla 1.7b seems to need this:
		$url .= '/' if $url =~ /^https?:\/\/[-\w.]+(:\d*)?$/i;
		$url .= ($opt_w) ? ', new-window' :
			($opt_t) ? ', new-tab'	  : '' if $arg ne 'cmd';
		push(@args, $netscape);
		push(@args, '-id', $id) if $id;
		push(@args, (($opt_r || $opt_w) ? '-noraise' : '-raise',
			'-remote', ($arg eq 'cmd') ? $url : "openURL($url)"));
		$| = 1, print("@args\n"), $| = $flush if $opt_v;
	}
	# Note: newer mozilla software includes mozila-xremote-client
	# for a similar alternative interface that allows one to specify
	# the browser application.  See www.mozilla.org/unix/remote.html

	# if requested,
	# print the input and/or exit without any browser interaction
	system(($arg eq 'url' || $arg eq 'cmd') ? 'echo' : '/bin/cat', $file)
		if $opt_o;
	($arg) ? exit : return if $opt_n;

	# remote control the browser
	# with NS/Moz, by running or execing the remote control command
	# with Mosaic, by writing a standard temporary command file and
	#   signaling the pid of the browser process, read from ~/.mosaicpid
	if ($use_ns) {
		($arg) ? exec @args : system @args;
	} else {
		die "$0: remote commands only available with Netscape" .
		    " or Mozilla\n" if $arg eq 'cmd';
		unless ($id) {
			$pid =  "$ENV{'HOME'}/.mosaicpid";
			$id  =  <PID>, close PID if open(PID, "< $pid");
			$id  =~ s/\D.*//;
			die "$0: cannot get pid from $pid ($!)\n" if ! $id;
		}
		$pid = "/tmp/Mosaic.$id";
		open(PID, "> $pid") || die "$0: cannot open $pid ($!)\n";
		print PID ($opt_w) ? 'newwin' : 'goto', "\n$url\n";
		close PID;
		kill 30, $id;
		exit if $arg;
	}
}

###############################################################################
## Subroutines ## Encoding ####################################################

# Return the given strings, concatenated, with quoting for their use as
# a single shell argument.
sub shencode {
	local($_) = join('', @_);
	s/'/'\\''/g; s/^/'/; s/$/'/;
	$_;
}

# Return the given strings, concatenated, with any special HTML characters
# escaped.
sub htmlencode {
	local($_) = join('', @_);
	s/&/&amp;/g; s/</&lt;/g; s/>/&gt;/g; s/"/&quot;/g;
	$_;
}

###############################################################################
## Subroutines ## HTML Markup #################################################

# Return the given strings, concatenated, with HTML font markup added
# for any quoted message lines.
sub mailquote {
	local($_, $s) = (join('', @_), '');
	s/(^|\n)(((\w*(>|&gt;)|[\]|}])[ \t]*)+)([^\n]*)/"$1<" .
		($s = &mailquotestyle($2)) . ">$2$6<\/$s>"/gie;
	$_;
}

# alternate between italic and bold for nested quotes
sub mailquotestyle {
	local($_) = @_;
	s/&gt;/>/g; s/[\w\s]//g;
	(length($_) % 2) ? 'I' : 'B';
}

# Return the given strings, concatenated, with HTML hyperlink markup added
# for any patterns that could be URLs, FTP locations, mail addresses,
# header newsgroups, news article IDs, and filesystem pathnames.
#
# Note: this is heuristic, not-at-all foolproof, and may not scale well
# to large texts.

sub markup {
	local($_)    = join('', @_);
	local($host) = '[-\w.]*\w';
	local($fqdn) = $host . '\.\w{2,}';
	local($addr) = '[-+\w.%!]*\w@' . $host;
	local($path) = '[-+\w.]+(/[-+\w.]+)*/?';
	local($urlp) = '/[^\s\'"`<>()\[\]{}]*';
	local($from) = '(^|\n)(From|To|Cc):[^\n]*';
	local($ngrp) = '(^|\n)(Newsgroups):[^\n]*';
	local($mesg) = '(^|\n)(Message-ID|References):[^\n]*';
	local($xref) = '(^|\n)(Xref):[^\n]*';

	1 while s/($xref):/$1&#58;/ogi;

	$pUR = "(\&lt;URL:\\s*)([^\&\\s]+)";
	 s~$pUR~$1<A HREF="$2">$2</A>~ogi;
	$pWW = "(^|[^-\\w.\">/\@])(www\\.$fqdn)($urlp)?";
	 s~$pWW~$1<A HREF="http://$2$3">$2$3</A>~ogi;
	$pFT = "(^|[^-\\w.\">/\@])(ftp\\.$fqdn)($urlp)?";
	 s~$pFT~$1<A HREF="ftp://$2$3">$2$3</A>~ogi;
	$pFP = "(^|[^-\\w.\">/\@])($fqdn):(/?)($path)";
	 s~$pFP~$1<A HREF="ftp://$2/$4">$2:$3$4</A>~og;
	$pUL = "(^|[^-\\w.\">/])(\\w+:$urlp)";
	 s~$pUL~$1<A HREF="$2">$2</A>~og;
	$pLF = "(^|\\s)(/$path)(\\s|\$)";
	 s~$pLF~$1<A HREF="file:$2">$2</A>$4~og;

	$pFR = "($from([ \\t]|\&lt;))($addr)";
	 1 while s~$pFR~$1<A HREF="mailto:$5">$5</A>~ogi;
	$pNG = "(${ngrp}[ \\t,])([-+\\w]+(\\.[-+\\w]+)+)";
	 1 while s~$pNG~$1<A HREF="news:$4">$4</A>~ogi;
	$pID = "($mesg\&lt;)([^\&\\s]+\@$host)(\&gt;)";
	 1 while s~$pID~$1<A HREF="news:$4">$4</A>$5~ogi;

	$pAD = "(^|[\\s,])($addr)";
	 s~$pAD~$1<A HREF="mailto:$2">$2</A>~og;
	$pAS = "(\&lt;)([-+\\w.]{0,13}\\w\@$host)(\&gt;)";
	 s~$pAS~$1<A HREF="mailto:$2">$2</A>$3~ogi;
	$pAR = "(\&lt;)([^\&\\s\@<]+\@$host)(\&gt;)";
	 s~$pAR~$1<A HREF="news:$2">$2</A>$3~ogi;

	$_;
}