package treewalk;

=head1 NAME

treewalk - perl module that deals with walking directory trees.
           (The main program is assumed to have the stub routines)

=head1 SYNOPSIS

    use treewalk qw (&doit &bustname
                     $needspace $wantabs $wanthelp $wantdots $wantfull $wantbig
                     $wantsize $wantperms $wantdirs $wantnogrf $maxdepth
                     $nodirmessage $workingdir 
                     );
    # $needspace - Extra space
    # $wantabs   - want absolute path names.
    # $wantdots  - Show UNIX dot files.
    # $wantsize  - Show file sizes.
    # $wantperm  - Show File Permissions
    # $maxdept   - Maximum depth to go into a directory structure.

    &bustname('/a/b/c') returns ('/a/b', 'c')

    &doit();


    # We expect the user to provide many stubs in the main program:
    # Most will do nothing other than return.

main::init()
   #  Any global initializtion that needs to be done before we start.

main::fini()
   #  Any global finalization code that needs to be done as we finish.

main::arginit ($argument)
   # Per argument initialization.

main::argfini ($argument) 
   # Per argument finalization code.

main::displayfile ($filename, $inode) returns Boolean
   # Should we display this file?

main::wantdir ($fullname, $inode) returns Boolean
   # Should we display this directory?

main::enterdirectory ($indent, $dirname);
   # Any housekeeping to do entering a directory.

main::exitdirectory ($indent, $dirname);
   # any housekeeping to do when exiting a directory.

main::processfile($indent, $fullname);  # Can update $needspace
   # Processing a file.

main::processdir ($indent, $fullname);
   # Processing a directory.

main::processuseropt ($option) returns boolean;)
   # Processing a user option. Return 1 if you processed the option.

main::printuseropt ($option)

main::defaultfile ();
   # what to do if the user specified nothing.
   # returning $workingdir is a good choice, erroring out might
   $ be appropriate also.

main::mungename {$given);
   # Any fixup you want done before displaying a name.



=head1 DESCRIPTION

Walking a tree is a useful function.  This does that and calls
user provided stubs.

=head1 AUTHOR

John Halleck <John.Halleck@utah.edu>

=head1 COPYRIGHT

(C) Copyright 2000 by John Halleck.

=cut

require 5.0;
use strict;
use vars qw(
          $wanthelp $wantdots $wantfull $wantbig $wantsize $wantperms $wantdirs
          $wantnogrf $maxdepth $nodirmessage $fail %inodenames $needspace %exceptions
          $workingdir $thename $given $anexception $inode
          $needspace $wantabs
          $VERSION @EXPORT_OK @ISA
         );

@ISA = qw (Exporter);
@EXPORT_OK = qw(&doit &bustname $needspace $wantabs $wanthelp $wantdots
                $wantfull $wantbig $wantsize $wantperms $wantdirs $wantnogrf
                $maxdepth $nodirmessage $workingdir);

$VERSION = 1.67;

use paths qw(&makepathrel &makepathabs);

# Set default options
$wanthelp   = 0; # Want help message
$wantdots   = 0; # Go through dot files and directories.
$wantfull   = 0; # Print fully expanded names.
$wantbig    = 0; # Special readability for big directories.
$wantsize   = 0; # want file sizes.
$wantperms  = 0; # want file permissions.
$wantdirs   = 0; # want only directories.
$wantnogrf  = 0; # want no graphics.
$maxdepth   = 0; # depth limit for tree walk.

# Housekeeping
$nodirmessage = undef; # An alternate message programs can set.

$fail = 0;
%inodenames = ();
$needspace = 0; # do we need extra space for readability?

%exceptions = (); # Files and directories not to process.

$workingdir = ''; # We'll need to know where we are if the
                  # user gives a relative reference on the
                  # command line.
if      (defined $ENV{'PWD'}) {
   $workingdir = $ENV{'PWD'};
} elsif (defined $ENV{'HOME'}) {
   $workingdir = $ENV{'HOME'};
}
if ($workingdir !~ m:/$:) { $workingdir .= '/' }

# ---------------------------------------------------------------------------
# This routine is shared by several different programs...

sub dumpperm {
  my $perm = shift; $perm = 0 if !defined $perm;
  my $result = '';
  if ($perm & 04) { $result .= 'r' } else { $result .= '-'}
  if ($perm & 02) { $result .= 'w' } else { $result .= '-'}
  if ($perm & 01) { $result .= 'x' } else { $result .= '-'}
  return $result;
}
sub dumpperms {
  my $perms = shift; $perms = 0 if !defined $perms;
  if ($perms eq '') { return '?????????' }
  my $result =  &dumpperm ($perms >> 6) 
              . &dumpperm ($perms >> 3) 
              . &dumpperm ($perms);
  if ($perms & 04000) {
     substr($result,2,1) = substr($result,2,1) eq 'x' ? 's' : 'S';
  }
  if ($perms & 02000) {
     substr($result,5,1) = substr($result,5,1) eq 'x' ? 's' : 'S';
  }
  if ($perms & 01000) {
     substr($result,8,1) = substr($result,8,1) eq 'x' ? 't' : 'T';
  }
  return $result;
}

