[comp.lang.perl] pstree

aas@boeygen.nr.no (Gisle Aas) (03/01/90)

This posting includes a perl script which produces a "map" of the
directory tree in PostScript.  Pipe the output from this script to
your favourite PostScript printer (or previewer). Enjoy!

------Cut here-------
#!/usr/bin/perl -P

;# NAME
;#     pstree(1) - produce directory map in PostScript
;#
;# SYNOPSIS
;#     pstree [-f] [dirname]
;#
;# 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 dirname is given the directory map from the given
;#     directory and down is produced. The page size is assumed to be A4.
;#
;# OPTIONS
;#     -f    Include ordinary files in the map. Without this flag only
;#           the overall directory structure is shown.
;#
;# SEE ALSO
;#     ls(1), perl(1), postscript(7)
;#
;# AUTHOR
;#     Gisle Aas, Norwegian Computing Centre, 1990
;#
;# BUGS
;#     Pstree truncates all directory names to 14 characters.
;# 
;# 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.
;#
;# CHANGES
;#     Jan 22 1990, Gisle Aas, NCC
;#        The right way to get rid of "." and ".." from directories is
;#        now used. Proper handling of symbolic links: tree doesn't
;#        follow symbolic links to directories any more.
;#     Jan 23 1990, Gisle Aas, NCC
;#        Added the '-f' option to include ordinary files in dir map.
;#

#define A4_TOP            841
#define A4_RIGHT_EDGE     595
#define TB_MARGIN         40
#define LEFT_MARGIN       60
#define FONT              "AvantGarde-Book"
#define FONT_SIZE         10
#define DIR_LEVEL_INDENT  90

$y = A4_TOP - TB_MARGIN;
$prev_level = 0;

open(tmp,"+>/tmp/tree$$") || die "Can't create temporary file";
unlink("/tmp/tree$$");
select(tmp);

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";

push(@ARGV,'.');
if ($ARGV[0] =~ /^-/) {
   $_ = shift;
   last if (/^--$/);
   if (/f/) {
      $list_files = 1;
   }
   else {
      print STDERR "Usage: tree [-f] [dirname]\n";
      exit(1);
   }
}
&list_dir($ARGV[0],0);

print "showpage\n";
seek(tmp,0,0); # rewind the temporary file

select(STDOUT);
print "%!\n";
if ($y < TB_MARGIN) {
   $page_size = (A4_TOP - 2*TB_MARGIN);
   $scale_factor = (A4_TOP - 2*TB_MARGIN)/((A4_TOP - TB_MARGIN ) - $y);
   printf "%.1f %.3f translate\n", LEFT_MARGIN,
                                   (-$y)*$scale_factor + TB_MARGIN;
   printf "%.5f dup scale\n", $scale_factor;
} else {
   printf "%.1f 0 translate\n", LEFT_MARGIN;
};

;# copy temporary file to standard out
while (<tmp>) {
   print;
}
exit;


sub list_dir
{
   local($dirname) = shift;
   local($level) = shift;
   local(@content);
   opendir(d,$dirname);
   @content = sort(grep(!/^\.\.?$/,readdir(d)));
   closedir(d);
   while ($file = shift(@content)) {
      $file = "$dirname/$file";
      if (-d $file) {
	 if (-l $file) {     # symbolic link; do not follow these
	    &emitt(substr($file,rindex($file,'/')+1,14) . " -> " .
		  readlink($file), $level + 1);
	 }
	 else {
            &list_dir($file,$level+1);
         }
      }
      elsif ($list_files) {
	 &emitt(substr($file,rindex($file,'/')+1,14), $level+1);
      }
   }
   &emitt(substr($dirname,rindex($dirname,'/')+1,14), $level);
}

;# 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
{
   local($text) = shift;
   local($level) = shift;

   ;# Do some substitutions on the $text so that it can be used as a
   ;# PostScript string constant.
   $text =~ s/\\/\\134/g;
   $text =~ s/\(/\\050/g;
   $text =~ s/\)/\\051/g;

   if ($level == $prev_level) {
      &write($level,$y,$text);
      $pos[$level] .= " $y";
      $bottom[$level] = $y;
      $y -= FONT_SIZE;
   }
   elsif ($level > $prev_level) {
      &write($level,$y,$text);
      local($i);
      for ($i=$prev_level+1;$i<$level;$i++) {
          $pos[$i] = '';
      }
      $pos[$level] = "$y";
      $top[$level] = $y;
      $bottom[$level] = $y;
      $y -= FONT_SIZE;
   }
   elsif ($level == ($prev_level - 1)) {
      local($ypos) = ($top[$level+1] - $bottom[$level+1]) / 2 + 
                     $bottom[$level+1];
      &write($level,$ypos,$text);
      &lines($level,$ypos,$pos[$level+1],$text);
      if ($pos[$level]) {
         $pos[$level] .= " $ypos";
         $bottom[$level] = $ypos;
      }
      else {
         $pos[$level] = "$ypos";
         $top[$level] = $ypos;
         $bottom[$level] = $ypos;
      }
   }
   else {
      die "Humm..., jump from level $prev_level to level $level";
   }
   $prev_level = $level;
}

sub write
{
   local($x,$y,$text) = @_;
   $x = $x * DIR_LEVEL_INDENT;
   printf "%.f %.f m(%s)s\n", $x, $y, $text;
}

sub lines
{
   local($x,$y,$to,$text) = @_;
   local(@to) = split(/ /,$to);
   $x = $x * DIR_LEVEL_INDENT;
   $y += FONT_SIZE/3;
   printf "($text) stringwidth pop %.1f add %.1f m\n",$x+1,$y;
   printf "[";
   for (@to) { printf " %.1f", $_ + FONT_SIZE/3; }
   printf "]\n";
   printf "{gsave %.1f exch lineto stroke grestore} forall\n",
          $x+DIR_LEVEL_INDENT-4;
}
------Cut here-------
--
-----------------------+------------------------------------------------
Gisle Aas              !  email: Gisle.Aas@nr.uninett
Norsk Regnesentral     !  arpa:  Gisle.Aas%nr.uninett@tor.nta.no
Tlf: (02)453561        !  snail: Postboks 114 Blindern, N-0314 OSLO 3
-----------------------+------------------------------------------------