#!/usr/bin/perl

use strict;
use warnings;

# shortcut
exit if $ENV{LESS_NO_PIPE};

# get filename
my $filename	= shift @ARGV;

# check if we want to view a specific member from an archive of somesort
my ($archive, $member) = split /~/, $filename;

# convert archive-member-name (if any) to a wildcard pattern
my $wildcard = "*" . ($member || "") . "*";

# lookup tables
my $protocols = {
	'^http://'										=> "w3m -dump '$filename'",
	'^@http://'										=> "rwget '". substr($filename, 1) . "'",
};

my $patterns = {
	'\.dmg'												=> "hdiutil imageinfo '$filename'",
	'\.([\dl](x|t|pm)?|man)\.gz$'	=> "( gunzip -c '$filename' | groff -E -s -p -t -e -Tascii -mandoc )",
	'\.([\dl](x|t|pm)?|man)$'			=> "groff -E -s -p -t -e -Tascii -mandoc",
	'\.(mpe?g|mp3)$'							=> "mpginfo '$filename'",
	'\.(plist|phr|webarchive|webhistory)$'		=> "plutil -convert xml1 -o /dev/stdout '$filename'",
	'\.(pod|pm)$'									=> "perldoc '$filename'",
	'\.(tar\.bz|tbz)2?$'					=> [
		"tar jtvvf -",
		"tar jxOf - '$wildcard'"
	],
	'\.(tar\.g?z|tgz)$'						=> [
		"tar ztvvf -",
		"tar zxOf - '$wildcard'",
	],
	'\.(zip|jar|sxw|egg|pages)$'	=> [
		"unzip -l '$filename'",
		"unzip -p '$archive' '$wildcard'",
	],
	'\.7z$'												=> "7z l '$filename'",
	'\.a$'												=> "ar vt /dev/stdin",
	'\.arj$'											=> "unarj l",
	'\.bom$'											=> "lsbom -p MUGsf /dev/stdin",
	'\.class$'										=> "jad -b -dead -ff -i -safe -space -p /dev/stdin",
	'\.doc$'											=> "antiword /dev/stdin",
	'\.g?z$'											=> "gunzip -c",
	'\.bz2?$'											=> "bunzip2 -c",
	'\.html?$'										=> "w3m -dump -T text/html",
	'\.(jpe?g|gif|crw|psd|tiff?)$'=> "sips -g all '$filename'",
	'\.pax\.gz$'									=> [
		"gunzip -c | pax -v",
		"gunzip -c | pax -v '$wildcard'", # only shows archivemembers matching,
                                      # cannot extract file to stdout
	],
	'\.pax$'											=> [
		"pax -v",
		"pax -v '$wildcard'",
	],
	'\.cab$'											=> [
		"cabextract -l '$filename'",
		"cabextract -p -F '$wildcard' '$archive'"
	],
	'\.pax\.gz$'									=> "pax -zv",
	'\.pdf$'											=> "pdftotext /dev/stdin /dev/stdout 2>/dev/null",
	'\.rar$'											=> [
		"unrar l '$filename'",
		"unrar p '$archive' '$wildcard'",
	],
	'\.swf$'											=> "swfdump -D '$filename'",
	'\.tar$'											=> [
		"tar tvvf -",
		"tar xOf - '$wildcard'",
	],
	'\.txt$'											=> "tr '\r' '\n' < '$filename'",

	# new pkg format for Leopard
	'\.(pkg)$'										=> "xar -tf '$filename'",

	# bundle handlers
	'\.(pkg|app)/$'							  => "cat '$filename'/Contents/Info.plist",

	# Symbian SIS files
	'\.sisx?$'										=> "sisinfo -if '$filename'",
};

# use archive-name in lookup
$filename = $archive
	if defined $archive
	and -1 == index($filename, "://"); # don't mistake protocols for archives

# determine ALL matching patterns in a hash, and elect winner
my $sub					= sub {
	no warnings;

	my $hash		= shift;
	my @matches	= grep { $filename =~ m/$_/i } keys %$hash;

	print "MATCHES: " . join(", ", @matches) . "\n"
		if $ENV{LESSOPEN_DEBUG};

	# determine winner by the number of extensions it matches
	my $re			= qr{\\.};
	my $winner	= [ sort { $b =~ s/$re/$&/g <=> $a =~ s/$re/$&/g } @matches ]->[0];

	return $hash->{$winner};
};

# determine match
my $protocol		= &$sub($protocols);
my $pattern			= &$sub($patterns);

# protocolhandlers have priority
my $command			= $protocol || $pattern || "cat";

# check for archive-member-listing
$command = $command->[(defined $archive and defined $member)]
	if "ARRAY" eq ref($command);

# build commandline
my $commandline	= $command;

# feed original file as stdin, unless this is a protocol handler or we're
# lessing a directory
$commandline .= " < '$filename'"
	unless $protocol or -d $filename;

# don't bother with errors
close STDERR;

# either print or execute
if ($ENV{LESSOPEN_DEBUG})
{
	print $commandline, "\n";
}
else
{
	exec $commandline;
}