mirror of
https://github.com/rn10950/RetroZilla.git
synced 2024-08-30 17:40:16 +02:00
197 lines
6.8 KiB
Plaintext
197 lines
6.8 KiB
Plaintext
|
#!/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/&/&/g; # Replace & with &
|
||
|
s/</</g; # Replace < with <
|
||
|
s/>/">"/g; # Temporarily replace > with ">"
|
||
|
# 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/">"/>/g; # Replace ">" with > 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;
|
||
|
}
|
||
|
}
|