view release on metacpan or  search on metacpan

scripts/csv2tsv  view on Meta::CPAN

  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 { 
    #exit if $o{'~'} ;
    exit if ! defined $csv ; 
    my @tmp = $csv -> error_diag () ; # ($cde, $str, $pos, $rec, $fld) = $csv->error_diag ();
    if ( $tmp[0] != 2012 ) {  # perldoc Text::CSV_XS で 2012 を参照。EOFを意味する。
      print STDERR BRIGHT_RED join (":",@tmp),"\n" ;
      print STDERR ON_BRIGHT_RED BLACK "_ERROR_INPUT at line $.: " ; 
      #use Data::Dumper ; #print STDERR UNDERLINE Dumper $csv  ; 
      print STDERR UNDERLINE BRIGHT_RED $csv ->{_ERROR_INPUT} ; 
      exit 1 ; 
    }
  }
}

## ヘルプとバージョン情報
BEGIN {
  our $VERSION = 0.56 ;
  $Getopt::Std::STANDARD_HELP_VERSION = 1 ; 
  grep { m/--help/} @ARGV and *VERSION_MESSAGE = sub {} ; 
    # 最初は 0.21 を目安とする。
    # 1.00 以上とする必要条件は英語版のヘルプをきちんと出すこと。
    # 2.00 以上とする必要条件はテストコードが含むこと。
   # 0.51 : 英文マニュアルをPOD形式にする。
   # 0.52 : revの機能をデバグ
   # 0.53 : エスケープ文字が余分に現れるバグを訂正。更にリファクタ。更にシェバングに-Tを加えた。
   # 0.54 : revで2次情報を出すようにした。STDERRで非ASCIIに対応。
   # 0.55 : CSVのフィールドの区分文字を変更可能とした。Text::CSV_XSでエラーが起きたときに、入力行の内容を表示するようにした。さらに -Tを-tにした(perldocが起動できなかったため)。
   # 0.56 : マニュアルの英語の部分を2箇所訂正。
}  
sub HELP_MESSAGE {
    use FindBin qw[ $Script $Bin ] ;
    sub EnvJ ( ) { $ENV{LANG} =~ m/^ja_JP/ ? 1 : 0 } ; # # ja_JP.UTF-8 
    sub en( ) { grep ( /^en(g(i(sh?)?)?)?/i , @ARGV ) ? 1 : 0 } # English という文字列を先頭から2文字以上を含むか 
    sub ja( ) { grep ( /^jp$|^ja(p(a(n?)?)?)?/i , @ARGV ) ? 1 : 0 } # jp または japan という文字列を先頭から2文字以上を含むか 
    sub opt( ) { grep (/^opt(i(o(ns?)?)?)?$/i, @ARGV ) ? 1 : 0 } # options という文字列を先頭から3文字以上含むから
    sub noPOD ( ) { grep (/^no-?p(od?)?\b/i, @ARGV) ? 1 : 0 } # POD を使わないと言う指定がされているかどうか
    my $jd = "JapaneseManual" ;
    my $flagE = ! ja && ( en || ! EnvJ ) ; # 英語にするかどうかのフラグ
    exec "perldoc $0" if $flagE &&  ! opt ; #&& ! noPOD   ; 
    $ARGV[1] //= '' ;
    open my $FH , '<' , $0 ;
    while(<$FH>){
        s/\Q'=script='\E/$Script/gi ;
        s/\Q'=bin='\E/$Bin/gi ;
        if ( s/^=head1\b\s*// .. s/^=cut\b\s*// ) { 
            if ( s/^=begin\s+$jd\b\s*// .. s/^=end\s+$jd\b\s*// xor $flagE ) {
                print $_ if ! opt || m/^\s+\-/  ; 
            }
        } 
    }
    close $FH ;
    exit 0 ;
}

=encoding utf8 

=head1 NAME

csv2tsv

=head1 VERSION 

0.55 (2018-07-09 Mon)

=head1 SYNOPSIS

csv2tsv [B<-t> str] [B<-n> str] [-v] [-Q] [-2] [B<-~>] file