Perlモジュール/File::Slurp::TSV

タブ区切りテキストファイルを丸ごと読み込んだり、一気に書き出したりするためのモジュール。

ソース

File::Slurp::TSVはCPANにもActivePerlのリポジトリにも登録されてないのラモジュールです。以下のソースを使用してください。

package File::Slurp::TSV;
use base 'File::Slurp';

use strict;
use Carp ;
use vars qw( %EXPORT_TAGS @EXPORT_OK $VERSION @EXPORT ) ;

%EXPORT_TAGS = ( 'all' => [
  qw( read_file write_file overwrite_file append_file read_dir ),
  qw( read_tsv write_tsv append_tsv )
] ) ;

@EXPORT = ( @{ $EXPORT_TAGS{'all'} } );
@EXPORT_OK = qw( slurp ) ;

$VERSION = '9999.02';

sub read_tsv {
  my @lines = &File::Slurp::read_file(@_);
  my $records = &parse_tsv(\@lines);
  return wantarray ? @{$records} : $records;
}

sub write_tsv {
  my @args = (shift);
  push(@args, shift) if (@_ and ref($_[0]) eq 'HASH');
  my $records = (@_ and ref($_[0]) eq 'ARRAY' and ref($_[0]->[0]) eq 'ARRAY') ? $_[0] : [@_];
  $records = &build_tsv($records);
  return &File::Slurp::write_file(@args, $records);
}

sub append_tsv {
  my $args = $_[1] ;
  if ( ref $args eq 'HASH' ) { $args->{append} = 1 ; }
  else { splice( @_, 1, 0, { append => 1 } ) ; }
  goto &write_tsv;
}

sub parse_tsv {
  my $lines = shift;
  my @records = ();
  if (ref($lines) eq 'ARRAY') {
    # Thanks to Ohzaki for "CSV to values" in his perl memo.
    # http://www.din.or.jp/~ohzaki/perl.htm#CSVwithCRLF
    while (@{$lines}) {
      my $line = shift(@{$lines});
      $line .= shift(@{$lines}) while ($line =~ tr/"// % 2 and @{$lines});
      $line =~ s/(?:\x0D\x0A|[\x0D\x0A])?$/\t/;
      my @values = map {/^"(.*)"$/s ? scalar($_ = $1, s/""/"/g, $_) : $_} ($line =~ /("[^"]*(?:""[^"]*)*"|[^\t]*)\t/g); #"}
      push(@records, [@values]);
    }
  }
  return (wantarray) ? @records : \@records;
}

sub build_tsv {
  # Thanks to Ohzaki for "CSV from Values" in his perl memo.
  # http://www.din.or.jp/~ohzaki/perl.htm#CSVfromValues
  my $record = shift;
  if (ref($record->[0]) eq '') {
    $record = join("\t", map {(s/"/""/g or /[\r\n\t]/) ? qq("$_") : $_} @{$record}) . "\n"; #"}
  } elsif (ref($record->[0]) eq 'ARRAY') {
    map { $record->[$_] = &build_tsv($record->[$_]); } (0..$#{$record}); #"}}
  }
  return (wantarray and ref($record) eq 'ARRAY') ? @{$record} : $record;
}

1;

セットアップ

編集

File::Slurp::TSVはFile::Slurpモジュールを使用します。このモジュールはCPANからでもPPMででも入手できますので、インストールして置いてください。

File::Slurpをインストールすると、Perのモジュール追加先（WindowsのActivePerlでは、デフォルトではC:\Perl\site\lib）のFileというディレクトリに、Slurp.pmというファイルが出来ているはずです。見つかったら、上のソースを次のようなディレクトリ構成になるように、「TSV.pm」というファイル名で保存してください。

[Dir] Perのモジュール追加先
  +-- [Dir] File
        +-- [File] Slurp.pm
        +-- [Dir]  Slurp
              +--  [File] TSV.pm

これで準備完了です。試しに以下を実行して、バージョンが表示されることを確認してください。

$ perl -MFile::Slurp::TSV -e "print File::Slurp::TSV->VERSION;"

利用例

編集

write_tsvで配列リファレンスをTSVファイルに書き出し。

use File::Slurp::TSV;

my @records = (
  [1, 'Jan', '睦月'],
  [2, 'Feb', '如月'],
  [3, 'Mar', '弥生'],
)
&write_tsv('month.tsv', @records);

read_tsvでTSVファイルから読み込み。この時リストコンテキストだと複数の配列リファレンスを返します。

use File::Slurp::TSV;
use Data::Dumper;

my @records = &read_tsv('month.tsv');
print Dumer(@records);

スカラコンテキストだと、配列リファレンスの配列リファレンスを返します。えーと、まあやってみてください。

use File::Slurp::TSV;
use Data::Dumper;

my $records = &read_tsv('month.tsv');
print Dumer($records);

append_tsvでTSVファイルにレコードを追加。

use File::Slurp::TSV;
use Data::Dumper;

my @records = (
  [4, 'Apr', '卯月'],
  [5, 'May', '皐月'],
  [6, 'Jun', '水無月'],
)
&append_tsv('month.tsv', @records);

# 追加されていることを確認しておく
my @records = &read_tsv('month.tsv');
print Dumer(@records);

編集

[[#rcomment]]

Perlモジュール/File::Slurp::TSV

ソース

セットアップ

利用例

コメント