Article 7674 of comp.lang.perl:
Xref: feenix.metronet.com comp.lang.perl:7674
Path: feenix.metronet.com!news.utdallas.edu!wupost!howland.reston.ans.net!pipex!sunic!trane.uninett.no!nntp.uio.no!nntp.uio.no!aas
From: aas@nora.nr.no (Gisle Aas)
Newsgroups: comp.lang.perl
Subject: Re: tool to pretty print directory trees?
Date: 06 Nov 1993 11:47:16 GMT
Organization: Norwegian Computing Center, Oslo, Norway
Lines: 438
Message-ID: <AAS.93Nov6124716@nora.nr.no>
References: <1993Nov5.234205.19234@unet.net.com>
Reply-To: Gisle.Aas@nr.no
NNTP-Posting-Host: nora.nr.no
In-reply-to: thoff@classic1's message of Fri, 5 Nov 1993 23:42:05 GMT

In article <1993Nov5.234205.19234@unet.net.com> thoff@classic1 (Todd Hoff) writes:
>   i'm looking for a tool to pretty print directory
>   trees. Has anyone done this (in perl or whatever)?

If you like Postscript output you might want to try this:

#!/bin/sh
# This is a shell archive (produced by shar 3.49)
# To extract the files from this archive, save it to a file, remove
# everything above the "!/bin/sh" line above, and type "sh file_name".
#
# made 11/06/1993 11:45 UTC by aas@boeygen
# Source directory /nr/holt/u3/aas
#
# existing files will NOT be overwritten unless -c is specified
#
# This shar contains:
# length  mode       name
# ------ ---------- ------------------------------------------
#  10339 -rwxr-xr-x pstree
#
# ============= pstree ==============
if test -f 'pstree' -a X"$1" != X"-c"; then
	echo 'x - skipping pstree (File already exists)'
else
echo 'x - extracting pstree (Text)'
sed 's/^X//' << 'SHAR_EOF' > 'pstree' &&
#!/usr/local/bin/perl
'di';
'ig00';
# pstree(1) - produce directory map in PostScript.
#
# $Id: pstree,v 1.7 1993/10/12 11:36:59 aas Exp $
X
require 'getopts.pl';
X
$Usage = "Usage: $0 [-fFlLv] [-d max_depth] [dirname]]\n";
X
die $Usage unless &Getopts('d:fFlLv');
X
$Version	= defined($opt_v) ? $opt_v : 0;
$ListFiles	= defined($opt_f) ? $opt_f : 0;
$ListTypes	= defined($opt_F) ? $opt_F : 0;
$MaxDepth	= defined($opt_d) ? $opt_d : -1;
$ForceLinks	= defined($opt_L) ? $opt_L : 0;
$ShowLinkTarget	= defined($opt_l) ? $opt_l : 0;
X
if ($Version) {
X   die 'pstree $Revision: 1.7 $ ($Date: 1993/10/12 11:36:59 $)'."\n";
}
X
# Sanity checks:
die "pstree: max_depth must be numeric\n" unless $MaxDepth =~ /\d+/;
X
push(@ARGV,'.');
die "$0: $ARGV[0] does not exist, stopped" unless -e $ARGV[0];
X
sub PAGE_TOP          { 792; }
#sub PAGE_RIGHT_EDGE   { 595; }
sub TB_MARGIN         { 60; }
sub LEFT_MARGIN       { 60; }
sub FONT              { "Times-Roman"; }
sub FONT_SIZE         { 10; }
sub DIR_LEVEL_INDENT  { 90; }
X
$y = &PAGE_TOP - &TB_MARGIN;
$prev_level = 0;
$average_char_width = &FONT_SIZE / 2;
$max_x_pos = 0;  # keep track of it in order produce bounding box
X
open(tmp,"+>/tmp/tree$$") || die "Can't create temporary file";
unlink("/tmp/tree$$");
select(tmp);
X
print "/mws
{
X    1 dict begin
X    gsave
X    /sw 4 index stringwidth pop def
X    dup sw le { %if
X      dup sw div
X      dup 1 3 div lt {
X	dup 3 mul
X      } {
X        1
X      } ifelse
X      matrix scale currentfont exch makefont setfont
X      /sw exch def
X    } { %else
X      pop
X    } ifelse
X    % The stack is now: (string) x y
X    moveto show
X    grestore
X    sw % leave width of string on stack
X  end
} def
";
print  "/s {show} bind def\n";
print  "/m {moveto} bind def\n";
printf "/%s findfont %d scalefont setfont\n",&FONT,&FONT_SIZE;
print  "0.1 setlinewidth\n";
X
X
&list_dir($ARGV[0],0);
X
print "showpage\n";
seek(tmp,0,0); # rewind the temporary file
X
select(STDOUT);
print "%!PS-Adobe-3.0 EPSF-3.0\n";
print "%%Title: (Directory map of $ARGV[0])\n";
print "%%Creator: pstree, (C) 1991 Gisle Aas, NR\n";
printf "%%%%DocumentFonts: %s\n", &FONT;
X
if ($y < &TB_MARGIN) {
X   $page_size = (&PAGE_TOP - 2 * &TB_MARGIN);
X   $scale_factor = ($page_size)/((&PAGE_TOP - &TB_MARGIN ) - $y);
X   printf "%%%%BoundingBox: %.0f %.0f %.0f %.0f\n",
X       &LEFT_MARGIN, &TB_MARGIN + &FONT_SIZE * $scale_factor,
X       &LEFT_MARGIN + $max_x_pos * $scale_factor,
X       &PAGE_TOP - &TB_MARGIN + &FONT_SIZE * $scale_factor;
X   printf "%.1f %.3f translate\n", &LEFT_MARGIN,
X                                   (-$y)*$scale_factor + &TB_MARGIN;
X   printf "%.5f dup scale\n", $scale_factor;
} else {
X   printf "%%%%BoundingBox: %.0f %.0f %.0f %.0f\n",
X       &LEFT_MARGIN, $y + &FONT_SIZE,
X       &LEFT_MARGIN + $max_x_pos,
X       &PAGE_TOP - &TB_MARGIN + &FONT_SIZE;
X   printf "%.1f 0 translate\n", &LEFT_MARGIN;
};
X
# copy temporary file to standard out
while (<tmp>) {
X   print;
}
exit;
X
#------------------------------------------
X
X
sub list_dir
{
X   local($dirname) = shift;
X   local($level) = shift;
X   local(@content);
X   local($file);
X
X   if (($MaxDepth == -1) || ($level < $MaxDepth)) {
X	   opendir(d,$dirname);
X	   @content = sort(grep(!/^\.\.?$/,readdir(d)));
X	   closedir(d);
X	
X	   while ($file = shift(@content)) {
X	      $file = "$dirname/$file";
X	      if ((-d $file) || ((-l $file) && $ForceLinks && !(-f $file))) {
X		 if (-l $file) {     # symbolic link; do not follow these
X		    &emitt(&fmtName($file), $level + 1);
X		 }
X		 else {
X	            &list_dir($file,$level+1);
X	         }
X	      }
X	      elsif ($ListFiles) {
X		 &emitt(&fmtName($file), $level+1);
X	      }
X	   }
X   }
X   &emitt(&fmtName($dirname), $level);
}
X
sub fmtName
{
X	local($file) = @_;
X	local($linkname);
X	local($abslinkname);
X	local($dirname);
X	local($basename);
X
X	$dirname = &dirname($file);
X	$basename = &basename($file);
X	$basename = '/' unless $basename;	# kludge for /
X
X	if (-l $file) {
X		$linkname = readlink $file;
X		$abslinkname = $linkname =~ m#^/# ? $linkname : $dirname . '/' . $linkname;
X		if ($ShowLinkTarget) {
X			return ($basename . " -> " . $linkname . &ft($abslinkname));
X			}
X		else {
X			return ($basename . &ft($file));
X			}
X		}
X	return($basename . &ft($file));
}
X
sub ft
{
X	local($file) = @_;
X	local($link);
X	
X	return '' unless $ListTypes;
X	lstat($file);
X
X	if (-l $file) {
X		$link = readlink($file);
X		$abslink = $link =~ m#^/# ? $link : &dirname($file) . '/' . $link;
X		stat($abslink);
X		return '>' if -d _;
X		return '@' if -e _;
X		return '&';
X		}
X	return '=' if -S _;	# File is an AF_UNIX domain socket.
X	return '|' if -p _;	# File is a named pipe (fifo)
X	return '%' if -c _;	# File is a character device
X	return '#' if -b _;	# File is a block device
X	return '/' if -d _;	# File is directory
X	return '*' if -x _;	# File is executable
X	return '';
}
X
# Uses the following global variables:
#    $y          : current vertical position (initial value = 'top of page')
#    $prev_level : the level reportet last time on emit (init value = 0)
#    @top        : current top position at different levels
#    @bottom     : current bottom position at different levels
#    @pos        : string of positions at different levels
sub emitt
{
X   local($text) = shift;
X   local($level) = shift;
X
X   # Do some substitutions on the $text so that it can be used as a
X   # PostScript string constant.
X   $text =~ s/[\\\(\)]/\\$&/g;
X
X   if ($level == $prev_level) {
X      &write($level,$y,$text,1);
X      $pos[$level] .= " $y";
X      $bottom[$level] = $y;
X      $y -= &FONT_SIZE;
X   }
X   elsif ($level > $prev_level) {
X      &write($level,$y,$text,1);
X      local($i);
X      for ($i=$prev_level+1;$i<$level;$i++) {
X          $pos[$i] = '';
X      }
X      $pos[$level] = "$y";
X      $top[$level] = $y;
X      $bottom[$level] = $y;
X      $y -= &FONT_SIZE;
X   }
X   elsif ($level == ($prev_level - 1)) {
X      local($ypos) = ($top[$level+1] - $bottom[$level+1]) / 2 + 
X                     $bottom[$level+1];
X      &write($level,$ypos,$text,0);
X      &lines($level,$ypos,$pos[$level+1],$text);
X      if ($pos[$level]) {
X         $pos[$level] .= " $ypos";
X         $bottom[$level] = $ypos;
X      }
X      else {
X         $pos[$level] = "$ypos";
X         $top[$level] = $ypos;
X         $bottom[$level] = $ypos;
X      }
X   }
X   else {
X      die "Humm..., jump from level $prev_level to level $level";
X   }
X   $prev_level = $level;
}
X
sub write
{
X   local($x,$y,$text,$pop_stringwidth) = @_;
X   local($max_stringwidth) = &DIR_LEVEL_INDENT * 0.9;
X   $x = $x * &DIR_LEVEL_INDENT;
X   printf "(%s) %.1f %.1f %.2f mws", $text, $x, $y, $max_stringwidth;
X   print " pop" if $pop_stringwidth;
X   print "\n";
X   # Try to estimate the width of the string
X   local($stringwidth) = length($text) * $average_char_width;
X   $x += $stringwidth > $max_stringwidth ? $max_stringwidth : $stringwidth;
X   $max_x_pos = $x if ($x > $max_x_pos);
}
X
sub lines
{
X   local($x,$y,$to,$text) = @_;
X   local(@to) = split(/ /,$to);
X   $x = $x * &DIR_LEVEL_INDENT;
X   $y += &FONT_SIZE/3;
X   printf "%.1f add %.1f m\n",$x+1,$y;
X   printf "[";
X   for (@to) { printf "%.1f\n", $_ + &FONT_SIZE/3; }
X   printf "]\n";
X   printf "{gsave %.1f exch lineto stroke grestore} forall\n",
X          $x + &DIR_LEVEL_INDENT - 4;
}
X
sub dirname	# (@pathnames) -> @dirnames
{
X	local(@paths) = @_;
X	local($pfx);
X
X	for (@paths) {
X		m,^(/?/?)/*,; $pfx=$1; $_=$'; # collect leading slashes
X		s,/+$,,;			# strip trailing slashes
X		s,[^/]+$,,;			# strip basename
X		s,/+$,,;			# strip trailing slashes again
X		length($pfx) || ($pfx='./');	# no null paths
X		$_=$pfx.$_;			# prefix + tail
X		}
X
X	return @paths;
}
X
sub basename	# (@pathnames) -> @basenames
{
X	local(@paths) = @_;
X
X	for (@paths) {
X		s,/+$,,;
X		s,.*/,,;
#		length || ($_='.');
X		}
X
X	return @paths;
}
X
###########################################################################
X	# These next few lines are legal in both Perl and nroff.
X
.00;			# finish .ig
X 
'di			\" finish diversion--previous line must be blank
.nr nl 0-1		\" fake up transition to first page again
.nr % 0			\" start at page 1
';<<'.ex'; #__END__ #### From here on it's a standard manual page #########
.TH PSTREE 1 "$Date: 1993/10/12 11:36:59 $"
.SH NAME
pstree \- produce directory map in PostScript
.SH SYNOPSIS
.B pstree
[
.B \-fFLv
] [
.B \-d
.I max_depth
] [
.I dirname
]
.SH DESCRIPTION
The output from this program is a PostScript program that will produce
a "map" of the directory tree from the current directory and down. If a
.I dirname
is given the directory map from the given directory and down is
produced.  Without any options, only directories or symbolic links
pointing to directories are included in the map.  The output conforms
to Adobe's document structuring conventions (version 3.0), and the EPSF
specification version 3.0.
.SH OPTIONS
.TP 5
\fB\-d\fP \fImax_depth\fP
Descend at most max_depth (a non-negative integer) levels
of directories below the given directory.
.TP 5
.B \-f
Include ordinary files and links to ordinary files in the map.
Without this flag only the overall directory structure is shown.
.TP 5
.B \-F
append the following characters depending on the file type:
.sp
.RS +.6i
.ta 1.2i 1.7i
.nf
=	File is an AF_UNIX domain socket.
|	File is a named pipe (fifo)
%	File is a character device
#	File is a block device
/	File is a directory
*	File is executable
@	File is a symbolic link pointing
X	to a non-directory
>	File is a symbolic link pointing
X	to a directory
&	File is a symbolic link pointing
X	to nowhere
.RE
.DT
.fi
.sp
.TP 5
.B \-l
Show link targets, i.e. where symbolic links are pointing to.
.TP 5
.B \-L
Include links pointing to nowhere in the map.
.TP 5
.B \-v
print version ond standard error and exit.
.SH SEE ALSO
.BR find (1),
.BR ls (1),
.BR perl (1),
.BR postscript (5)
.SH BUGS
The image is not scaled down if it overflows the right edge of the page.
.SH AUTHOR
(C) Gisle Aas, Norwegian Computing Centre (NR), 1991. <Gisle.Aas@nr.no>
.br
with additions of Peter W. Osel, Siemens AG, Munich, 1993.  <pwo@zfe.siemens.de>
.SH NOTES
PostScript is a trademark of Adobe Systems, Incorporated.
Perl is written by Larry Wall and is distributed under the
terms of the GNU General Public License.
.SH BUGS
Symbolic links are never traversed to avoid problems with circular links.
.P
The output should be similar to previous versions of
.BR pstree ,
if you provide the `-l' option.
.ex
X
SHAR_EOF
chmod 0755 pstree ||
echo 'restore of pstree failed'
Wc_c="`wc -c < 'pstree'`"
test 10339 -eq "$Wc_c" ||
	echo 'pstree: original size 10339, current size' "$Wc_c"
fi
exit 0
--
¤ Gisle Aas - Norsk Regnesentral                     <gisle.aas@nr.no>