Perlでread関数使ってバイナリファイルを読み込んだら、1度に読み込むデータ量で処理速度が全然違った件
バイナリファイルを比較して、ファイルの壊れ具合をチェックするという処理をperlで書いて実行した。
use Time::Piece; #中略 my $ngstart = 0;#undef(未定義)やnullでは都合が悪い。 my $megabyte =1048576; open(SourceFILE0, "<", $arg[0]) or die("Cannt open $arg[0] !\n"); binmode SourceFILE0; open(SourceFILE1, "<", $arg[1]) or die("Cannt open $arg[1] !\n"); binmode SourceFILE1; for(my $i=1;$i <$file_size0;$i = $i +4){ my ($buf0, $buf1); read(SourceFILE0, $buf0, 4, $i); my @data0 = unpack('C4', $buf0); read(SourceFILE1, $buf1, 4, $i); my @data1 = unpack('C4', $buf1); for(my $j =0;$j <4;$j++){ if(($i +$j) >$file_size0){ last; } if($data0[$j] != $data1[$j]){ if($ngstart == 0){ $ngstart = $i + $j; } }else{ if($ngstart){ my $ngend = $i + $j -1; print "違! $ngstart 〜 $ngend\n"; $ngstart = 0; } } } if($i -1 == $megabyte){ my $t = localtime; my $megatta = $megabyte / 1048576; print "$megatta MB $t\n"; $megabyte = $megabyte + 1048576; } }
当初は上記の設定で動かしたのだが、
1 MB Wed Jul 29 13:01:28 2020 2 MB Wed Jul 29 13:07:13 2020
と、1MBの処理に6分近くかかった。当初読み込むデータ量を4byteにしたのは、32bitのCPUなんだから、1度に扱えるのは4byteだろうと思ったから。
でもあまりにも遅すぎるので、思い切って1KB読み込むように書き換えた。
for(my $i=1;$i <$file_size0;$i = $i +1024){ if($i >$file_size0){ last; } my ($buf0, $buf1); read(SourceFILE0, $buf0, 1024, $i); my @data0 = unpack('C1024', $buf0); read(SourceFILE1, $buf1, 1024, $i); my @data1 = unpack('C1024', $buf1); for($j =0;$j <1024;$j++){
すると
1 MB Wed Jul 29 13:17:09 2020 2 MB Wed Jul 29 13:17:12 2020 3 MB Wed Jul 29 13:17:15 2020 4 MB Wed Jul 29 13:17:21 2020 5 MB Wed Jul 29 13:17:27 2020
と、爆速(当社比)になった。さらに4KBずつ読み込むように書き換えたところ、体感での差は出なかった。
1 MB Wed Jul 29 13:41:41 2020 2 MB Wed Jul 29 13:41:43 2020 3 MB Wed Jul 29 13:41:46 2020 4 MB Wed Jul 29 13:41:51 2020 5 MB Wed Jul 29 13:41:55 2020
結局、読み込むデータ量を少なくしすぎることで、HDDからメモリへの読み込みの頻度が多くなって、そのHDDアクセスがオーバーヘッドとなって、全体の速度低下を招いていたのだろう。
上のスクリプトを実行すると、どんどん実行速度が遅くなる件
1KBずつ読み込む方のスクリプトでは、下記のようなログとなった。
200 MB Wed Jul 29 16:39:23 2020 201 MB Wed Jul 29 16:41:17 2020 202 MB Wed Jul 29 16:43:12 2020 203 MB Wed Jul 29 16:45:05 2020 204 MB Wed Jul 29 16:46:59 2020 205 MB Wed Jul 29 16:48:52 2020 206 MB Wed Jul 29 16:50:47 2020 207 MB Wed Jul 29 16:52:44 2020
当初は数秒で1MBを処理していたのに、1MBを処理する時間が2分に迫る速度低下である。
原因はどこにあるのか?
forループや whileループ内で "my" で定義した変数は、その場限りの変数であり、ループ実行後にシステムが破棄してくれる。次のループになるとこれらの my変数は再度定義される。どうもその処理が予想以上に重い処理であるようだ。
ループ内で my変数を定義するからいけないんだ!
ということで、ループ外で変数を定義して同じ変数を再利用することにするが、再初期化忘れというバグを発生させる元となるので、基本的にはお勧めしない。
my $ngstart = 0; my ($buf0, $buf1,@data0, @data1); my $megabyte =1048576; for(my $i=1;$i <$file_size0;$i = $i +4096){ read(SourceFILE0, $buf0, 4096, $i); @data0 = unpack('C4096', $buf0); $buf0 = ''; read(SourceFILE1, $buf1, 4096, $i); @data1 = unpack('C4096', $buf1); $buf1 = ''; for(my $j =0;$j <4096;$j++){ if(($i + $j)>$file_size0){ last; } if($data0[$j] != $data1[$j]){ if($ngstart == 0){ $ngstart = $i + $j; } }else{ if($ngstart){ my $ngend = $i + $j -1; print "違! $ngstart 〜 $ngend\n"; $ngstart = 0; } } } @data0 =(); @data1 =(); if($i -1 == $megabyte){ my $t = localtime; my $megatta = $megabyte / 1048576; print "$megatta MB $t\n"; $megabyte = $megabyte + 1048576; } }
結果は
1 MB Wed Jul 29 17:56:07 2020 2 MB Wed Jul 29 17:56:08 2020 3 MB Wed Jul 29 17:56:10 2020 4 MB Wed Jul 29 17:56:11 2020 5 MB Wed Jul 29 17:56:13 2020 ・・・ (中略) ・・・ 200 MB Wed Jul 29 18:58:03 2020 201 MB Wed Jul 29 18:58:59 2020 202 MB Wed Jul 29 18:59:52 2020 203 MB Wed Jul 29 19:00:43 2020 204 MB Wed Jul 29 19:01:34 2020 205 MB Wed Jul 29 19:02:26 2020 206 MB Wed Jul 29 19:03:21 2020 207 MB Wed Jul 29 19:04:14 2020
処理速度低下は免れていないものの、処理速度は向上した。
念の為書いておきますけど、これはサンプルコードであって、同じ処理をするならコマンドラインで下記のコマンドを打って、出力結果を加工するほうが速い。
% cmp -l ファイル1 ファイル22020/07/31 追記
ここまでのperlスクリプトにはread関数にオフセット値を付けていたが、オフセット値をつけることでいちいちファイルの先頭に移動して、また戻ってくるということをしていたのではなかろうか?という疑問が湧いたので、オフセット値を付けないことにした。
use Time::Piece; #中略 open(SourceFILE0, "<", $arg[0]) or die("Cannot open $arg[0] !\n"); binmode SourceFILE0; open(SourceFILE1, "<", $arg[1]) or die("Cannot open $arg[1] !\n"); binmode SourceFILE1; my $ngstart = 0; my ($buf,$megatta, $j); my $megabyte =104857600; for(my $i=1;$i <$file_size0;$i = $i +4096){ read(SourceFILE0, $buf, 4096);# オフセット値の $i を削除 my @data0 = unpack('C4096', $buf);# @data0の使い回しをやめた(後述) $buf = ''; read(SourceFILE1, $buf, 4096);# オフセット値の $i を削除 my @data1 = unpack('C4096', $buf);# @data1の使い回しをやめた(後述) $buf = ''; for($j =0;$j <4096;$j++){ if(($i + $j)>$file_size0){ last; } if($data0[$j] != $data1[$j]){ if($ngstart == 0){ $ngstart = $i + $j; } }else{ if($ngstart){ my $ngend = $i + $j -1; print "違! $ngstart 〜 $ngend\n"; $ngstart = 0; } } } if(($i + $j -1) == $megabyte){ my $t = localtime; $megatta = $megabyte / 104857600; print "$megatta 00MB $t\n"; $megabyte = $megabyte + 104857600; } } close SourceFILE0; close SourceFILE1;
とすると、
1 00MB Fri Jul 31 18:40:12 2020 2 00MB Fri Jul 31 18:41:47 2020 3 00MB Fri Jul 31 18:43:15 2020 4 00MB Fri Jul 31 18:44:46 2020 5 00MB Fri Jul 31 18:46:31 2020 6 00MB Fri Jul 31 18:48:02 2020 7 00MB Fri Jul 31 18:49:33 2020 8 00MB Fri Jul 31 18:51:05 2020 9 00MB Fri Jul 31 18:52:41 2020 10 00MB Fri Jul 31 18:54:10 2020
と爆速(当社比)となった。
perlのメモリ使用量がどんどん増える件
上記のスクリプトをそのまま動かし続けると、処理速度はどんどん遅くなった。
600 MB Thu Jul 30 05:09:35 2020 601 MB Thu Jul 30 05:11:53 2020 602 MB Thu Jul 30 05:14:12 2020 603 MB Thu Jul 30 05:16:29 2020 604 MB Thu Jul 30 05:18:46 2020 605 MB Thu Jul 30 05:21:04 2020 606 MB Thu Jul 30 05:23:22 2020 607 MB Thu Jul 30 05:25:42 2020
別の問題が発生していて、メモリ使用量も読み込んだデータに比例して増えている。
CPU使用量には余裕があるので2プロセス同時に動かしている。
こんな性能では全然実用に耐えない。本当に cmpコマンド使ったほうがマシである。
前項で高速化のために @data0, @data1をループ外で定義して全ループ共通で同じものを使いまわしたのだが、これがメモリリークを起こす原因なのではないかと思い、read関数のオフセット値を外した時に同時に、@data0, @data1の使い回しをやめたのだが、これが効果があったらしく、スクリプト実行中の急激なメモリ増加はなくなった。
おまけ
という訳で、cmpコマンドを使うように書き換えてみた。
open(my $cmpout, "cmp -l $filename0 $filename1 2>&1 |"); my @outlist = <$cmpout>; close($cmpout); if(!(defined $outlist[0])){ die("cmpコマンドからの出力がありませんでした\n多分、完全に一致しているのでしょう\n"); } $/='\n'; print @outlist;
で、そもそも完全に一致しているファイルでは問題なかったのですが、一致していない部分が多かったファイル同士を比べたところ、メモリを使い果たしてOSがリブートする羽目になった。
perlがOSを落とした時と同じファイル同士を cmpコマンドで比較したところ
% cmp -l ファイル0 ファイル1 >diff.txt
% ls -la
- rw-rw-rw- 1 tanuki staff 3933286178 7 30 2020 diff.txt
4GB弱のファイルサイズとなっていた。なので、一旦cmpコマンドでの結果をファイル出力してから、その出力ファイルを使って作業するしか仕方がないだろう。
% head -n 5 diff.txt
98305 1 0
98307 2 0
98309 73 0
98313 102 0
98314 325 0
diff.txtの中身を見て「はぁ?」って言ってしまった。1バイトは8bitだから 28 = 256 で、0から255までの値しか格納できないはずなのに、325という数値がある。
「なんぞこれ?」と思って調べると、cmpが出力する値は 8進数なのだという。
というわけで、diff.txtを元に、0埋めされた部分を復元するperlスクリプトを作成した。
open(DiffFILE, "<", $arg[1]) or die("Cannot open $arg[1] !\n"); open(SourceFILE, "<", $arg[0]) or die("Cannot open $arg[0] !\n"); binmode SourceFILE; open(NEWFILE, ">", $arg[2]) or die("Cannot open $arg[2] !\n"); binmode NEWFILE; my $address =1; my ($diffdata,$seekadd,$buff) ; # my ($seekchecks, $seekcheckn) ; while(<DiffFILE>){ $_ =~ s/ +/ /g; $_ =~ s/^ //; my @diffdatas = split(/ /,$_); for(;$address < $diffdatas[0];$address++){ read(SourceFILE, $buf, 1); print NEWFILE $buf; $buf =''; } read(SourceFILE, $buf, 1); if(unpack('C', $buf)==0){ if($diffdatas[1]){ $diffdata = oct($diffdatas[1]); }else{ $diffdata = oct($diffdatas[2]); } $diffdata = pack('C',$diffdata); print NEWFILE $diffdata; }else{ close SourceFILE; close NEWFILE; close DiffFILE; die("書き込み位置のデータが0ではありません"); } $buf=''; @diffdatas =(); =pod $seekcheckn =tell(NEWFILE); $seekchecks =tell(SourceFILE); if($seekcheckn != $seekchecks ||$seekchecks != $address){ close SourceFILE; close NEWFILE; close DiffFILE; die("書き込み位置がズレています\n書き込み位置$seekcheckn: ソースファイル:$seekchecks アドレス:$address"); } =cut $address++; } while(read(SourceFILE, $buf, 1)){ print NEWFILE $buf; $buf =''; } close SourceFILE; close NEWFILE; close DiffFILE; my $file_size2 = -s $arg[2]; if($file_size2 != $file_size0){ die("$arg[2]のファイルサイズが異なります\n$file_size0 != $file_size2 \n"); }
