RetroZilla/extensions/xmlterm/scripts/xcat

197 lines
6.8 KiB
Plaintext
Raw Normal View History

2015-10-21 05:03:22 +02:00
#!/usr/bin/perl
# xcat: an XMLterm wrapper for the UNIX "cat" command
# Usage: xcat [-h|--height]
use Cwd;
use Getopt::Long;
Getopt::Long::config('bundling');
if (!@ARGV) {
print STDERR "Usage: xcat [--height <pixels>] <file1> <URL2> ...\n";
exit;
}
&GetOptions("height|h=i");
my $height = 240;
$height = $opt_height if $opt_height;
my $cookie = $ENV{LTERM_COOKIE}; # XMLTerm cookie
if (!$cookie) {
print 'Please use the "eval `xenv`" command to set-up the remote XMLterm environment'."\n";
exit;
}
my $dir = cwd();
foreach my $url (@ARGV) { # for each argument
my ($scheme, $username, $host, $port, $pathname);
# Check if argument is a valid URL
if ( $url =~ m%\b # initiator
([a-zA-Z]\w*)?: # scheme
(?=/) # lookahead
(?:// # slashpair
(?:([\w.]+)@)? # username
([\w\-]+(?:\.[\w\-]+)*)? # host
(?::(\d+))? # port
)?
(/|/[^/\s]\S*?)? # pathname
(?=>|\"|\'|\s|[.,!](?:\s|\Z)|\Z) # terminator (look ahead)
%x ) {
($scheme, $username, $host, $port, $pathname) = ($1, $2, $3, $4, $5);
## print STDERR "URL: scheme=$scheme, username=$username, host=$host, port=$port, pathname=$pathname\n";
} else {
# Not an URL; assume it is a local file
# Prepend current working directory, if need be, to make full pathname
$url = $dir . "/" . $url if ($url and !($url =~ m%\A/%));
## print STDERR "Not an URL; assume local file $url\n";
# Create a file URL
($scheme, $username, $host, $port, $pathname) =
("file", "", "", "", $url);
}
if (($scheme ne "http") && ($scheme ne "file")) {
print STDERR "xcat: Cannot handle URI scheme $scheme:\n";
next;
}
if ($scheme eq "file") { # Local filename
if (!(-e $pathname)) {
print STDERR "xcat: File $pathname not found\n";
next;
}
if (!(-r $pathname)) {
print STDERR "xcat: Unable to read file $pathname\n";
next;
}
if (-d $pathname) {
print STDERR "xcat: Use the 'xls' command to list contents of directory $pathname\n";
next;
}
}
$pathname =~ m%\A(.*?) (\.[^/.]*)?\Z%x # Deconstruct pathname
or die "xcat: Internal error; unable to deconstruct pathname\n";
($filename, $extension) = ($1, $2);
## print STDERR "Filename=$filename, extension=$extension\n";
if (($extension eq ".gif") ||
($extension eq ".png") ||
($extension eq ".jpg")) {
## print STDERR "Image file\n";
print "\e{S$cookie\n"; # HTML stream escape sequence
print "<IMG SRC='$scheme://${host}$pathname'>";
print "\000"; # Terminate HTML stream
} elsif (($scheme eq "file") && ($extension eq ".ps")) {
## print STDERR "PostScript local file\n";
system("ghostview $pathname&");
} elsif (($scheme eq "file") && ($extension eq ".url")) {
# URL
open INFILE, $pathname or next;
$_ = <INFILE>;
close INFILE;
my @urlvals;
my $nurl = 0;
while ( m%\b # initiator
(http|file|mailto): # scheme
(?=/) # lookahead
(?:// # slashpair
(?:([\w.]+)@)? # username
([\w\-]+(?:\.[\w\-]+)*)? # host
(?::(\d+))? # port
)?
(/|/[^/\s]\S*?)? # pathname
(?=>|\)|\"|\'|\s|[.,!](?:\s|\Z)|\Z) # URL terminator (look ahead)
%x ) {
$urlvals[$nurl] = $&;
s%$&%%;
$nurl++;
}
s%\A\s*(\S.*?)?\s*\Z%$1%;
if ($nurl >= 1) {
my $urldesc = $_;
my $urlstr = $urlvals[0];
$urldesc = $urlstr if !$urldesc;
my $clickcmd =
qq%onClick="return HandleEvent(event,'click','textlink',-\#,'$urlstr')"%;
print "\e{S$cookie\n"; # HTML stream escape sequence
if ($nurl >= 2) {
print "<a target='_new' href='$urlstr'><img src='$urlvals[1]'></a><br>";
}
print "<a target='_new' href='$urlstr'>$urldesc</a>";
print "\000"; # Terminate HTML stream
}
} elsif ( ($scheme eq "http") ||
(($scheme eq "file") && (($extension eq ".htm") ||
($extension eq ".html") ||
($extension eq ".xml")) ) ) {
## print STDERR "IFRAME\n";
print "\e{S$cookie\n"; # HTML stream escape sequence
print "<iframe frameborder=0 width='100%' height='$height' src='$scheme://${host}$pathname'></iframe>";
print "<div class='beginner'>";
print "Use shift-key + Home/End/PageUp/PageDown to scroll nested IFrame.";
print "</div>";
print "\000"; # Terminate HTML stream
} elsif ((-T $pathname) || ($extension eq "txt")) { # plain text file
## print STDERR "Text file\n";
open INFILE, $pathname or next;
print "\e{S$cookie\n"; # HTML stream escape sequence
print "<pre>";
while (<INFILE>) {
s/&/&amp;/g; # Replace & with &amp;
s/</&lt;/g; # Replace < with &lt;
s/>/"&gt;"/g; # Temporarily replace > with "&gt;"
# to allow termination of <http://xyz.com> etc.
s%\b # URL word boundary
([a-zA-Z]\w*)?: # scheme
(?=/) # lookahead
(?:// # slashpair
(?:([\w.]+)@)? # username
([\w\-]+(?:\.[\w\-]+)*)? # host
(?::(\d+))? # port
)?
(/|/[^/\s]\S*?)? # pathname
(?=>|\)|\"|\'|\s|[.,!](?:\s|\Z)|\Z) # URL terminator (look ahead)
%<a target='_new' href='$&'>$&</a>%xg;
s/"&gt;"/&gt;/g; # Replace "&gt;" with &gt; in the end
print $_;
}
print "</pre>";
print "\000"; # Terminate HTML stream
close INFILE;
} else { # unknown file type
print STDERR "xcat: File type unknown for $pathname\n";
next;
}
}