yet another tree.pl perl script

grampus

#!/usr/bin/perl

if ( $#ARGV != 0 ){
        printf(STDERR "Usage: perl treedir.pl directory\n");
        exit(0);
}

glob $vtab="|";
glob @fmt=();

glob @dirs=();

search_dir($ARGV[0]);

sub listdir{
        my ($dirname) = @_;
       
        opendir(DIR_HANDLE, $dirname);
        my (@dirlist) = readdir(DIR_HANDLE);
       
        shift(@dirlist);
        shift(@dirlist);

        closedir(DIR_HANDLE);
        return @dirlist;
}

sub getPath{
        return join("/",@dirs);
}

sub search_dir{
        my ($dirnm)=@_;
       
        push(@dirs,$dirnm); # cd $dirnm
        my (@entries)=listdir(getPath());
        my ($count)=$#entries;

        foreach $file (@entries) {
               
                if (0==$count){
                        $vtab="\\";
                }

                display($file);
                $vtab="|";
               
                if (-d getPath()."/".$file){

                        if($count==0){
                                push(@fmt,"\t");
                        }
                        else {
                                push(@fmt,"|\t");
                        }

                        search_dir($file);
                }
               
                $count--;
        }

        pop(@fmt);
        pop(@dirs); # cd ..
}

sub display{
        my ($entry)=@_;
        my ($formats)=join("",@fmt);
       
        print $formats.$vtab."-----".$entry."\n";
}


windows linux 下都可使用。
查找的目录级非常大，足够实用。

LYOO

不错！执行效率明显比shell脚本强。

KornLee

对,perl无所不能!尤其对数据结构的处理是shell无法比拟的!由于shell要经常调用系统命令,效率当然要打折扣!
LY,你的PERL学得怎么样啦~~,;)

fwt11

请问这几句
glob $vtab="|";
glob @fmt=();

glob @dirs=();
是干什么的，尤其glob $vtab="|";


谢谢了

crook

sub listdir{
my ($dirname) = @_;

opendir(DIR_HANDLE, $dirname);
my (@dirlist) = readdir(DIR_HANDLE);

shift(@dirlist);
shift(@dirlist);

closedir(DIR_HANDLE);
return @dirlist;
}

上面两个连续的shift是不是想删除. 和..(当前目录和上一目录)??
实际上readdir得到的目录数组的顺序不一定, 所以上面的两个shift反而删除了其他目录.
结果导致无穷的递归, 怎么解决? readdir有没有参数来确定目录顺序??

perl新手, 在欣赏区看到的这个脚本...不好意思翻出这么老的帖子= =!

crook

sub listdir{
        my ($dirname) = @_;

        opendir(DIR_HANDLE, $dirname);
        my (@dirlist) = readdir(DIR_HANDLE);
        my ($number) = 0;

        foreach $file (@dirlist) {
            next if $file =~ /^\.*.$/;  # Skip . and .. directory
            $dirlist[$number] = $file;
            $number += 1;

        }

        my (@directory) = @dirlist[0..($number-1)];     # Get subarray
        closedir(DIR_HANDLE);
        return @directory;
}

列出当前目录的函数做了些改动, 删除了.和..两个目录, 也就说@dirlist的大小减2形成新的子数组@directory
这样就没有问题了 不过感觉办法很笨, 关键问题是:

删除某些数组元素后, 如何得到新的数组???

大家有没有其他的办法??

huan

原来是老帖
我说怎么用glob关键字。。。

实际上不会有问题
从glob的角度（至少
. ..会被先读入

不过要删除这两个目录
也很简单

2. [0 No.2030 huan@huan /tmp/test]$ ls -a
3. ./  ../  a  .a  b  .b
5. [0 No.2031 huan@huan /tmp/test]$ perl -lwe ' opendir(DH, "./"); /^\.\.?$/ or push @arr,$_ while $_ = readdir DH; ; print "@arr" '
6. a .a b .b
8. [0 No.2032 huan@huan /tmp/test]$ perl -lwe ' opendir(DH, "./"); @arr = readdir DH; @arr = grep (! /^\.\.?$/, @arr); print "@arr" '
9. a .a b .b
11. [0 No.2033 huan@huan /tmp/test]$

复制代码

不知道我没有理解楼上的意思

crook

楼上的方法不错, 赞一个

[ray@localhost perl]$ perl -lwe ' opendir(DH, "./"); @arr = readdir DH; print "@arr" '
.quickill.pl.swp hello.pl .. test.pl .hello.pl.swp readdir.pl .readdir.pl.swp grep .hello.pl.swo buggy.pl max.pl quickill.pl . tree.pl grep.pl hash.pl

我机器上运行的结果就是这样, .和..目录不在头两个

huan

请问是什么locale

晨想

哪里提到 locale 了？