File: pretty_print_a_directory.pl

package info (click to toggle)
libfile-util-perl 4.201720-2
  • links: PTS, VCS
  • area: main
  • in suites: bookworm, forky, sid, trixie
  • size: 840 kB
  • sloc: perl: 4,353; makefile: 2
file content (87 lines) | stat: -rw-r--r-- 1,995 bytes parent folder | download | duplicates (4)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
# ABSTRACT: manually pretty print a directory, recursively

# This example shows a manual walker and descender.  It is inferior
# to the prety_print_a_directory_using_callbacks* scripts, and takes
# more time/effort/code.  This example script is limited: it can
# only walk single top-level directories-- moral of the story: using
# callbacks is the clearly superior option.
#
# This example is here less for exhibition as a good example, and
# much more for exhibition about how not-to-walk directories.  Take
# a look at the other examples instead ;-)

# set this to the name of the directory to pretty-print
my $treetrunk = '/tmp';

use strict;
use warnings;

use File::Util qw( NL );
my $indent = '';
my $ftl    = File::Util->new();
my $opts   = {
   with_paths    => 1,
   sl_after_dirs => 1,
   no_fsdots     => 1,
   as_ref        => 1,
   onfail        => 'zero'
};

my $filetree  = {};
my( $subdirs, $sfiles ) = $ftl->list_dir( $treetrunk => $opts );

$filetree = [{
   $treetrunk => [ sort { uc $a cmp uc $b } @$subdirs, @$sfiles ]
}];

descend( $filetree->[0]{ $treetrunk }, scalar @$subdirs );

walk( @$filetree );

exit;

sub descend {

   my( $parent, $dirnum ) = @_;

   for ( my $i = 0; $i < $dirnum; ++$i ) {

      my $current = $parent->[ $i ];

      next unless -d $current;

      my( $subdirs, $sfiles ) = $ftl->list_dir( $current => $opts );

      map { $_ = $ftl->strip_path( $_ ) } @$sfiles;

      splice @$parent, $i, 1,
      { $current => [ sort { uc $a cmp uc $b } @$subdirs, @$sfiles ] };

      descend( $parent->[$i]{ $current }, scalar @$subdirs );
   }

   return $parent;
}

sub walk {

   my $dir = shift @_;

   foreach ( @{ [ %$dir ]->[1] } ) {

      my $mem = $_;

      if ( ref $mem eq 'HASH' ) {

         print $indent . $ftl->strip_path([ %$mem ]->[0]) . '/', NL;

         $indent .= ' ' x 3; # increase indent

         walk( $mem );

         $indent = substr( $indent, 3 ); # decrease indent

      } else { print $indent . $mem, NL }
   }
}