head	1.1;
access;
symbols;
locks
	alexis:1.1; strict;
comment	@# @;


1.1
date	98.08.06.13.32.20;	author alexis;	state Exp;
branches;
next	;


desc
@walks 'ls' listings
@


1.1
log
@Initial revision
@
text
@#!/usr/bin/perl
use strict;


#  RCS version string
$main::modvers{'thisprogram'} = "MARKER";
($main::modvers{'thisprogram'} =~ /^M.*R$/) && ($main::modvers{'thisprogram'} = '$Id: lswalk,v 1.2 1996/11/02 11:32:38 alexis Exp alexis $') =~ s/^.*,v (\S+) .*$/$1/;

#  The name of this program
($main::main::progname = $0) =~ s/^.*\/([^\/]+)/$1/;

$main::localpl_dir = "/usr/local/lib/perl5";
$ENV{'FADLIBDIR'} && ($main::localpl_dir = $ENV{'FADLIBDIR'});

push(@@INC,split(/:/, $main::localpl_dir));
$main::localpl_dir = "/usr/local/lib/perl5";

require 'msgs.pl';
($main::modvers{'msgs.pl'} ne "1.12") && (!$ENV{'IGNORELOCALPLVERS'}) && &msgs::error("configuration error: wrong version of msgs.pl");
require "zfiles.pl";
($main::modvers{'zfiles.pl'} ne "1.13") && (!$ENV{'IGNORELOCALPLVERS'}) && &msgs::error("configuration error: wrong version of zfiles.pl");

$main::FLG_DEFAULT  = 0x00;
$main::FLG_LS_SHOW  = 0x01;
$main::FLG_RS_SEEK  = 0x02;
$main::FLG_ST_ROOT  = 0x04;

$main::FLG_LISTALL  = 0x01;
$main::FLG_LISTLONG = 0x02;

$main::FLD_OFS = "o";
$main::FLD_DIR = "d";

#  returns 0 if EOF not encountered.
sub readrootdir
{
    my($flags) = @@_;
    my($eofstat, $rootlsline, $savedofs);
    my($rootdir, $lsline, $nextdirls);

    #  Move the the root directory listing
    $savedofs = tell(LS_HANDLE);
    seek(LS_HANDLE, 0, 0);

    #  Keep the show status we received, but don't keep the
    #  dirent 'cos we do it later in this func
    $eofstat = &readcurrdir($flags & $main::FLG_LS_SHOW);

    #  We need to look at the next directories entry
    #  in order to work out where we are. But are

    &msgs::debug(13, "readrootdir: flags=$flags");
    if ($flags & $main::FLG_ST_ROOT) {
        if ($eofstat) {
            $main::directories{".",$main::FLD_OFS} = 0;
            &msgs::debug(9, "readrootdir: recording . 0");
	    $rootdir = ".";
        } else {
	    #  Can peek at next
	    #  Read over the blank line and save the offset so
	    #  that subsequent calls to readdir() will catch
	    #  their start points.
	    $nextdirls = tell(LS_HANDLE);
	    $lsline = <LS_HANDLE>;
	    $lsline =~ s/^(.*):\n/$1/;
	    &msgs::debug(10, "readrootdir: lsline is $lsline (stripped dir entry)");
	    $rootdir = &dirname($lsline);
            &msgs::debug(9, "readrootdir: recording $rootdir 0");
            $main::directories{$rootdir,$main::FLD_OFS} = 0;
	    seek(LS_HANDLE, $nextdirls, 0); 
        }
    }

    #  If restoring seek position return 0 for eof not met (even if met)
    #  otherwise return whether eof was met.
    if ($flags & $main::FLG_RS_SEEK) {
        seek(LS_HANDLE, $savedofs, 0);
	return(0, $rootdir);
    } else {
        return($eofstat, $rootdir);
    }
}

