webなネタ
Perl ファイル入出力をまとめる
2016/09/26(Mon) 13:50
perlでファイルの入出力に、いちいちopenって書くのがめんどくさいので、サブルーチンにしました。
誰かが同じ事やってないかと探してみたんだけど、意外となかった!
たぶん、この方法はメモリー食うとか、処理速度が遅いとか、そんな感じでみんなやらないのかな。
でも、入出力を1行で書けるのは快適だし、ソースコードもコンパクトで読みやすくなるので、お気に入り。
#------ 読み込み ------ #---------------------------------- # ファイルの読み込み # my @data = &read_array ('data/data.cgi'); sub read_array { my $file = shift; open my $fh, '<', $file; flock $fh, LOCK_SH; my @data = <$fh>; close $fh; return (@data); } #---------------------------------- # ファイルの読み込み # my $data = &read_all ('data/data.cgi'); sub read_all { my $file = shift; open my $fh, '<', $file; flock $fh, LOCK_SH; undef $/; my $data = <$fh>; close $fh; return ($data); } #---------------------------------- # ファイルの読み込み(1行) # my $line = &read_line ('data/data.cgi',$key); # ($a, $b, $c) = split(/\t/, $line); sub read_line { my ($file,$key) = @_; my @data = &read_array ($file); #ファイルの読み込み my $line; for(@data){ my ($pg,undef) = split(/\t/); if ($pg eq $key) { chomp $_; $line = $_; last; } } return ($line); } #------ 書込み ------ #---------------------------------- # データファイルの書き込み(1行新規) # &write_new_line ('data/data.cgi', "$aaa\t$bbb\t$ccc\t\n"); sub write_new_line { my ($file,$new_data) = @_; # time値とプロセスIDでKey発行 my $key = "$$"."$^T"; open my $fh,'+<', $file or die "ERROR open file $file : $!"; flock $fh, LOCK_EX or die "ERROR Write can't lock $!"; my @data = <$fh>; unshift (@data,"$key\t$new_data"); # 降順ソート @data = sort { (split(/\t/,$b))[0] <=> (split(/\t/,$a))[0] } @data; seek $fh, 0, 0; print $fh @data; truncate $fh, tell $fh; close $fh; } #---------------------------------- # データファイルの書き込み(1行更新) # &write_line ('data/data.cgi', $key, "$key\t$aaa\t$bbb\t$ccc\t\n"); sub write_line { my ($file,$key,$new_data) = @_; open my $fh,'+<', $file or die "ERROR open file $file : $!"; flock $fh, LOCK_EX or die "ERROR Write can't lock $!"; my @data = <$fh>; my $check; my @new; for (@data){ my ($pg,$undef) = split(/\t/); if ($key eq $pg) { $_ = $new_data; $check = 1; } push (@new, $_); } if ($check eq ''){ # 新規 unshift (@new, $new_data); } seek $fh, 0, 0; print $fh @new; truncate $fh, tell $fh; close $fh; } #---------------------------------- # データファイルの書き込み(配列) # &write_array ('data/data.cgi', \@new_data); sub write_array { my ($file,$new_data) = @_; open my $out,'>', $file; flock $out, LOCK_EX or die "ERROR Write can't lock $!"; print $out @$new_data; close $out; } #---------------------------------- # データファイルの「上書き」書き込み(変数) # &write_all ('data/data.cgi', $data); sub write_all { my ($file,$new_data) = @_; open my $out,'>', $file or die "ERROR $!"; flock $out, LOCK_EX; print $out $new_data; close $out; } #---------------------------------- # データファイルの「追加」書き込み(変数) # &write_plus ('data/data.cgi', $plus_data); sub write_plus { my ($file,$new_data) = @_; open my $out,'>>', $file; print $out $new_data; close $out; } #---------------------------------- # データファイルから削除 # &del_line ('data/data.cgi',$w_del); sub del_line { my ($file,$key01) = @_; open my $fh,'+<', $file or die "ERROR open file $file : $!"; flock $fh, LOCK_EX or die "ERROR Write can't lock $!"; my @data = <$fh>; my @new_data; for (@data){ # 既存データ my ($key02,undef) = split(/\t/); if ($key01 ne $key02) { push(@new_data,$_); } } seek $fh, 0, 0; print $fh @new_data; truncate $fh, tell $fh; close $fh; } 1;
■ コメント