home *** CD-ROM | disk | FTP | other *** search
/ InfoMagic Source Code 1993 July / THE_SOURCE_CODE_CD_ROM.iso / languages / perl / scripts-osu / pstree < prev    next >
Encoding:
Internet Message Format  |  1990-02-28  |  6.1 KB
  1. Path: tut.cis.ohio-state.edu!cica!sol.ctr.columbia.edu!samsung!uunet!mcsun!sunic!nuug!ulrik!ulrik!aas
  2. From: aas@boeygen.nr.no (Gisle Aas)
  3. Newsgroups: comp.lang.perl
  4. Subject: pstree(1)
  5. Message-ID: <AAS.90Mar1145200@boeygen.nr.no>
  6. Date: 1 Mar 90 13:52:00 GMT
  7. Sender: news@ulrik.uio.no (USENET News System)
  8. Distribution: comp.lang.perl
  9. Organization: aas%nr.uninett@tor.nta.no
  10. Lines: 210
  11.  
  12. This posting includes a perl script which produces a "map" of the
  13. directory tree in PostScript.  Pipe the output from this script to
  14. your favourite PostScript printer (or previewer). Enjoy!
  15.  
  16. ------Cut here-------
  17. #!/usr/bin/perl -P
  18.  
  19. ;# NAME
  20. ;#     pstree(1) - produce directory map in PostScript
  21. ;#
  22. ;# SYNOPSIS
  23. ;#     pstree [-f] [dirname]
  24. ;#
  25. ;# DESCRIPTION
  26. ;#     The output from this program is a PostScript program that will
  27. ;#     produce a "map" of the directory tree from the current directory
  28. ;#     and down. If a dirname is given the directory map from the given
  29. ;#     directory and down is produced. The page size is assumed to be A4.
  30. ;#
  31. ;# OPTIONS
  32. ;#     -f    Include ordinary files in the map. Without this flag only
  33. ;#           the overall directory structure is shown.
  34. ;#
  35. ;# SEE ALSO
  36. ;#     ls(1), perl(1), postscript(7)
  37. ;#
  38. ;# AUTHOR
  39. ;#     Gisle Aas, Norwegian Computing Centre, 1990
  40. ;#
  41. ;# BUGS
  42. ;#     Pstree truncates all directory names to 14 characters.
  43. ;# 
  44. ;# NOTES
  45. ;#     PostScript is a trademark of Adobe Systems, Incorporated.
  46. ;#     Perl is written by Larry Wall and is distributed under the
  47. ;#     terms of the GNU General Public License.
  48. ;#
  49. ;# CHANGES
  50. ;#     Jan 22 1990, Gisle Aas, NCC
  51. ;#        The right way to get rid of "." and ".." from directories is
  52. ;#        now used. Proper handling of symbolic links: tree doesn't
  53. ;#        follow symbolic links to directories any more.
  54. ;#     Jan 23 1990, Gisle Aas, NCC
  55. ;#        Added the '-f' option to include ordinary files in dir map.
  56. ;#
  57.  
  58. #define A4_TOP            841
  59. #define A4_RIGHT_EDGE     595
  60. #define TB_MARGIN         40
  61. #define LEFT_MARGIN       60
  62. #define FONT              "AvantGarde-Book"
  63. #define FONT_SIZE         10
  64. #define DIR_LEVEL_INDENT  90
  65.  
  66. $y = A4_TOP - TB_MARGIN;
  67. $prev_level = 0;
  68.  
  69. open(tmp,"+>/tmp/tree$$") || die "Can't create temporary file";
  70. unlink("/tmp/tree$$");
  71. select(tmp);
  72.  
  73. print  "/s {show} bind def\n";
  74. print  "/m {moveto} bind def\n";
  75. printf "/%s findfont %d scalefont setfont\n",FONT,FONT_SIZE;
  76. print  "0.1 setlinewidth\n";
  77.  
  78. push(@ARGV,'.');
  79. if ($ARGV[0] =~ /^-/) {
  80.    $_ = shift;
  81.    last if (/^--$/);
  82.    if (/f/) {
  83.       $list_files = 1;
  84.    }
  85.    else {
  86.       print STDERR "Usage: tree [-f] [dirname]\n";
  87.       exit(1);
  88.    }
  89. }
  90. &list_dir($ARGV[0],0);
  91.  
  92. print "showpage\n";
  93. seek(tmp,0,0); # rewind the temporary file
  94.  
  95. select(STDOUT);
  96. print "%!\n";
  97. if ($y < TB_MARGIN) {
  98.    $page_size = (A4_TOP - 2*TB_MARGIN);
  99.    $scale_factor = (A4_TOP - 2*TB_MARGIN)/((A4_TOP - TB_MARGIN ) - $y);
  100.    printf "%.1f %.3f translate\n", LEFT_MARGIN,
  101.                                    (-$y)*$scale_factor + TB_MARGIN;
  102.    printf "%.5f dup scale\n", $scale_factor;
  103. } else {
  104.    printf "%.1f 0 translate\n", LEFT_MARGIN;
  105. };
  106.  
  107. ;# copy temporary file to standard out
  108. while (<tmp>) {
  109.    print;
  110. }
  111. exit;
  112.  
  113.  
  114. sub list_dir
  115. {
  116.    local($dirname) = shift;
  117.    local($level) = shift;
  118.    local(@content);
  119.    opendir(d,$dirname);
  120.    @content = sort(grep(!/^\.\.?$/,readdir(d)));
  121.    closedir(d);
  122.    while ($file = shift(@content)) {
  123.       $file = "$dirname/$file";
  124.       if (-d $file) {
  125.      if (-l $file) {     # symbolic link; do not follow these
  126.         &emitt(substr($file,rindex($file,'/')+1,14) . " -> " .
  127.           readlink($file), $level + 1);
  128.      }
  129.      else {
  130.             &list_dir($file,$level+1);
  131.          }
  132.       }
  133.       elsif ($list_files) {
  134.      &emitt(substr($file,rindex($file,'/')+1,14), $level+1);
  135.       }
  136.    }
  137.    &emitt(substr($dirname,rindex($dirname,'/')+1,14), $level);
  138. }
  139.  
  140. ;# Uses the following global variables:
  141. ;#    $y          : current vertical position (initial value = 'top of page')
  142. ;#    $prev_level : the level reportet last time on emit (init value = 0)
  143. ;#    @top        : current top position at different levels
  144. ;#    @bottom     : current bottom position at different levels
  145. ;#    @pos        : string of positions at different levels
  146. sub emitt
  147. {
  148.    local($text) = shift;
  149.    local($level) = shift;
  150.  
  151.    ;# Do some substitutions on the $text so that it can be used as a
  152.    ;# PostScript string constant.
  153.    $text =~ s/\\/\\134/g;
  154.    $text =~ s/\(/\\050/g;
  155.    $text =~ s/\)/\\051/g;
  156.  
  157.    if ($level == $prev_level) {
  158.       &write($level,$y,$text);
  159.       $pos[$level] .= " $y";
  160.       $bottom[$level] = $y;
  161.       $y -= FONT_SIZE;
  162.    }
  163.    elsif ($level > $prev_level) {
  164.       &write($level,$y,$text);
  165.       local($i);
  166.       for ($i=$prev_level+1;$i<$level;$i++) {
  167.           $pos[$i] = '';
  168.       }
  169.       $pos[$level] = "$y";
  170.       $top[$level] = $y;
  171.       $bottom[$level] = $y;
  172.       $y -= FONT_SIZE;
  173.    }
  174.    elsif ($level == ($prev_level - 1)) {
  175.       local($ypos) = ($top[$level+1] - $bottom[$level+1]) / 2 + 
  176.                      $bottom[$level+1];
  177.       &write($level,$ypos,$text);
  178.       &lines($level,$ypos,$pos[$level+1],$text);
  179.       if ($pos[$level]) {
  180.          $pos[$level] .= " $ypos";
  181.          $bottom[$level] = $ypos;
  182.       }
  183.       else {
  184.          $pos[$level] = "$ypos";
  185.          $top[$level] = $ypos;
  186.          $bottom[$level] = $ypos;
  187.       }
  188.    }
  189.    else {
  190.       die "Humm..., jump from level $prev_level to level $level";
  191.    }
  192.    $prev_level = $level;
  193. }
  194.  
  195. sub write
  196. {
  197.    local($x,$y,$text) = @_;
  198.    $x = $x * DIR_LEVEL_INDENT;
  199.    printf "%.f %.f m(%s)s\n", $x, $y, $text;
  200. }
  201.  
  202. sub lines
  203. {
  204.    local($x,$y,$to,$text) = @_;
  205.    local(@to) = split(/ /,$to);
  206.    $x = $x * DIR_LEVEL_INDENT;
  207.    $y += FONT_SIZE/3;
  208.    printf "($text) stringwidth pop %.1f add %.1f m\n",$x+1,$y;
  209.    printf "[";
  210.    for (@to) { printf " %.1f", $_ + FONT_SIZE/3; }
  211.    printf "]\n";
  212.    printf "{gsave %.1f exch lineto stroke grestore} forall\n",
  213.           $x+DIR_LEVEL_INDENT-4;
  214. }
  215. ------Cut here-------
  216. --
  217. -----------------------+------------------------------------------------
  218. Gisle Aas              !  email: Gisle.Aas@nr.uninett
  219. Norsk Regnesentral     !  arpa:  Gisle.Aas%nr.uninett@tor.nta.no
  220. Tlf: (02)453561        !  snail: Postboks 114 Blindern, N-0314 OSLO 3
  221. -----------------------+------------------------------------------------
  222.  
  223.