sub ratdir
{
    my($srcdir) = @@_;
    my($dstdir, $dir, @@srcdirs);

    #  Remove all double slashes
    $srcdir =~ s#/+#/#g;

    #  Set dstdir to / or . and strip leading /
    $dstdir = ($srcdir =~ s/^\///) ? "/" : ".";

    #  Split up directories which no longer have leading /
    @@srcdirs = split(/\//, $srcdir);

    #  No look at all combinations of current directory and next component
    while ($dir = shift @@srcdirs) {
	if ($dir eq "..") {
	    if ($dstdir =~ /^[^\/]+$/) {
		$dstdir = ".";
	    } elsif ($dstdir =~ /^\/[^\/]+$/) {
		$dstdir = "/";
	    } elsif ($dstdir ne "." && $dstdir ne "/") {
		$dstdir =~ s/^(.*)\/[^\/]+$/$1/;
	    }
	} elsif ($dir ne ".") {
            if ($dstdir eq ".") {
		$dstdir = $dir;
	    } elsif ($dstdir eq "/") {
		$dstdir = "/$dir";
	    } else {
		$dstdir = "$dstdir/$dir";
	    }
	}
    }

    return($dstdir);
}

sub cmd_ls
{
    my($currdir, @@args) = @@_;
    my($savedofs) = tell(LS_HANDLE);
    my($lsdir, $options, $dir, $arg, $letarg);

    &msgs::debug(12, "cmd_ls: sof");
    #  Process ls options
    while (@@args) {
	$arg = $args[0];
	&msgs::debug(9, "cmd_ls: processing argument: $arg");
	if ($arg =~ /^-(.*)/) {
	    foreach $letarg (split(//, $1)) {
		if ($letarg eq "a") {
		    $options |= $main::FLG_LISTALL;
		} elsif ($letarg eq "l") {
		    $options |= $main::FLG_LISTLONG;
		} else {
		    &message("ls: invalid option '$letarg'");
		}
	    }
	} else {
	    &msgs::debug(9, "cmd_ls: end of options");
	    last;
	}
	#  Do the shift at the end 'cos of the one case where
	#  we don't want to do it.
	shift @@args;
    }

    &msgs::debug(12, "cmd_ls: about to go into dir loop");
    if (@@args) {
        &msgs::debug(9, "directories supplied, processing");
        while ($dir = shift @@args) {
            &msgs::debug(9, "in loop, first arg is $dir");
            if ($dir =~ /^\// && $main::directories{$lsdir=&ratdir($dir), $main::FLD_OFS} eq "") {
                &message("$lsdir: no such directory");
            } elsif ($dir =~ /^[^\/]/ && $main::directories{$lsdir=&ratdir("$currdir/$dir"), $main::FLD_OFS} eq "") {
                &message("$lsdir: no such directory");
	    } else {
		&msgs::debug(9, "after the ratdir we have $lsdir - now listinh");
		&do_ls($lsdir, $options);
	    }
	}
    } else {
        &msgs::debug(9, "using current directory");
	&do_ls($currdir, $options);
    }
}

sub do_ls
{
    my($dir, $options) = @@_;
    my($savedofs) = tell(LS_HANDLE);

    if (seek(LS_HANDLE, $main::directories{$dir,$main::FLD_OFS}, 0) != 1) {
        die "can't seek: $!\n";
    } else {
	#  readcurrdir() doesn't do a reseek 'cos we do. We know to where
	#  ignore return status since we immediately do a seek
	&readcurrdir($main::FLG_LS_SHOW);
    }

    seek(LS_HANDLE, $savedofs, 0);
}

sub readcurrdir
{
    my($flags) = @@_;
    my($ofs, $eofstat, $lsline, $endofdirls, $dir);
    my($savedofs) = tell(LS_HANDLE);

    $endofdirls = 0;
    $ofs = $savedofs;
    ($flags & $main::FLG_LS_SHOW) && (open(PAGER_PIPE, "|" . ($ENV{'PAGER'} || "/bin/more")) || die "can't open pipe to pager: $!\n");
    while (!$endofdirls && ($lsline = <LS_HANDLE>)) {
        print PAGER_PIPE $lsline if ($flags & $main::FLG_LS_SHOW);
        if ($lsline eq "\n") {
            $endofdirls = 1;
        } elsif ($lsline =~ /^(.*):\n$/) {
	    $dir = $1;
	    if ($flags & $main::FLG_ST_ROOT) {
	        $main::directories{$dir,$main::FLD_OFS} = $ofs;
                &msgs::debug(9, "readcurrdir: recording $dir $ofs");
	    }
        }
	$ofs = tell(LS_HANDLE);
    }
    ($flags & $main::FLG_LS_SHOW) && close PAGER_PIPE;
    seek(LS_HANDLE, $savedofs, 0) if ($flags & $main::FLG_RS_SEEK);
    $eofstat = !$endofdirls;
    return($eofstat);
}

sub cmd_cd
{
    my($currdir, @@args) = @@_;
    my($returndir, $dir);

    $returndir = $currdir;

    if (defined($args[1])) {
	&message("cd: bad directory");
    } elsif ($args[0] eq "") {
	&message("cd: no directory");
    } elsif ($args[0] =~ /^\// && $main::directories{$dir=&ratdir("$args[0]"), $main::FLD_OFS} eq "") {
	&message("$dir: no such directory");
    } elsif ($args[0] =~ /^[^\/]/ && $main::directories{$dir=&ratdir("$currdir/$args[0]"), $main::FLD_OFS} eq "") {
	&message("$dir: no such directory");
    } else {
	$returndir = $dir;
    }
    return($returndir);
}

sub dirname
{
    my($dir) = @@_;

    #  /XXXXX --> /
    if ($dir =~ /^\/[^\/]+$/) {
        &msgs::debug(9, "dirname: type is /directory");
        return("/");

    #  XXXXX --> .
    } elsif ($dir =~ /^[^\/]+$/) {
        &msgs::debug(9, "dirname: type is directory");
	return(".");

    #  PATH/XXXXX --> PATH
    } elsif ($dir =~ /^(.+)\/[^\/]+$/) {
        &msgs::debug(9, "dirname: $dir --> $1");
        return($1);

    } else {
        &msgs::debug(3, "dirname: type is unknown: $dir");
    }
}

sub message
{
    print "@@_\n";
}

sub usage
{
    print STDERR "Usage: $main::progname [ -v ] [ -d level ] lsfile\n";
    exit(1);
}

sub main
{
    my(@@args) = @@_;
    my($cmd, $cmdline, @@cmdlinewords);
    my($lsfile, $dircnt);
    my($currdir, $eofstat, $rootdir, $quit);

    #  Get the name of this program
    if ( $0 =~ /^.*\/(\w+)$/ ) {
        $main::progname = $1 ;
    }

    while (defined($args[0]) && $args[0] =~ /^-/) {
        $_ = shift(@@args);
        if (/^-d(.*)/) {
            $msgs::verboselevel = $1 ? $1 : shift(@@ARGV);
        } elsif (/^-v$/) {
            $msgs::verboselevel = 3;
        } else {
            &usage;
        }
    }

    ($lsfile = shift @@args) || &usage;
    (@@args) && &usage;

    #  Open the list file
    #  &zfiles::zopenr($lsfile, \*LS_HANDLE) || die "Couldn't open $lsfile: $!\n";
    open(LS_HANDLE, $lsfile) || die "Couldn't open $lsfile: $!\n";
    #  Read the root directory
    ($eofstat, $rootdir) = &readrootdir($main::FLG_ST_ROOT);
    $eofstat && die "Only one directory!";
        print ++$dircnt, "\r";
    #  Read subsequent directories
    while (&readcurrdir($main::FLG_ST_ROOT) == 0) {
        print ++$dircnt, "\r";
    }
    # $verbose_flag && print "\n";

    $currdir = $rootdir;
    print "$main::progname> ";
    $quit = 0;
    while(!$quit && ($cmdline = <STDIN>)) {

        #  Read the command and chop it up
        chop($cmdline);
        @@cmdlinewords = split(/ /, $cmdline);
        $cmd = shift @@cmdlinewords;
    
        if ($cmd eq "ls") {
	    &cmd_ls($currdir, @@cmdlinewords);

        } elsif ($cmd eq "exit") {
	    $quit = 1;
    
        } elsif ($cmd eq "cd") {
	    $currdir = &cmd_cd($currdir, @@cmdlinewords);

        } elsif ($cmd eq "pwd") {
	    print "$currdir\n";

        } elsif ($cmd =~ /!(.*)/) {
	    system($1);

        } elsif ($cmd eq "") {
	    ;

        } else {
            print "$cmd: bad command\n";
        }

        print "$main::progname> ";
    }
    print "\n";
    close(LS_HANDLE);
    exit(0);
}

exit(&main(@@ARGV));
@