Отобразить выходной файл дерева дерева, например, команду дерева

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; 

Answer 2

if ($child->is_dir) { 
    printf "%s+- %-${width}s| %d\n", 
     ('| ' x ($indent - 1)), 
     $child_basename . '/', 
     $child_mtime; 
} else { 
    printf "%s%s- %-${width}s| %d\n", 
     ('| ' x ($indent - 1)), 
     ($child eq ($child->dir->children)[-1] ? '\\' : '|'), 
     $child_basename, 
     $child_mtime; 
} 

Кроме того, ASCII строка вызывает рак глаза. Вместо этого используйте правильное значение box drawing characters.