sub treewalk { # Walk the tree processing as we go.
   my $indent       = shift;
   my $indentraw    = shift;
   my $depth        = shift;
   my $fullname     = shift;

   # print "DEBUG: treewalk called $fullname, $depth\n";

   my $softlink = -l $fullname;         $softlink = 0 if !defined $softlink;
   my $inode    = (stat $fullname) [1]; $inode = '' if !defined $inode;
   my $isdir = !$softlink && -d _;
   my $hardlink = 0;
   if (!$softlink && !$isdir && defined ((stat _) [3])) {
      # Yeah... we know that there can be hard links to directories...
      # But if we have one there is not much we can really tell without
      # taking the entire directory appart.
      $hardlink = (stat _) [3] > 1;
   }
   my $exists   = -e _;
   my $linkname = '';
   my $linktype = '';
   my $actlink  = '';
   if ($softlink) {
     $linktype = '=>';
     $linkname = readlink $fullname; $linkname = '' if !defined $linkname;
     $actlink  = &makepathabs ($linkname, $fullname);
   } elsif ($hardlink) {
     $linktype = '==';
     if (defined $inode && $inode ne '' && defined $inodenames{$inode}) {
        # Hard link we know.
        $linkname = $inodenames{$inode};
     }
   }
    
   if ($isdir && $fullname !~ m/\/$/) { $fullname .= '/' }
   my $shortname = $fullname;
   if ($depth > 0) { ($shortname) = $fullname =~ m:/([^/]+/?)$: }
     
   # --- output name -----

   # Handle spacing for readability.
   if ($isdir && $depth > 0) { $needspace = 1 }
   print $indentraw, '|'                   if $needspace && !$wantnogrf;
   print "\n"                              if $needspace;
   $needspace = 0;

   # put out a reasonable name.
   print $indentraw                        if !$wantnogrf;
         print '|-- '                      if $depth > 0 && !$wantnogrf;

   if ($wantperms) {
      my $perms = (stat _) [2];
      print &dumpperms ($perms), ' ' if defined $perms;
   }

   print &main::mungename($shortname, $fullname);
   print ' (', $fullname, ')'              if $wantfull
                                              || ($isdir && $wantnogrf)
                                              || ($wantbig && $needspace)
                                              ;

   if ($linktype ne '') {
     print " $linktype ", $linkname;
     print " ($actlink)"
         if $actlink ne ''
         && $actlink ne $fullname
         && $actlink ne $shortname
         && $actlink ne $linkname;
     print " [??? *** Does not exist\a]" if $softlink && !-e $actlink;
   } elsif ($exists && !$softlink && $wantsize) {
      print " [", -s _, " bytes]";
   }

   print "\n";

   $inodenames {$inode} = $fullname if !$softlink
                                    && defined $inode
                                    && !defined $inodenames{$inode};

   # --- Handle early bailouts ----

   if (!$exists)   { return }
   elsif (!$isdir) { # Handle per file processing.
       &main::processfile ($depth, $indent . '+ ', $fullname); 
       return
   }

   # --- must be a directory.

   $needspace = 1; # we need extra space for readability after directories.
   my $markindent = $indent . '|';

   if ($linkname ne '') 
      { print $markindent, " *** Not processed, link to $linkname\n" }
   elsif ($maxdepth != 0 && $depth >= $maxdepth)
      { print $markindent, " *** Not processed, max depth reached\n" }
   elsif (defined $exceptions{$inode})
      { print $markindent, " *** Processing suppressed by option\n" }
   elsif (!&main::wantdir($fullname, $inode)) {
      if (!defined $nodirmessage)
            { print $markindent, " *** Not processesing directory\n"}
      else  { print $markindent, $nodirmessage, "\n" }
   } else {
      # Discover what's in the directory.
      my $thedirectory = $fullname;
      &main::processdir ($markindent, $fullname);

      if (!opendir (DIR, $thedirectory))
         { print $markindent, " *** Not checked ($!)\a \n"; }
      else {
         # Get the contents of the directory.
         my $next; my @directorycontents = ();
         while (defined ($next = readdir DIR)) {
            if ($next eq '' || $next eq '.' || $next eq '..') { next }
            if (!$wantdots && $next =~ m/^\./)                { next }
            $fullname = $thedirectory . $next;
            $isdir = -d $fullname;
            if (!$isdir && $wantdirs)                         { next }
            if (!$isdir && defined $exceptions{$inode})       { next }
            if (!&main::displayfile ($fullname, $inode))      { next }
            push @directorycontents, $fullname;
         }
         if (!closedir (DIR))
            {print "$markindent *** Couldn't close $thedirectory ($!) ***\a\n"}

         else { # Ok, let's dump out the contents of this directory.
           @directorycontents = sort @directorycontents
               if @directorycontents > 0;
           &main::enterdirectory  ($markindent . '+ ', $thedirectory);
           my $newindent = $indent . '|   ';
           $needspace = 1;
           if (@directorycontents == 0) {
              print $markindent, "\n" if !$wantnogrf;
           } else {
              while (@directorycontents > 0) {
                 $thename = shift @directorycontents;
                 if (@directorycontents == 0) { $newindent = $indent . '    ' }
                 &treewalk ($newindent, $indent, $depth + 1, $thename);
              }
           }
           $needspace = 1; # We need extra space for readability after
                           # directories.
           &main::exitdirectory ($markindent, $thedirectory); # cleanup.
         }
      }
   }
}

