#!/usr/bin/perl -w

# tree - Draw a tree of the directory hierachy in a manner similar to
# the MS-DOS command of the same name.

# (C) 1996 Pharos IP Pty Ltd
# $Id: tree,v 2.9 1997-10-30 16:08:32+10 mbp Exp $

# ---------------------------------------------
# Procedure: Descend through the directory tree in a prefix search.
# ---------------------------------------------

# Libraries ----------------------------------------------------------
use Getopt::Long;
use integer;

# Process args -------------------------------------------------------
$Getopt::Long::ignorecase = 0;
%optctl = ('files!'     , \$show_files,
	   'F'          , \$show_files,
	   'key!'       , \$show_key,
	   'k'          , \$show_key,
	   'dots!'      , \$show_dots,
	   'd'          , \$show_dots,
	   'depth=i'    , \$max_depth,
	   'n=i'        , \$max_depth,
	   'indent=i'   , \$indent_width,
	   'i=i'        , \$indent_width,
	   'owner!'     , \$with_owner,
           'o'          , \$with_owner,
           'mode!',     , \$with_mode,
           'm'          , \$with_mode,
	   'ignore-re=s@', \@ignore_re,
	   'I=s@',       , \@ignore_re,
	   'help'       , \$show_help);
GetOptions(%optctl);
$indent = ' ' x ($indent_width || 2);
print_help(), exit(0) if ($show_help);

# Directory in which to start
my @dirs = @ARGV?@ARGV:('.');

# Map uids and gids back to names
my (%uid_cache, %gid_cache) = ();
sub user_name {
    my $uid = shift;
    return $uid_cache{$uid} if exists $uid_cache{$uid};
    return $uid_cache{$uid} = (getpwuid($uid))[0] || $uid;
}

sub group_name {
    my $gid = shift;
    return $gid_cache{$gid} if exists $gid_cache{$gid};
    return $gid_cache{$gid} = (getgrgid($gid))[0] || $gid;
}

# Main ---------------------------------------------------------------
for $root (@dirs) {
    chdir($root);
    $root = `pwd`;
    chomp($root);
    
    # Add trailing slash if missing
    $root .= '/' unless ( substr($root, -1, 1) eq '/' );
    
    print($root, "\n");
    process_dir($root, 1);
}

print_key() if ($show_key);

# Recursive descent --------------------------------------------------
# process_dir: 

#   Recursively traverses the directory hierarchy below $dirname,
#   printing the names of files as appropriate.  $level specifies the
#   current level of recursion, where the starting directory is 1.
#   $dirname must be an absolute pathname, starting and ending with a
#   slash.

#   This subroutine starts coming back up out of the directory if it
#   reaches it's maximum recursion depth, or isn't allowed to descend
#   deeper, or if there are no more subdirectories.

sub process_dir {  # ($dirname, $level)
    my $dirname = shift;
    my $level = shift;
    my $fullname;
    my $target;
    my $entry;

    if ( !opendir(DIR, $dirname) ) {
	print($indent x ($level), 
	      "** can't open directory $dirname: $!\n");
	return;
    }

    my @entries = sort readdir(DIR);
    closedir(DIR);

    my $thisindent = $indent x $level;

    foreach $entry (@entries) {
	next if ( $entry eq '.'  ||  $entry eq '..' );
	next if @ignore_re && grep(($entry =~ /$_/), @ignore_re);
	$fullname = $dirname . $entry;
	my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
	    $atime,$mtime,$ctime,$blksize,$blocks)
	    = lstat($fullname);
	next if ( !(-d _) && !$show_files );
	next if ( !$show_dots  &&  substr($entry,0,1) eq '.' );

	print($thisindent);
	print($entry);

	my @extra = ();
	if ($with_owner) {
	    push @extra, user_name($uid).'/'.group_name($gid);
	}
	if ($with_mode) {
	    push @extra, sprintf('%o', $mode & 07777);
	}

	if ( -l _ ) {
	    print("@");
	    if ( $target = readlink($fullname) ) {
		print(" -> ", $target);
	    }
	    print("\n");
	}
	elsif ( -d _ ) {
	    print('/');
	    if (@extra) {
		print ' (', (join ',', @extra), ')';
	    }
	    if ( !$max_depth  ||  ($level < $max_depth) ) {
		print "\n";
		process_dir(($fullname . '/'), $level+1);
	    }
	    else {
		print("...\n");
	    }
	} 
	else {
	    if (@extra) {
		print "  \t(", (join ',', @extra), ')';
	    }
	    print ("\n");
	}
    }
}


# Key to symbols -----------------------------------------------------
sub print_key { #()
    print("\n", '-' x 60, "\n");
    print("Files within directories ",
	  $show_files ? "ARE" : "ARE NOT",
	  " displayed.\n");
    print("Key: \n",
	  "/ directory        @ symlink      /... too deep\n");
}

# Help lusers --------------------------------------------------------
sub print_help { #()
    print "
tree - print a directory tree.
Usage: $0 [OPTION]... [PATH]

  --help              Show help message
  -F, --files         Include files as well as directories
  -k, --key           Include a key to symbols at the end
  -d, --dots          Include normally-hidden dot files & directories
  -n, --depth=MAX     Descend at most MAX levels
  -i, --indent=WIDTH  Indent by WIDTH space characters per level of tree
  -I, --ignore-re=REGEXP
                      Ignore files or directories matching Perl REGEXP
  -o, --owner         Show file owners and groups
  -m, --mode          Show file modes (permissions)
  PATH                Directory in which to begin.  (default = current.)
";
}