view release on metacpan or  search on metacpan

scripts/csv2tsv  view on Meta::CPAN

 }
 exit 1 ; 
} ;


grep { $_ = decode_utf8 $_ if defined $_ } $o{e} , $o{t}, $o{n} ;
$o{e} //= qw[ \ ] ;  # エスケープしたい文字列につける文字
$o{s} //= ',' ; # フィールドの区切り文字を指定
$o{'@'} //= 5 ; # 何も入力が無い場合に，何秒おきに警告を出すか


my $alarmF = 0 ; # 警告を出すか出さないか。
& alarmset ; # 入力が 一定秒数以内に始まらない場合に、画面に注意を表示する。
& rev and exit 0 if $o{'~'} ;
& main and exit 0 ; 

# 入力が無いときに，注意を表示する仕組み
sub alarmset { 
  # return unless -t ;
  # $alarmF = 1 ; 
  # $SIG{ALRM} = sub { 
  #  print STDERR GREEN "[$Script] Waiting CSV-formatted input from STDIN..\n" ;
  #  $SIG{ALRM} = sub { print STDERR GREEN "." ; alarm $o{'@'} } ; 
  #   alarm $o{'@'} ; 
  #} ; 
  $SIG{ALRM} = sub { print STDERR GREEN BOLD FAINT "$. lines have read. " ; alarm $o{'@'} } ; 
  alarm $o{'@'} ; 
}

# 逆操作。 TSV -> CSV 
sub rev ( ) { 
  grep { $_ = quotemeta $_ if defined $_ } $o{e} , $o{n} , $o{t} ; 
  my $csv = Text::CSV_XS->new( { binary => 1 , sep_char => $o{s} , always_quote => $o{a} } ) ;  # if binary =0 then UTF-8 character cause trouble

  while ( <> ){ 
    # do { $alarmF = 0 ; alarm 0 } if $alarmF ;
    chomp ; 
    s/\r$// ;
    my @F = split /\t/, $_ , -1 ; 
    for ( @F ){
      & escrev ($o{t} , "\t") if defined $o{t} && $o{t} ne '' ; # エスケープされた文字を考慮しつつ、-t から タブ文字を復元する。
      & escrev ($o{n} , "\n") if defined $o{n} && $o{n} ne '' ; # エスケープされた文字を考慮しつつ、-n から 改行文字を復元する。
    }
    my $status = $csv -> print ( * STDOUT, [ @F ] ) ;
    print STDERR BRIGHT_RED "Something wrong at line $.\n" unless $status ; 
    print "\n" ;
  }
  print STDERR CYAN qq[[$Script -~] "$ARGV": $. lines input has processed.\n] unless $o{Q} ;
  return 1 ;

  sub escrev { 
    my $bef = $_[0] ;
    my $aft = $_[1] ;
    s/(?<!$o{e})$bef/$aft/g ;  # 否定的後読みは (?<!pattern)　; 肯定的後読みは (?<=pattern)
    s/$o{e}$bef/$bef/g ; #print STDERR BLUE "$o{e}, $o{n}\n" ;
  }
}

