view release on metacpan or  search on metacpan

scripts/csv2tsv  view on Meta::CPAN

#!/usr/bin/perl -t
use 5.014 ; use strict ; use warnings ;  # Confirmed also for 5.010 
use Time::HiRes qw [ gettimeofday tv_interval ] ;
my ${ dt_start } = [ gettimeofday ] ; 
use Getopt::Std ; getopts '~2ae:n:s:t:vQ@:', \my %o ;
use Text::CSV_XS ;  #  Not a core module.
use FindBin qw [ $Script ] ; 
use Term::ANSIColor qw[ :constants color ] ; $Term::ANSIColor::AUTORESET = 1 ; 
use Encode ;# Encode was first released with perl v5.7.3
#$| = 1 ;
END{
  my $lt = sprintf '%04d-%02d-%02d %02d:%02d:%02d' , do {my @t = @{[localtime]}[5,4,3,2,1,0] ; $t[0]+=1900 ; $t[1]++ ; @t } ; 
  say STDERR CYAN FAINT BOLD tv_interval( ${ dt_start } ) , " seconds spent ($0 $lt)"; 
}

$SIG{INT} = sub { 
 say STDERR YELLOW FAINT BOLD UNDERLINE qq[Analysis using the function of the perl function `caller': ("~" means undefined.)] ;
 for ( 0..59 ) { 
    my @out = caller ($_)  ; 
    last unless @out ; 
    say STDERR YELLOW FAINT BOLD "$_ : " , map { $out[$_] //= '~' ; "[$_] $out[$_] " } 0..$#out ; 

 }
 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 ( ) {