#!/usr/bin/perl # xcat: an XMLterm wrapper for the UNIX "cat" command # Usage: xcat [-h|help] use Cwd; use Getopt::Long; Getopt::Long::config('bundling'); $options = "@ARGV"; &GetOptions("help|h!"); if ($opt_help) { print STDERR "Usage: xcat ...\n"; exit; } my $cookie = $ENV{LTERM_COOKIE}; # XMLTerm cookie my $dir = cwd(); foreach my $url (@ARGV) { # for each argument my ($protocol, $slashpair, $username, $host, $port, $pathname); if ( $url =~ m%\b # initiator ([a-zA-Z]\w*)?: # protocol (//)? # slashpair (?:([\w.]+)@)? # username ([\w\-]+(?:\.[\w\-]+)*)? # host (?::(\d+))? # port (/\S*?)? # pathname (?=>|\"|\'|\s|[.,!](?:\s|\Z)|\Z) # terminator (look ahead) %x ) { ($protocol, $slashpair, $username, $host, $port, $pathname) = ($1, $2, $3, $4, $5, $6); ## print STDERR "URL: protocol=$protocol, slashpair=$slashpair, 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"; ($protocol, $slashpair, $username, $host, $port, $pathname) = ("file", "//", "", "", "", $url); } if (($protocol ne "http") && ($protocol ne "file")) { print STDERR "xcat: Cannot handle URI protocol $protocol:\n"; next; } if ($protocol 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")) { ## print STDERR "Image file\n"; print "\e{S$cookie\a"; # HTML stream escape sequence print ""; print "\000"; # Terminate HTML stream } elsif (($protocol eq "http") || ($extension eq ".htm") || ($extension eq ".html")) { print STDERR "Web/HTML file (unable to display due to IFRAME bug)\n"; } elsif (($protocol eq "file") && ($extension eq ".url")) { # URL open INFILE, $pathname or next; $_ = ; close INFILE; my @urlvals; my $nurl = 0; while ( m%\b # initiator (http|file|mailto): # protocol (//)? # slashpair (?:([\w.]+)@)? # username ([\w\-]+(?:\.[\w\-]+)*)? # host (?::(\d+))? # port (/\S*?)? # pathname (?=>|\"|\'|\s|[.,!](?:\s|\Z)|\Z) # 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 clickXMLTerm('textlink',-#,'$urlstr')"%; print "\e{S$cookie\a"; # HTML stream escape sequence if ($nurl >= 2) { print "
"; } print ""; 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\a"; # HTML stream escape sequence print "
";

        while () {
            s/&/&/g;
            s//">"/g;
                s%\b                              # initiator
                 ([a-zA-Z]\w*)?:                  # protocol
                 (//)?                            # slashpair
                 (?:([\w.]+)@)?                   # username
                 ([\w\-]+(?:\.[\w\-]+)*)?         # host
                 (?::(\d+))?                      # port
                 (/\S*?)?                         # pathname
                 (?=>|\"|\'|\s|[.,!](?:\s|\Z)|\Z) # terminator (look ahead)
                 %$&%xg;
                s/">"/>/g;

            print $_;
        }

        print "
"; print "\000"; # Terminate HTML stream close INFILE; } else { # unknown file type print STDERR "xcat: File type unknown for $pathname\n"; next; } }