# --- Extract directory parts.

sub bustname {  # file is assumed to have been made absolute.
  my $given = shift;
  if ($given eq '' || $given eq '/')  { return ('/', '')     }
  if ($given !~ m:^/:)                { return ('/', $given) }
     # This should probably should be an error
  if ($given =~ m:^/([^/]+)$:)        { return ('/', $1)     }
  if ($given =~ m:^(/.+/)([^/]+/?)$:) { return ($1, $2)      }
  return ('',$given);
}

# --- Setup.

sub treewalkstart {
  my $given = shift; # Assume fully qualified.
  %inodenames = (); $needspace = 0;
  my $realname = $given;
  $realname = &makepathabs ($realname, $workingdir);
  my ($directory, $filename) = &bustname ($realname); 

  my $needdirectory = $directory ne '' && !-d $realname;
     # If what we are given in not a directory,
     # the walk will not notice that we have entered
     # the parent directory.

  if ($needdirectory) { &main::enterdirectory ('', $directory) }

  &treewalk ('','',0, $realname); # Go for it.

  if ($needdirectory) { &main::exitdirectory ('', $directory) }
}

# ---------------------- Ok, use the utility developed above.

sub doit {
# Process arguments and get files.
my $progversion = shift;
my @files = (); $fail = 0;
while (defined ($given = shift @ARGV)) {
   if ($given !~ m/^\-(.*)$/) { # Argument.
      push @files, $given; # must be file to process.
   } else { # Otherwise it is an option.
      my $option = $1;
      if    ($option eq 'a') { $wantdots  = 1 }
      elsif ($option eq 'b') { $wantbig   = 1 }
      elsif ($option eq 'd') { $wantdirs  = 1 }
      elsif ($option eq 'e') { 
        $anexception = shift @ARGV; $anexception = '' if !defined $anexception;
        if ($anexception eq '' || !-e $anexception) {
           warn "*** Bad file given for exception option (\"$anexception\")\n";
        } else {
          $inode = (stat _)[1];
          $exceptions{$inode} = $anexception;
        }
      }
      elsif ($option eq 'f') { $wantfull  = 1 }
      elsif ($option eq 'p') { $wantperms = 1 }
      elsif ($option eq 's') { $wantsize  = 1 }
      elsif ($option eq 'n') { $wantnogrf = 1 ; $wantbig = 1; }
      elsif ($option eq 'm') { 
        $maxdepth = shift @ARGV; $maxdepth = '' if !defined $maxdepth;
        if ($maxdepth !~ m/^\d+$/) {
           warn "*** Bad depth given for m option ($maxdepth)\n";
        } 
      }
      elsif ($option eq 'V') {
        if (defined $progversion) {
           warn "Program: $progversion\nFrame ";
        }
        warn "Version: $VERSION of treewalk\n";
      }
      elsif ($option eq 'h') { $wanthelp = 1 }
      elsif (&main::processuseropt($option)) {}
      else {
         warn "Unknown option \"$option\"\n";
         $fail++;
      }
   }
}
if ($fail > 0) {
  exit 1;
}

# ---- We've got a list of what the user wants.

# If nothing given on command line, check if program has defaults.
if (@files == 0) {
   my $userwants = &main::defaultfile();
   if (defined $userwants) { @files = ($userwants) }
}

if ($wanthelp || @files == 0) { # User confused?
   warn "treedir [-a] [-h] directories\n";
   warn "  -V      print program version\n";
   warn "  -a      show dot files and directories\n";
   warn "  -b      extra readability for BIG directories\n";
   warn "  -d      do ONLY directories and don't list files\n";
   warn "  -e xxx  Don't process given directory or file\n";
   warn "  -f      Always print full expanded file names\n";
   warn "  -h      Produce this help message\n";
   warn "  -p      list file permissions.\n";
   warn "  -s      print file sizes\n";
   warn "  -m #    limit depth of processing to #\n";
   warn "  -n      suppress graphics\n";
   &printuseropt();
}

&main::init();
   # Let the user do their program wide startup.


# Do the files stated.
foreach $given (@files) {

    my $realname = &makepathabs ($given, $workingdir);
       # Undo any relative references the user gave.

    &main::arginit($realname);
       # Let the user do any needed setup.

    &treewalkstart($realname);
       # Go for it.

    &main::argfini($realname);
       # and any needed cleanup.

}

&main::fini();
}
1;