0475town.com
Note
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;

■ コメント

お名前:
コメント: