perl - 像树命令一样显示目录树输出

Question

我仍然玩得很好 Path::Class 模块以遍历目录。我写了一段代码，但我对输出的显示不满意。我的目录树输出不像 tree 的输出那样简洁和优雅。命令。 :-(

到目前为止我的代码:

use strict;
use warnings;
use Path::Class;

my $dir = Path::Class::Dir->new('D:\dev\pl\testdir');

my $max_depth = $dir->traverse(sub {
  my ($child, $cont, $depth) = @_;
  return max($cont->($depth + 1), $depth);
}, 0);
sub max { my $max = 0; for (@_) { $max = $_ if $_ > $max } $max };

# Print header
printf "%-43s|%s\n", " Name", " mtime";
printf "%-43s|%s\n", '-' x 43, '-' x 11;

$dir->traverse(sub {
  my ($child, $cont, $indent) = @_;
  my $child_basename = $child->basename;
  my $child_stat     = $child->stat();
  my $child_mtime    = $child_stat->[9];
  $indent //= 0;
  my $width = 40 - 3 * ($indent - 1);

  #print "DEBUG: Scanning $child\n";

  if ($indent == 0) {
    print "ROOT: ", $child, "\n";
  }
  else {
    if ($child->is_dir) {
        print '   ' x ($indent - 1), '+- ';
        printf "%-${width}s| %d", $child_basename . '/', $child_mtime;
        print "\n";
    } else {
        print '   ' x ($indent - 1), '|- ';
        printf "%-${width}s| %d", $child_basename, $child_mtime;
        print "\n";
    }
  }

  $cont->($indent + 1);
});

还有我的 错了输出是:

Name                                       | mtime
-------------------------------------------|-----------
ROOT: D:\dev\pl\testdir
+- Path-Class-0.25/                        | 1337013211
   |- Build.PL                             | 1329360988
   |- Changes                              | 1329360988
   |- dist.ini                             | 1329360988
   |- INSTALL                              | 1329360988
   +- lib/                                 | 1337013211
      +- Path/                             | 1337013211
         +- Class/                         | 1337013211
            |- Dir.pm                      | 1329360988
            |- Entity.pm                   | 1329360988
            |- File.pm                     | 1329360988
         |- Class.pm                       | 1329360988
   |- LICENSE                              | 1329360988
   |- Makefile.PL                          | 1329360988
   |- MANIFEST                             | 1329360988
   |- META.yml                             | 1329360988
   |- README                               | 1329360988
   |- SIGNATURE                            | 1329360988
   +- t/                                   | 1337013211
      |- 01-basic.t                        | 1329360988
      |- 02-foreign.t                      | 1329360988
      |- 03-filesystem.t                   | 1329360988
      |- 04-subclass.t                     | 1329360988
      |- 05-traverse.t                     | 1329360988
      |- author-critic.t                   | 1329360988

正确 输出(也更好看)应该是:

Name                                       | mtime
-------------------------------------------|-----------
ROOT: D:\dev\pl\testdir
+- Path-Class-0.25/                        | 1337013211
   |- Build.PL                             | 1329360988
   |- Changes                              | 1329360988
   |- dist.ini                             | 1329360988
   |- INSTALL                              | 1329360988
   +- lib/                                 | 1337013211
   |  +- Path/                             | 1337013211
   |     +- Class/                         | 1337013211
   |     |  |- Dir.pm                      | 1329360988
   |     |  |- Entity.pm                   | 1329360988
   |     |  |- File.pm                     | 1329360988
   |     \- Class.pm                       | 1329360988
   |- LICENSE                              | 1329360988
   |- Makefile.PL                          | 1329360988
   |- MANIFEST                             | 1329360988
   |- META.yml                             | 1329360988
   |- README                               | 1329360988
   |- SIGNATURE                            | 1329360988
   \- t/                                   | 1337013211
      |- 01-basic.t                        | 1329360988
      |- 02-foreign.t                      | 1329360988
      |- 03-filesystem.t                   | 1329360988
      |- 04-subclass.t                     | 1329360988
      |- 05-traverse.t                     | 1329360988
      \- author-critic.t                   | 1329360988

您能否改进或更正我的代码？

非常感谢您的帮助!

问候，
斯科蒂

Answer 1

我下面的代码不是花哨的解决方案，但它可以满足您的需求>>

#!/usr/bin/perl

use strict;
use warnings;
use Path::Class;

my $dir = Path::Class::Dir->new('D:\dev\pl\testdir');

my $max_depth = $dir->traverse(sub {
  my ($child, $cont, $depth) = @_;
  return max($cont->($depth + 1), $depth);
}, 0);

sub max { my $max = 0; for (@_) { $max = $_ if $_ > $max } $max };

my @output = ( sprintf("%-43s|%s", " Name", " mtime"),
               sprintf("%-43s|%s", '-' x 43, '-' x 11) );

my @tree = (0, 0);
my $last_indent = 0;

$dir->traverse( sub {
  my ($child, $cont, $indent) = @_;
  my $child_basename = $child->basename;
  my $child_stat     = $child->stat();
  my $child_mtime    = $child_stat->[9];

  $indent = 1 if (!defined $indent);
  my $width = 40 - 3 * ($indent - 1);

  if ($last_indent != $indent) {
    if ($last_indent > ($indent + 1)) {
      for my $level (($indent + 1)..($last_indent - 1)) {
        $output[$#output - $_] = 
          substr($output[$#output - $_], 0, 3 * ($level - 1)) . ' ' .
          substr($output[$#output - $_], 3 * ($level - 1) + 1, 65535) 
            for (0..$tree[$level] - 1);
      }
      delete $tree[$_] for $indent..$last_indent;
    }
    $tree[$indent] = 0;
    $last_indent = $indent;
  }

  if ($child->is_dir) {
    push @output, sprintf("%s+- %-${width}s| %d",
      ('|  ' x ($indent - 1)), $child_basename . '/', $child_mtime);
    $tree[$indent] = 0;
  }
  else {
    push @output, sprintf("%s%s- %-${width}s| %d", ('|  ' x ($indent - 1)),
      ($child eq ($child->dir->children)[-1] ? '\\' : '|' ),
      $child_basename, $child_mtime);
    $tree[$indent]++;
  }
  $tree[$_]++ for (1..$indent - 1);

  $cont->($indent + 1);
});

for my $level (1..$last_indent - 1) {
  $output[$#output - $_] = 
    substr($output[$#output - $_], 0, 3 * ($level - 1)) . ' ' .
    substr($output[$#output - $_], 3 * ($level - 1) + 1, 65535)
      for (0..$tree[$level] - 1);
}

print "$_\n" for @output;