sub main ( ) {

  binmode * STDOUT , ":utf8" ; # Necessry because Text::CSV_XS decodes UTF8 input.
  binmode * STDERR , ":utf8" ; # Necessry because Text::CSV_XS decodes UTF8 input.

  my $linepos = 1 ; # CSV で読み込んでいるので、$. は2以上増えることがある。読み取る度に、 $linepos から $. 行目までと認識するため。
  my %cols ; # 何個の列を何行が持っていたかを表す。3列の行が120行存在した、などを表す。
  our $csv = Text::CSV_XS -> new ( { binary => 1 , sep_char => $o{s} , auto_diag => 1 } ) ;  # if binary => 0 then when "\n" is included in a cell it cause trouble.
  push my @trans , grep {$_} do { [ "\t" , $o{t} ] if defined $o{t} } , do { [ "\n" , $o{n} ] if defined $o{n} } ; # 文字列置換の指定。
  my @warnstr ; # 警告対象の文字列。改行やタブ文字など
  my @escape ; # エスケープ対象の文字列
  unless ($o{Q}) { 
    push @warnstr , $o{t} if defined $o{t} ; 
    push @warnstr , $o{n} if defined $o{n} ; 
    @warnstr = grep { $_ ne '' } @warnstr ;
    @escape = map { quotemeta $_ } @warnstr ; # この時点で -vのものははいっていない
    push @warnstr , "\t" if $o{v} || ! defined $o{t} ; 
    push @warnstr , "\n" if $o{v} || ! defined $o{n} ; 
  }

  # 入力を読取り、処理して出力。
  my $posV = 0 ; # 出力上の縦方向の位置を表す
  while ( my $x = $csv -> getline( *ARGV ) ) {  # 次行以下を読むこと↓
       # *ARGVはOld(er) support と perldoc Text::CSV_XSに記載あり。将来サポートされないかも。
       # geline でよくエラーが起こる。なぜだ? <--- - - 
    do { $alarmF = 0 ; alarm 0 } if $alarmF ;
    $posV ++ ; 
    $cols{ @$x } ++ ; # この行は、列を何個持っていたかの数から，後で，何個の行が何個の列を持っていたか情報表示をするようにする。
    my $posH = 0 ; # 出力上のセルの水平位置を表す。 
    for my $cell ( @$x ) { 
      $posH ++ ;
      warnprint ( $cell , \@warnstr, [ $linepos , $posV , $posH ] ) unless $o{Q} ; # 要注意文字列に対して、警告を表示する。
      $cell =~ s/(?=$_)/$o{e}/g for @escape ;       # エスケープする /
      $cell =~ s/$trans[$_]->[0]/$trans[$_]->[1]/g for 0 .. $#trans ; # -tと-nの処理を加える。
    }
    # 出力処理
    print join ( "\t", @$x ) . "\n" ;  
    print "\n" if $o{2} ; #   # 出力各行の間に空行を挿入する場合の処理
    $linepos = $. + 1 ; # <- 入力の何行目を改行区切りで数えた $. に +1 している。tricky!
  }
  $csv->eof; # <-- - 必要か?
  & info ( $. , \%cols ) unless $o{Q} ; 
  return 1 ; 

  sub info {
    my $out1 = qq[[$Script] "$ARGV": $_[0] lines] ;
    my $out2 = keys %{ $_[1] } ? "=> columns x rows: " . join " + " , map { "${_} x ${$_[1]}{$_}"} sort {$a<=>$b} keys %{ $_[1] } : '' ;
    print STDERR CYAN qq[$out1 $out2 \n] ;
  }

  sub warnprint { 
    my $cell = $_[0] ;
    my ( $linepos , $posV , $posH ) = @{ $_[2] } ;
    for my $seek ( @{ $_[1] } ) { 
      next unless $cell =~ m/\Q$seek\E/ ; 
      my $S = do { local $_ = $seek ; s/\n/\\n/g ; s/\t/\\t/g ; $_ } ; #quotemeta $seek ; 
      my $L = ($linepos == $.) ? $linepos : "$linepos-$." ; 
      my $C = do { local $_ = $cell ; s/\n/\e[44m\\n\e[40m/gs ; s/\t/\e[44m\\t\e[40m/gs ; "\e[0m\e[4m$_" } ; # 背景を青くする。
      my $sout = qq[[$Script] Warning: "$S" detected at "$ARGV": input line $L; output cell (Row: $posV, Col: $posH): ${C}\n] ; 
      print STDERR BRIGHT_RED $sout ; 
    }
  }
  # エラー処理 (Text::CSV_XS のエラー処理)  , このプログラムの変数の使い方が理由で、この位置にENDを置いた。
  END {