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;
■ コメント