作者: dune
日時: 2003/5/11(23:18)
極悪です。
Let's 野ぷ野ぷって言ってももう古くて嫌になったな。

Windows 付属の tree.exe の出力を真似をするモジュールです。
UNIX-Like Tools に付属の tree.com(中身は perl スクリプト)を
参考にしてます。Text::Thread でも同じようなことができるらしい。

use Tree; して tree() を呼び出すとカレントディレクトリ下のフ
ァイルのツリーを表示します。



モジュール Tree.pm

package Tree;
use strict;

BEGIN{
    use Exporter;
    use vars qw($VERSION @ISA @EXPORT @EXPORT_VAR @EXPORT_SUB);
    ($VERSION) = q($Revision: 1.3 $) =~ m/\s([\d.]+)\s/;    
    @ISA    = qw(Exporter);
    @EXPORT_VAR = qw();
    @EXPORT_SUB = qw(tree);
    @EXPORT = (@EXPORT_VAR,@EXPORT_SUB)
}

use vars qw($func $h $hend $v $vend);

sub tree{
    (my $root   = shift || ".") =~ s|\/?$|/|;
    local $func = shift || sub{ print "$_[0]$_[2]\n" };
    my $hv      = shift ||  [
                            "\x84\xA5\x84\x9F", # "+-"
                            "\x84\xA4\x84\x9F", # "\-"
                            "\x84\xA0\x20\x20", # "| "
                            "\x20\x20\x20\x20", # "  "
                            ];
    local($h,$hend,$v,$vend)    = @{$hv};

    sub _tree{
        my $root        = shift || "./";
        my $head        = shift;
        my $continue    = shift;
        my @tree;
    
        my(@dir,@file);
        opendir(DIR,$root) or die qq($root : $!\n);
        my @file    = sort readdir DIR;
        closedir DIR;
        
        my @dir;
        while(my $file = shift @file){
            next if $file =~ m/^\.+$/;
            if(-d $root.$file){
                push(@dir,"$file/");
            }else{
                my $headf   = $head.((@file || @dir) ? $h : $hend);
                push(@tree,&{$func}($headf,$root,$file));
            }
        }
        
        while(my $dir = shift @dir){
            my $headf   = $head.(@dir ? $h : $hend);
            push(@tree,&{$func}($headf,$root,$dir));
            my $headd   = $head.(@dir ? $v : $vend);
            push(@tree,_tree("$root$dir",$headd));
        }

        return @tree;
    };

    return(&{$func}(undef,undef,$root),_tree $root);
}

1;;;



使用例

D:%perl -MTree -etree
./
├─CGI.bench.t
├─CGI.pm
├─CGI.t
├─CGI2.pm
├─MG.pm
├─MG.t
├─Tree.pm
├─Tree.t
├─Tree.t.bak
├─mg5.pm
├─mg5.t
├─Config/
│  └─Tiny.pm
└─Wiki/
    ├─AutoLink.pm
    ├─AutoLink.t
    ├─Text2html.pm
    ├─Text2html.t
    └─test/
        ├─include.txt
        └─main.txt

D:%



関数も渡せるので表示をカスタマイズできます。

use Tree;
tree(   $ARGV[0],

        sub{    my($hv,$dir,$file)  = @_;
                my $path    = $dir.$file;
                if(-d $path){
                    print $hv,$file,"\n";
                }else{
                    my $size    = ((500 + -s $path) >> 10) || 1;
                    my $time    = localtime((stat $path)[9]);
                    printf("%-28s\t%6d KB $time\n",$hv.$file,$size);
                }
            },

        [' +--',' \--',' |  ','    ']
    );



D:%perl Tree.t
./
 +--CGI.bench.t                      1 KB Sat May 10 19:32:51 2003
 +--CGI.pm                           7 KB Sat May 10 23:54:01 2003
 +--CGI.t                            1 KB Sat May 10 23:54:01 2003
 +--CGI2.pm                          3 KB Sat May 10 23:54:01 2003
 +--MG.pm                           50 KB Sat May 10 23:54:01 2003
 +--MG.t                             1 KB Sat May 10 23:54:01 2003
 +--Tree.pm                          2 KB Sun May 11 22:29:33 2003
 +--Tree.t                           1 KB Sun May 11 22:39:53 2003
 +--Tree.t.bak                       1 KB Sun May 11 22:23:55 2003
 +--mg5.pm                          29 KB Sat May 10 19:32:59 2003
 +--mg5.t                            1 KB Sat May 10 19:33:25 2003
 +--Config/
 |   \--Tiny.pm                      2 KB Mon May  5 13:58:51 2003
 \--Wiki/
     +--AutoLink.pm                  5 KB Sat May 10 23:54:56 2003
     +--AutoLink.t                   3 KB Sat May 10 23:54:56 2003
     +--Text2html.pm                10 KB Sat May 10 23:54:56 2003
     +--Text2html.t                  1 KB Sat May 10 23:54:56 2003
     \--test/
         +--include.txt              1 KB Sun Apr 20 15:18:22 2003
         \--main.txt                 1 KB Sun Apr 20 14:15:36 2003

D:%
--
FZH01112@..., http://hpcgi1.nifty.com/dune/gwiki.pl