用POE改写的备份文件的小工具

aef25u

将之前用AnyEvent与Moose写的备份文件的小工具改成了使用POE。
AnyEvent与Moose或Moo的见：http://blog.chinaunix.net/link.php?url=http://bbs.chinaunix.net

1. #use Acme::PerlTidy;
   
2. 
   
3. use POE;
   
4. use File::Xcopy qw(xcopy find_files);
   
5. 
   
6. POE::Session->create(
   
7.     inline_states => {
   
8.         _start     => \&Start,
   
9.         _FindFiles => \&_FindFiles,
   
10.         _Backup    => \&_Backup,
    
11.         _Exit      => \&_Exit,
    
12.     },
    
13. );
    
14. POE::Kernel->run;
    
15. 
    
16. sub Start {
    
17.     my ( $kernel, $heap ) = @_[ KERNEL, HEAP ];
    
18.     $heap->{from_dir} = 'G:/结果';
    
19.     $heap->{to_dir}   = 'D:/结果';
    
20.     $heap->{regex}    = '.*';
    
21. 
    
22.     print '<select a number:>', "\n";
    
23.     my $prompt = 'which will you chose:';
    
24.     my @array  = qw(FindFiles Backup Exit);
    
25.     return '' unless @array;
    
26.     print "  $_:$array[$_]\n" for ( 0 .. $#array );
    
27.     print $prompt;
    
28.     my $n = <>;
    
29.     if ( $n =~ /^\d+$/ and defined $array[$n] ) {
    
30.         print "You chose:$array[$n]\n";
    
31.         my $block = '_' . $array[$n];
    
32.         $kernel->yield($block);
    
33.     }
    
34. }
    
35. 
    
36. sub _Backup {
    
37.     my ( $kernel, $heap ) = @_[ KERNEL, HEAP ];
    
38. 
    
39.     #如不存在目标备份文件夹(copy_to_dir)则新建同名文件夹
    
40.     mkdir( $heap->{to_dir} ) if ( !-e $heap->{to_dir} );
    
41.     my $fx = File::Xcopy->new;
    
42.     my %p = ( s => 1 );
    
43.     $fx->xcp( $heap->{from_dir}, $heap->{to_dir}, $heap->{regex}, \%p );
    
44.     $kernel->yield('_start');
    
45. }
    
46. 
    
47. #列出文件清单
    
48. sub _FindFiles {
    
49.     my ( $kernel, $heap ) = @_[ KERNEL, HEAP ];
    
50.     my $fx = File::Xcopy->new;
    
51.     my $ar = $fx->find_files( $heap->{from_dir}, $heap->{regex} );
    
52.     open my $fh, ">目录.txt";
    
53.     for my $ar_file ( @{$ar} ) {
    
54.         print "\t$ar_file->{path}\n";
    
55.         print $fh "$ar_file->{path}\n";
    
56.     }
    
57.     close $fh;
    
58.     $kernel->yield('_start');
    
59. }
    
60. 
    
61. sub _Exit { exit 0 }

复制代码

x9x9

支持贴代码~

aef25u

回复 2# x9x9

既然支持，那你也贴一些啊，我网上找代码来学习好花时间啊...

x9x9

回复  x9x9

既然支持，那你也贴一些啊，我网上找代码来学习好花时间啊...
aef25u 发表于 2011-08-13 16:29

有的话会贴的~
这里贴的还不少：http://www.oschina.net/code/list
很喜欢这个代码着色的显示风格~

moryaden

回复 1# aef25u


    感谢楼主分享，你的链接貌似有问题。。。

iamlimeng

支持原创，支持源码！

首天

有的话会贴的~
这里贴的还不少：
很喜欢这个代码着色的显示风格~
x9x9 发表于 2011-08-13 17:38

这里的代码不错的