Perl学习笔记（一）文件迁移脚本

动机

到新公司，开始看source code了，用eclipse看code需要在同一个文件夹下，所以就做一个扫描所有.cpp和.h的脚本，然后全复制到一个目录下。

完整代码

https://github.com/MoYummy/Perl/blob/master/1/extract.pl

#!/usr/bin/perl -w

use strict;
use warnings;

use Cwd;
use Data::Dumper;
use File::Basename;
use File::Copy;
use File::Path;

sub get_files {
    my $dir = shift;
    opendir DIR, $dir or die "Error: open $dir";
    my @items = map { "$dir/$_" } grep { !/^\.$/ && !/^\.\.$/ } readdir(DIR);
    closedir DIR;
    return [@items];
}

sub filter_folder {
    my $items = shift;
    my @folders = grep { -d } @$items;
    return [@folders];
}

sub filter_file {
    my $items = shift;
    my @files = grep { -f } @$items;
    my @srcs = grep { /^.*\.cpp$/ || /^.*\.h$/ } @files;
    return [@srcs];
}

# copy a directory tree
sub copy_folder {
    my $dir = shift;
    my $dest = shift;
    print "\n\nCopying Dir: " . $dir . " to " . $dest . "\n";

    mkdir $dest if not -e $dest;

    my $items = get_files($dir);

    my $files = filter_file($items);
    copy_files($files, $dest);

    my $folders = filter_folder($items);
    for my $folder (@$folders) {
        my $folder_dest = $dest . "/" . basename($folder);
        copy_folder($folder, $folder_dest);
    }
}

sub copy_files {
    my $files = shift;
    my $dest = shift;
    print "Copying files to " . $dest . "\n";
    #print Dumper($files);
    for my $file (@$files) {
        my $newfile = $dest . "/" . basename($file);
        copy($file, $newfile);
    }
}

# copy all files to a single directory
sub copy_folder_s {
    my $dir = shift;
    my $dest = shift;
    print "\n\nCopying Dir: " . $dir . " to " . $dest . "\n";

    mkdir $dest if not -e $dest;

    my $items = get_files($dir);

    my $files = filter_file($items);
    copy_files_s($files, $dest);

    my $folders = filter_folder($items);
    for my $folder (@$folders) {
        copy_folder_s($folder, $dest);
    }
}

sub copy_files_s {
    my $files = shift;
    my $dest = shift;
    print "Copying files to " . $dest . "\n";
    #print Dumper($files);
    for my $file (@$files) {
        my $newfile = $dest . "/" . basename($file);
        if (-e $newfile) {
            my @label = split "/", dirname($file);
            shift @label;
            my $label = join ".", @label;
            $newfile = $newfile . "#" . $label;
        }

        print $newfile . "\n";
        copy($file, $newfile);
    }
}

my $root = getcwd;
my $newdir = $root . "_new";

rmtree $newdir if -e $newdir;
copy_folder_s($root, $newdir);

1;

代码思路

写了两套，copy_folder和copy_folder_s，走的是copy_folder_s。copy_folder不同的地方是，它不是存到一个目录，所以不打破目录结构；copy_folder_s存到同一目录，会出现重名问题。

这里用的是递归。对每个目录调用copy_folder_s，先扫一遍，然后处理普通文件，对每个子目录，递归调用copy_folder_s。如果出现重名，第二个开始会带一个label。

P.S.用getopts改进为带参数运行。
P.S.引入log，方便monitor和debug。

文件操作

sub get_files {
    my $dir = shift;
    opendir DIR, $dir or die "Error: open $dir";
    my @items = map { "$dir/$_" } grep { !/^\.$/ && !/^\.\.$/ } readdir(DIR);
    closedir DIR;
    return [@items];
}

open or die或者opendir or die，是典型的Perl 风格，也是我特别喜欢Perl的一点。:)
readdir扫一下目录所有的文件和文件夹，grep过滤掉.和..，也就是自己和父目录，然后给每个map成绝对路径。
多说一句，用[@items]而不是\@items。

组建label

        if (-e $newfile) {
            my @label = split "/", dirname($file);
            shift @label;
            my $label = join ".", @label;
            $newfile = $newfile . "#" . $label;
        }

传进来的是文件所在的绝对路径（window里，C:/xxx/yyy/zzz，linux里，/xxx/yyy/zzz），split后存在一个array里，windows里第一个是C:，linux里第一个是空，直接shift掉，剩下用.来连接。新文件名类似a.cpp#xxx.yyy.zzz。

调试

用Data::Dumper，然后print Dumper(xxx)，可以打印所有的类型，scalar、array、ref或者层层嵌套，和ToString()异曲同工。

结语

第一次写，也比较简单，没啥好多说的。:)