使い方は、こんな感じ。

% perl -Ilib -MDir::Tree -e 'print Dir::Tree->new(shift)->tree_cmd(1)' .
|-- Changes
|-- MANIFEST
|-- Makefile.PL
|-- README
|-- lib
|   |-- Dir
|   |   |-- #Tree.pm#
|   |   |-- Tree.pm
|-- t
|   |-- 00-load.t
|   |-- boilerplate.t
|   |-- pod-coverage.t
|   |-- pod.t
|-- z -> lib

% perl -Ilib -MDir::Tree -e 'print Dir::Tree->new(shift)->yaml' .
--- 
Changes: 
  - 234881026
  - 2673280
  - 33188
  - 1
  - 501
  - 501
  - 0
  - 108
  - 1194438543
  - 1194438543
  - 1194438543
  - 4096
  - 8
MANIFEST: 
...
z: lib

少し解説すると、これはディレクトリーをhash object化するモジュール。キーが

文字列

ファイルはsymlinkで、文字列はそのリンク先

Array Reference (File::stat object)

symlinkやdirectory以外のファイルで、内容はlstat()の結果

Hash Reference (Dir::Hash object)

ディレクトリー

という案配。

ちょっと長い、ので、sourceは最後に追加したけど、キモはdir2href()。ディレクトリーを総なめするプログラムを書くときとかの参考になると思う。

欲しい人がいたら、整理してCPANにうpしとくけど。

#でもこれだとdirectoryのメタデータは消えちゃうんだよね。軽く書くというのを念頭においたからこうなったのだけど。こっちをDir::Tree::Simpleとかにしておいて、きちんとdirectoryのメタデータもpreserveする実装も用意しようか....ご意見募集。

Dan the Perl Monger

package Dir::Tree;
use warnings;
use strict;
our $VERSION = sprintf "%d.%02d", q$Revision: 0.1 $ =~ /(\d+)/g;
use File::stat;

sub new {
    my $class = shift;
    my $dir = shift or return bless {}, $class;
    href2obj( dir2href($dir) );
}

sub dir2href {
    my $dir  = shift;
    my $tree = {};
    opendir my $dh => $dir or die qq{opendir($dir) failed : $!};
    my (@f) = grep !/^\.\.?/, readdir($dh);
    closedir $dh;
    for my $f (@f) {
        my $path = "$dir/$f";
        my @st = CORE::lstat($path) or die qq{lstat("$path") failed : $!};
        $tree->{$f} =
            -l _ ? readlink($path)
          : -d _ ? dir2href($path)
          :        [@st];
    }
    $tree;
}

sub href2obj{
    my $href = shift;
    bless $href, __PACKAGE__;
    for my $f (keys %$href){
        next unless my $type = ref $href->{$f};
        bless $href->{$f}, 'File::stat' if $type eq 'ARRAY';
        href2obj($href->{$f}) if $type eq 'HASH';
    }
    $href;
}

sub tree {
    my $self = shift;
    my $tree = {};
    for my $f ( keys %$self ) {
        $tree->{$f} =
            !ref $self->{$f}          ? $self->{$f}
          : $self->{$f}->isa('ARRAY') ? [ @{ $self->{$f} } ]
          : $self->{$f}->isa('HASH')  ? tree( $self->{$f} )
          :                             die "unknown type : ", ref $self->{$f};
    }
    $tree;
}

sub dump {
    no warnings 'once'; # for DD variable
    require Data::Dumper;
    Data::Dumper->import;
    local $Data::Dumper::Terse = 1;
    my $self = shift;
    Dumper($self);
}

sub yaml {
    my $dump = do{
        eval { require YAML::Syck };
        unless ($@){
            \&YAML::Syck::Dump;
        }else{
            eval { require YAML };
            die $@ if $@;
            \&YAML::Dump;
        }
    };
    my $self = shift;
    $dump->($self->tree);
}

sub json {
    my $dump = do{
        eval { require JSON::XS };
        unless($@){
            warn 'JSON::XS';
            \&JSON::XS::to_json;
        }else{
            eval { require JSON::Syck };
            unless ($@){
                \&JSON::Syck::Dump;
            }else{
                eval { require JSON };
                die $@ if $@;
                \&JSON::objToJson
            }
        }
    };
    my $self = shift;
    $dump->($self->tree);
}

sub tree_cmd{
    no warnings 'uninitialized';
    my $self = shift;
    my $depth = shift;
    my $str = '';
    for my $f (sort keys %$self){
        $str .= '|   ' x ($depth - 1) if $depth > 1;
        $str .= '|-- ' if $depth;
        $str .= $f;
        $str .= " -> " . $self->{$f} unless ref $self->{$f};
        $str .= "\n";
        $str .= $self->{$f}->tree_cmd($depth+1) if ref $self->{$f} eq __PACKAGE__;
    }
    $str;
}

1;
__END__