RetroZilla/extensions/xmlterm/scripts/xcat

#!/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;
    }
}