ぼくちん: 2008年5月アーカイブ

うーむ

 1 use strict;
 2 use warnings;
 3
 4 use Test::More tests => 3;
 5 use Test::Exception;
 6 use Data::Dumper;
 7
 8 lives_ok { open( my $fh, "<",     \"ABCD") or die $!; } 'test1';
 9 lives_ok { open( my $fh, "<:raw", \"ABCD") or die $!; } 'test2';
10 lives_ok { open( my $fh, "<",     \"ABCD") or die $!; binmode $fh; } 'test2';
11
12 {
13     open( my $fh, "<", \"ABCD\015\012") or die $!;
14     diag Dumper [PerlIO::get_layers($fh)];
15     diag length( do { local $/; readline $fh; } );
16 }
17
18 {
19     open( my $fh, "<", \"ABCD\015\012") or die $!;
20     binmode $fh;
21     diag Dumper [PerlIO::get_layers($fh)];
22     diag length( do { local $/; readline $fh; } );
23 }
24
25 {
26     open( my $fh, "<", \"ABCD\015\012") or die $!;
27     binmode $fh, ":crlf";
28     diag Dumper [PerlIO::get_layers($fh)];
29     diag length( do { local $/; readline $fh; } );
30 }
31
32 __END__
33 $ prove.bat -I extlib -v b.pl
34 b.......
35 1..3
36 ok 1 - test1
37
38 #   Failed test 'test2'
39 #   at b.pl line 9.
40 # died: No such file or directory at b.pl line 9.
41 # $VAR1 = [
42 #           'scalar'
43 #         ];
44 # 6
45 # $VAR1 = [
46 #           'scalar'
47 #         ];
48 # 6
49 # $VAR1 = [
50 #           'scalar',
51 #           'crlf'
52 #         ];
53 # 5
54 # Looks like you failed 1 test of 3.
55 not ok 2 - test2
56 ok 3 - test2
57  Dubious, test returned 1 (wstat 256, 0x100)
58  Failed 1/3 subtests
59
60 Test Summary Report
61 -------------------
62 b.pl (Wstat: 256 Tests: 3 Failed: 1)
63   Failed test number(s):  2
64   Non-zero exit status: 1
65 Files=1, Tests=3,  0 wallclock secs ( 0.01 usr +  0.02 sys =  0.03 CPU)
66 Result: FAIL

Perl, Python, Ruby の比較にあるPerlのバージョンのを 弄ってみたよ。みかけてついいぢってしまった。あんまテストしてねい。

 1 #!/usr/bin/env perl
 2
 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);