#!/usr/bin/perl -w
# vi:ts=4 sw=4
use strict;
use Getopt::Std;

die "Need \$HOME to exist\n" unless exists $ENV{'HOME'};
#=======================================================================
# Config

sub handle_textonly ($$);
sub handle_xgui	($$);
sub handle_image	($$);
sub handle_fetch	($$);

my %paths = (
		w3m			=> '/usr/local/bin/w3m',
		mozilla		=> '/usr/X11R6/bin/mozilla',
		netscape	=> '/usr/local/bin/netscape6',
		dillo		=> '/home/pdp/bin/freebsd_i386/dillo',
		webview		=> '/home/pdp/bin/zsh-funcs/webview',
		xless		=> '/usr/X11R6/bin/xless',
		mktemp		=> '/usr/bin/mktemp',
		wget		=> '/usr/local/bin/wget',
		paste_cmd	=> '/home/pdp/bin/freebsd_i386/xfetchselection',
		);

my %handles = (
		textonly	=> \&handle_textonly,
		w3m			=> \&handle_textonly,
		xgui		=> \&handle_xgui,
		mozilla		=> \&handle_xgui,
		netscape	=> \&handle_xgui,
		dillo		=> \&handle_xgui,
		image		=> \&handle_image,
		fetch		=> \&handle_fetch,
		);
my %defaults = (
		textonly	=> 'w3m',
		xgui		=> 'dillo',
		image		=> 'webview',
		);

my $handle	= 'dillo';
$handle = 'textonly' if -t;

my $netscape_lockfile = $ENV{'HOME'} . '/.netscape/lock';
my $download_template = $ENV{'HOME'} . '/Incoming/download-XXXXXXX';

#=======================================================================
# Main

my $exitval = 0;
my ($notreally, $verbose);
my $prg = $0; $prg =~ s{^.*/([^/]+)$}{$1};
my $url;

sub dprint		(@);
sub do_exec		(@);
sub do_options	($);
sub usage		($);

do_options \$url;

if (not defined $url) {
# $url=`xprop -root CUT_BUFFER0`;
	$url = `$paths{paste_cmd}`;
	die "$prg: URL fetch failed\n" if $?;

#	$url =~ s/^CUT_BUFFER0\(STRING\) = "(.*)"\s*$/$1/s;

	$url =~ s/\\n/\n/sg;
}

chomp $url;
$url =~ s/^\s*(.*)\s*/$1/s;

if ($url =~ s/^[<[](.*)[]>]$/$1/ms or $url =~ /^(?:http|https|url):/i) {
	$url =~ s/\n\+//sg;
	$url =~ s/(\s|\n)+//sg;
}

$url =~ s/^url:\s*//i;

$url =~ s{news\.bbc\.co\.uk/hi/}{news.bbc.co.uk/low/};

dprint "URL: <$url>\n";

if (defined $notreally) {
	dprint "Would use: $handle";
} else {
	&{$handles{$handle}}($handle, $url);
}

exit($exitval);

#=======================================================================
# Misc subs

sub dprint (@)
{
	return unless defined $verbose;
	print STDERR @_;
	print STDERR "\n" unless $_[$#_] =~ /\n$/;
}

sub do_exec (@)
{
	my $cmd = shift;
	if (not exists $paths{$cmd}) {
		++$exitval;
		dprint("No path defined for '$cmd'");
	} else {
		dprint "Exec with argv0 '$cmd', and line:\n\t$paths{$cmd} @_";
		exec {$paths{$cmd}} (($cmd, @_));
	}
}

sub usage ($)
{
	my $ex = shift;

	if (defined $ex and $ex != 0) { select STDERR; }
	if (defined $ex and $ex == 0) { $verbose = 1; }

	if (defined $verbose) {
		print "${prg}: Usage: [-nv] [-c command] [-u url]\n";
		print " URL in X11 cut-buffer 0 unless -u given\n";
		print " -n  Not really\n -v  Verbose\n";
		print 'Known commands:';
		foreach my $k (sort keys %handles) {
			print " $k";
		}
		print "\n";
	}

	exit $ex if defined $ex;
}

sub do_options ($)
{
	my $urlref = shift;
	my %opts;

	getopts('hnvc:u:', \%opts);

	usage(0)		if exists $opts{'h'};
	$notreally = 1	if exists $opts{'n'};
	$verbose = 1	if exists $opts{'v'};
	if (exists $opts{'c'}) {
		usage(1) unless defined $opts{'c'};
		usage(2) unless exists $handles{$opts{'c'}};
		dprint "Setting handler to $opts{'c'} [was: ${handle}]";
		$handle = $opts{'c'};
	}
	if (exists $opts{'u'}) {
		usage(1) unless defined $opts{'u'};
		$$urlref = $opts{'u'};
		dprint "Overriding URL, using command-line parameter";
	}
}

#=======================================================================
# Handlers

sub handle_textonly ($$)
{
	my ($handle, $url) = @_;
	$handle = $defaults{'textonly'} unless exists $paths{$handle};

	do_exec($handle, $url);
}

sub handle_xgui ($$)
{
	my ($handle, $url) = @_;
	$handle = $defaults{'xgui'} unless exists $paths{$handle};

    $url =~ s{([^-A-Za-z0-9_.#%;/?:@&=+\$~])}{sprintf("%%%x", ord($1))}eg;

#	if (-l $netscape_lockfile) {
#		do_exec('netscape', '-remote', "openURL($url,new-window)");
#	} else {
#		do_exec('netscape', $url);
#	}
	do_exec($handle, $url);
}

sub handle_image ($$)
{
	my ($handle, $url) = @_;
	$handle = $defaults{'image'} unless exists $paths{$handle};

	do_exec($handle, $url);
}

sub handle_fetch ($$)
{
	my ($handle, $url) = @_; # $handle ignored!

	my $fn = `$paths{'mktemp'} $download_template`;
	chomp $fn;

	my $pid = open(VIEWER, '|-');
	if ($pid) { # parent
		my $ofd = select VIEWER; $| = 1; select $ofd;
		my $pfd = fileno(VIEWER);
		open(STDERR, ">&=$pfd")
			or warn "Unable to redirect stderr: $!\n";

		print VIEWER "URL: $url\nFilename: $fn\n\n";

		do_exec('wget', '-O', $fn, $url);

	} else { # child
		do_exec('xless', '-f');
	}
}
