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

动机

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

完整代码

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

#!/usr/bin/perl -wuse 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 treesub 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 directorysub 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()异曲同工。

结语

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