用perl的moose写了个备份文件的小工具

功能与XP系统的xcopy命令相似

#use Acme::PerlTidy;

package Backup;
use Moose;
use AnyEvent;
use File::Xcopy qw(xcopy find_files);

has from_dir => ( is => 'rw' );
has to_dir => ( is => 'rw' );
has regex => ( is => 'rw', isa => 'Str', required => 1, default => '.*' );

#&menu( $prompt, @a);
sub Menu {
    my $self = shift;
    print '', "\n";
    my $prompt = 'which will you chose:';
    my @array = qw(FindFiles Backup Exit);
    return '' unless @array;
    print " $_:$array[$_]\n" for ( 0 .. $#array );

    my $cv = AnyEvent->condvar;
    my $w;
    $w = AnyEvent->idle(
        cb => sub {
            print $prompt;
            my $n = <>;
            if ( $n =~ /^\d+$/ and defined $array[$n] ) {
                print "You chose:$array[$n]\n";
                my $block = '_' . $array[$n];
                eval $self->$block;
            }
        }
    );

    $cv->recv;

}

#备份文件
sub _Backup {
    my $self = shift;
    my $fx = File::Xcopy->new;
    my %p = ( s => 1 );
    $fx->xcp( $self->from_dir, $self->to_dir, $self->regex, \%p );

}

#列出文件清单
sub _FindFiles {
    my $self = shift;
    my $fx = File::Xcopy->new;
    my $ar = $fx->find_files( $self->from_dir, $self->regex );
    open my $fh, ">目录.txt";
    for my $ar_file ( @{$ar} ) {
        print "\t$ar_file->{path}\n";
        print $fh "$ar_file->{path}\n";
    }
    close $fh;
}

sub _Exit { my $self = shift; exit 0 }

#如不存在目标备份文件夹(copy_to_dir)则新建同名文件夹
around to_dir => sub {
    my ( $orig, $self, @args ) = @_;
    my $dir = $self->$orig(@args);
    if ( !-e $dir ) {
        mkdir($dir);
    }
    return $dir;
};

package main;

#备份文件支持正则表达式，默认为所有文件及文件夹，只备份doc文档时regex属性设置为：regex => '.*\.doc$'
#my $bac = Backup->new( from_dir => '', to_dir => '',regex => '');
my $bac = Backup->new( from_dir => 'g:/结果', to_dir => 'd:/结果' );
$bac->Menu();用Moo会快一些

#use Acme::PerlTidy;

package Backup;
use Moo;
use AnyEvent;
use File::Xcopy qw(xcopy find_files);

has from_dir => ( is => 'rw' );
has to_dir => ( is => 'rw' );
#修改下一句-----------------------------------------------------------
has regex => ( is => 'rw');

#&menu( $prompt, @a);
sub Menu {
    my $self = shift;
    print '', "\n";
    my $prompt = 'which will you chose:';
    my @array = qw(FindFiles Backup Exit);
    return '' unless @array;
    print " $_:$array[$_]\n" for ( 0 .. $#array );

    my $cv = AnyEvent->condvar;
    my $w;
    $w = AnyEvent->idle(
        cb => sub {
            print $prompt;
            my $n = <>;
            if ( $n =~ /^\d+$/ and defined $array[$n] ) {
                print "You chose:$array[$n]\n";
                my $block = '_' . $array[$n];
                eval $self->$block;
            }
        }
    );

    $cv->recv;

}

#备份文件
sub _Backup {
    my $self = shift;
    my $fx = File::Xcopy->new;
    my %p = ( s => 1 );
    $fx->xcp( $self->from_dir, $self->to_dir, $self->regex, \%p );

}

#列出文件清单
sub _FindFiles {
    my $self = shift;
    my $fx = File::Xcopy->new;
    my $ar = $fx->find_files( $self->from_dir, $self->regex );
    open my $fh, ">目录.txt";
    for my $ar_file ( @{$ar} ) {
        print "\t$ar_file->{path}\n";
        print $fh "$ar_file->{path}\n";
    }
    close $fh;
}

sub _Exit { my $self = shift; exit 0 }

#如不存在目标备份文件夹(copy_to_dir)则新建同名文件夹
around to_dir => sub {
    my ( $orig, $self, @args ) = @_;
    my $dir = $self->$orig(@args);
    if ( !-e $dir ) {
        mkdir($dir);
    }
    return $dir;
};

package main;

#备份文件支持正则表达式，默认为所有文件及文件夹，只备份doc文档时regex属性设置为：regex => '.*\.doc$'
#my $bac = Backup->new( from_dir => '', to_dir => '',regex => '');
my $bac = Backup->new( from_dir => 'g:/结果', to_dir => 'd:/结果' );
$bac->Menu();
    my $prompt = 'which will you chose:';
    my @array = qw(FindFiles Backup Exit);
    print " $_:$array[$_]\n" for ( 0 .. $#array );

    my $cv = AnyEvent->condvar;
    my $w;
    $w = AnyEvent->idle(
        cb => sub {
            print $prompt;
            my $n = <>;
            if ( $n =~ /^\d+$/ and defined $array[$n] ) {
                print "You chose:$array[$n]\n";
                my $block = '_' . $array[$n];
                eval $self->$block;
            }
        }
    );

    $cv->recv;

}

#备份文件
sub _Backup {
    my $self = shift;
    my $fx = File::Xcopy->new;
    my %p = ( s => 1 );
    $fx->xcp( $self->from_dir, $self->to_dir, $self->regex, \%p );
}

#列出文件清单
sub _FindFiles {
    my $self = shift;
    my $fx = File::Xcopy->new;
    my $ar = $fx->find_files( $self->from_dir, $self->regex );
    open my $fh, ">目录.txt";
    for my $ar_file ( @{$ar} ) {
        print "\t$ar_file->{path}\n";
        print $fh "$ar_file->{path}\n";
    }
    close $fh;
}

sub _Exit { my $self = shift; exit 0 }

#如不存在目标备份文件夹(copy_to_dir)则新建同名文件夹
around to_dir => sub {
    my ( $orig, $self, @args ) = @_;
    my $dir = $self->$orig(@args);
    if ( !-e $dir ) {
        mkdir($dir);
    }
    return $dir;
};

package main;

#备份文件支持正则表达式，只备份doc文档时regex属性设置为：regex => '.*\.doc$'
#my $bac = Backup->new( from_dir => '', to_dir => '',regex => '');
#修改下一句-----------------------------------------------------------
my $bac = Backup->new( from_dir => 'D:/结果', to_dir => 'G:/结果',regex => '.*' );

$bac->Menu();

阅读(1914) | 评论(0) | 转发(0) |

0

上一篇：Text::Table用于财务报表的输出

下一篇：用POE改写的备份文件的小工具