Perl, Python, Ruby の比較にあるPerlのバージョンのを 弄ってみたよ。みかけてついいぢってしまった。あんまテストしてねい。
1 #!/usr/bin/env perl2
3 use strict;
4 use warnings;
5 use File::Compare;
6 use File::Copy;
7 use IO::All;
8 use List::Util qw(max);
9 use POSIX qw(strftime);
10
11 # Pythonのに無いため
12 # カレントディレクトリの操作
13 # 例外処理の一部
14 # linarの起動
15 # は省きました。
16 #
17 # ハッシュは作っていません。
18
19 sub next_photo_dir {
20 my $path = shift;
21 my $max = max ( map { m/(\d+)$/ } (glob("$path/photo[0-9][0-9]"), 0) );
22 sprintf("photo%02d", ++$max);
23 }
24
25 sub move_photos {
26 my ($media, $disk) = map { io->dir($_) } @_;
27
28 my $ym = strftime("%y-%m", localtime);
29
30 for my $from_dir ($media, $media->All_Dirs) {
31 my @files = $from_dir->all_files;
32 next unless @files;
33
34 my $to_dir = io->catdir($disk, $ym, next_photo_dir($disk));
35 $to_dir->mkpath;
36
37 print "$from_dir ==> $to_dir\n";
38
39 my $file_num = 0;
40 for my $from (@files) {
41 my $to = io->catfile($to_dir, $from->filename);
42 copy("$from", "$to") or die "cannot make a copy for $from: $!";
43 if (0 == compare("$from", "$to")) {
44 $from->unlink;
45 printf("\t%s/%s\n", ++$file_num, 0+@files);
46 }
47 else {
48 die "an error occurs during coping $from";
49 }
50 }
51 }
52 }
53
54 #main
55 my $media = 'c:/_/media';
56 my $disk = 'c:/_/disk';
57 move_photos($media, $disk);
コメントする