view release on metacpan or  search on metacpan

scripts/colorplus  view on Meta::CPAN

0.31  (2018-07-10)

=head1 SYNOPSIS

 colorplus [-0] [-n N|-3|-4] [-c colorname] [-e N[,N[,N..]]] [-l N] [-s REGEX] [-t N] [-/ char]
 colorplus [--help [opt|en]] [--version]

=head1 DESCRIPTION

Put colors (ASCII color escape sequnces) parts on text data such as numerical parts, 
columns cyclically, text matching specific regular expressions. Useful to look around
CSV/TSV files with a pager LESS (less -R).

=head1 OPTIONS

=over 4

=item B<-0> 

Remove colors (remove all the ASCII color escape sequences). 

=item B<-n> N

Put colors on numerical characters. Every neighboring N digits from the bottom of a numerical 
character sequence has a same color. Cyan, green, yellow are used to colorize. 

=item B<-3>

Same as the specification B<-n 3>.

=item B<-4>

Same as the specification B<-n 4>.

=item B<-c> colorname

Speficy the colorname. It can be "blue", "red", "yellow", and also "on_while", "underline" and so on.
See the ASCII color escape sequences.

=item B<-e> N,N,...

Any operation by "colorplus" is exemplified on the lines specified by the number(s) beginning from 1. 
-0 is also cancelled on the specified lines, thus in this case, the input color on the specified line 
will survive.

=item B<-l> N

One line from every N lines are colored. The default color : "on_blue".

scripts/csv2tsv  view on Meta::CPAN

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 ;