もっと簡単に解けるよ
問題編
あるところ(Windows)にこんな構造Aのファイルがあり、これをB構造に直したいといわれました。さあどうしましょうか？
回答編
fu7mu4「手間ですね。(まじで、えー、そんなの利用者がフォルダ検索して探せばいいじゃん、え、だめなの)」
後輩「そうなんですよ、でperlでこうしてこうしてすれば、できるかなって」
fu7mu4「え、そう？」
perlで..?
後輩「こんなかんじでどうでしょうか？」
#!/opt/local/bin/perl use stricts; use warnings; use utf8; use File::Copy; my ($source_dir, $target_dir, $num ) = @_; die("$source_dir is not exist\n") unless -d "$source_dir"; die("$target_dir is not exist\n") unless -d "$target_dir"; our $ID_Name = defined($num) ? $num : 8; opendir(my $SDIR, "$source_dir") or die("cannot open dir $! \n"); my @sdirs = grep(-d,readdir($SDIR)); @sdirs = grep(!/\.+/, @sdirs); closedir($SDIR); my %filelist; foreach my $x (@sdirs) { opendir(my $SUBDIR, $x); my @files_in_sdir = grep(-f, readdir($SUBDIR)); closedir($SUBDIR); $filelist[$SUBDIR]=\@files_in_sdir; } foreach my $subd (keys %filelist) { foreach my $file_in_subd (@{$filelist{$subd}}) { if( $ID_Name =~ /\d+$/){ my $id = substr( "$files_in_sdir", 0, $ID_Name-1); } else { my @tmp = split(/\s/,$files_in_sdir); my $id = $tmp[0].'_'.$tmp[1]; } my $target_newdir="$target_dir".'/'."$id"; mkdir("$target_newdir") unless -d $name; my $source_file="$source_dir".'/'."$subd".'/'."$file_in_subd"; my $target_file="$target_newdir".'/'."$file_in_subd"; copy( $source_file, $target_file); } }
