App-Bin4TSV

 view release on metacpan or  search on metacpan

scripts/chars2code  view on Meta::CPAN

#!/usr/bin/perl
use 5.014 ; use warnings ; 
use Getopt::Std ; getopts ":01bnuw" , \my%o ; 
use Term::ANSIColor qw[ :constants color ] ; $Term::ANSIColor::AUTORESET = 1 ;
use utf8 ; 
binmode STDOUT , ":utf8" ; #if ! $o{b} ; 
use Encode qw [ decode_utf8 encode_utf8 ] ; 
use FindBin qw [ $Script ] ; 
my $sdt = sprintf '%04d-%02d-%02d %02d:%02d:%02d', do{my @t= @{[localtime]}[5,4,3,2,1,0]; $t[0]+=1900; $t[1]++; @t } ; 
eval "use Encode::JP qw[decode encode];1" or die "Encode::JP cannot be loaded, so -w does not work. ($Script, $sdt)\n" if $o{w} ; 

# my $utf8 = Encode::find_encoding('utf8') ;
sub decode ($) ; 
sub encode ($) ;
* decode = $o{b} ? sub ($) { $_[0] } : $o{w} ? sub ($) { Encode::JP::decode('cp932',$_[0]) } : * decode_utf8 ;
#* encode = $o{b} ? sub ($) { $_[0] } : * encode_utf8 ;

scripts/colchop  view on Meta::CPAN

* trim = $o{v} ? * Text::VisualWidth::UTF8::trim : sub { substr ( $_[0], 0 , $_[1] ) } ; 

$| = 1 if $o{'!'} ; # オートフラッシュの設定　<- -- 必要か?
$o{h} //= 0 ; # 左から何列は手を加えないかを洗わす。
# 出力する文字列の長さの最大値と折り返し数の最大値
my ($tlen, $tmax) = do { ($o{g}//='') =~ m/(\d*)\D?(\d*)/ ; ( $1 || 6 , $2 // 2 || "Inf")  } ; 
#say STDERR $tlen,' ', $tmax;
my $existNext = $o{'.'} // '.' ; # また表示が足りない時に、セル末に挿入する文字列
my $iosep = $o{'/'} // "\t" ; # 入出力の区切り文字

binmode STDIN, ":encoding(utf8)" if ! $o{w} && $o{u} ;   # binmode の指定は、 substr関数に影響する。
binmode STDIN, ":encoding(cp932)" if $o{w} ; # <-- - SJIS <<? "cp932" 絵文字も考えたい
binmode STDOUT,":encoding(utf8)" if $o{u} || $o{w} ;  #$/ = "\r\n" if $o{W} ;

& main ; 
exit ; 

sub aLinOut ( @ ) { 
  my @cells ;
  for ( 1 .. $#_ ) { # 各マスの文字列について..  ( $_ は1始まりで左から何番目かを表す )
    push @cells , undef and next if ! defined $_[$_] ; # 未定義なら未定義として
    my $str = $_ <= $o{h} ? $_[$_] : trim ( $_[$_] , $tlen ) ; # -h で左からいくつかの列は保護する指定があれば、そのようにして ..
    $_[$_] =~ s/^\Q$str\E// ; 

scripts/colsummary  view on Meta::CPAN

$o{g} = 6 if ( ! defined $o{g} ) ; # 取り出す数
$| = 1 if $o{'!'} ;
* decode = $o{u} ? * decode_utf8 : sub ($){ $_[0] } ; #* encode = $o{u} ? * encode_utf8 : sub ($){ $_[0] } ; 
$o{'#'} = decode ( $o{'#'} ) if defined $o{'#'} ; 

my %fOut = (
j =>  [ map {UNDERLINE decode($_)} qw[列番号 値の異なり 数値化平均 列名 値の範囲 最頻値 最頻値の度数 ..テールの度数(重なり) 桁数範囲 ] ] ,
e =>  [ map {UNDERLINE $_ } qw[ cpos diff ave. name range frequent frequency ..lower(x_mul) digits] ] ) ; 

binmode *STDOUT , ':utf8' if $o{u} ;
alarm $sec ; 
push @ARGV , '-' unless @ARGV ; # 標準入力の追加
& eachFile ( $_ ) for @ARGV ;
exit 0 ;

sub eachFile ( $ ) {
  sub colnames( $ ) ; # -=の時に先頭行の情報を取り出す
  sub filePinfo ; # ファイル毎の2次情報(一行サマリ)
  sub ColFreq ( $$ ) ; # 第１変数はファイルハンドル 第２変数は参照 ;  各列の値の分布を取り出す
  my $FH = do { my $t = *STDIN if $_[0] eq '-' ; open $t, '<', $_[0] if!$t ; binmode $t , ':gzip(gzip)' if $o{z} ; $t } ; # ファイルハンドルの取得
  $rl = 0 ;
  my @colnames =  colnames $FH  if $o{'='} ; 
  my $maxCols = ColFreq $FH, my $colvals ; #my $colvals ; 各列の各データ値の度数を集計;$colvals->[列番-1]{データ値}=度数 
  close $FH  ;

  AlignOut @{ $fOut{$o{j}?'j':'e'} } if 0 ne ($o{0}//'') ; 
  defined $colvals->[$_] and ColStat $colvals->[ $_ ] , $colnames[$_] for 0 .. $maxCols - 1  ; # オプション -0 により全ての値が除外されることは起こりうる。 
  filePinfo ;
}

scripts/csel  view on Meta::CPAN

    @out = @tmp ; #print join ", " , map ( $_+1, @out) , "\n" ;
  }
 
  return [ @out ] ; 
}


# 各行の出力処理。 sCols関数を呼び出して、選択する。-n で列番号も付ける。
sub line ( ) { 
  chomp ; 
  $_ = decode_utf8 ( $_ ) if $isep eq '' ; # 入力がSTDINとは限らないので binmode を使わず decode_utf8
  my @F = split /$isep/ , $_ , $split_limit   ; #use Data::Dumper ; print scalar @F , Dumper [@F];  
  @F = map { $_ + 1 . ":$F[$_]" } 0 .. $#F  if $o{n} ;   # -n で列番号をコロンを付けて出力
  push @F , $emp ; # $F[-1] で参照する
  print join ( "$osep" , @F [ @{ sCols $#F } ] ) , "\n" ; 
}

# main 
sub main { 

  binmode STDOUT ,":utf8" if $isep eq ''  ; # 文字単位で処理する場合、utf8としての扱いをする。
  # 一行目かつ -= が指定された場合の処理
  if ( $o{'='} ) { 
      $_ = <> ; 
      chomp ;  
      my $c = 0 ;
      $colNamePos { $_ } = ++ $c  for split /$isep/ , $_ , $split_limit ; # <-- 分割文字列に気をつけたい
      $cream{ $_ } = [ expand $o{$_} ] for qw/p d h t/ ;    
      line ;  # <-- - 
  }
  else { 

scripts/csv2tsv  view on Meta::CPAN

  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} ; 

scripts/digitdemog  view on Meta::CPAN

use Term::ANSIColor qw/:constants color/ ;  $Term::ANSIColor::AUTORESET = 1 ;
use Time::HiRes qw/sleep usleep gettimeofday tv_interval/ ; # 5.7.3から
use Encode ;

#$SIG{INT} = sub { & info ; exit 130 } ;
my $time0 = [ gettimeofday ] ;
my ${binFlag} = 1 if defined $o{u} && $o{u} eq '0' ;

$o{'$'} //= 'end' ;  # 文字の終端を表す記号
$o{p} //= '' ;  # 文字を切り分けるパターン。正規表現
binmode STDOUT, 'utf8' unless $binFlag ;

sub main () ; 
* main = $o{L} ? * bylen : $o{S} ? * blanks : * normal ; # <-- mainの定義はここである。
& main ; 
exit 0 ;

# どんな種類の空白かを数えるモード:
sub blanks ( ) { 
  my $header = <> if $o{'='} ; 
  my %seen ; # 同じ行が来たかどうかの判定に使う。数が集計される。

scripts/expskip  view on Meta::CPAN

sub traverse ( ) { 
  my $fnFlag = @ARGV > 1 ; 
  while ( 1 ) { 
    my $fn = shift @ARGV  ; # ファイル名
    my $fh ; # ファイルハンドル
    if ( defined $fn ) { 
        open $fh , "<" , $fn or warn "File `$fn' does not open." and next ; 
    } else { 
        $fh = *STDIN ;
    }
    binmode $fh , ":gzip(autopop)" if $o{z}  ; 
    say $fn if $fnFlag ;
    eachFile $fh ; 
    close $fh ; 
    last if ! @ARGV  ;
    print "\n" ; # ファイル間の空行
  }
}

sub eachFile ( $ ) { 
  #$. = 0 ;

scripts/gzpaste  view on Meta::CPAN

exit 0 ; 


## 以下は関数。

sub files_open ( ) { 
	$SIG{INT} = sub { closing ; exit 130 } ; 
	for ( 0 .. $argnum - 1  ) { 
		if ( ! $o{g} ) { 
			open $FH [ $_ ] , '<' , $ARGV [ $_ ] ; # "<:gzip(gzip)"
			binmode $FH [ $_ ] , ':gzip(gzip)' ; # < -- 速度比較をせよ。
		}
		else { 
			open $FH [ $_ ] , '-|' , 'gzcat' , $ARGV[$_] ; # open $FH, "gzcat '$ARGV[$_]' |" より良いと思った
		}
	}
}

sub closing ( ) { 
	# ファイルを閉じる。
	close $_ for @FH ;

scripts/samesize  view on Meta::CPAN

  	my @files = sort @{ $s2f{$size} } ; # ファイルの一覧
  	@files = sort {(stat $a)[9] <=> (stat $b)[9] } @files if $o{n} // $o{o} ;
  	@files = reverse @files if $o{n} ;
  	my %seenD ; # 既に見たハッシュダイジェスト値
  	for ( @files ) { 
      my @t3 =  (stat $_)[8,9,10] ; # <-- stat にしたのを便宜上の変更

  	  my $ctx = Digest::MD5->new;
  	  unless ($o{0}){
  	    open my $FH, '<', $_ or die  "Can't open '$_': $!";
  	    binmode $FH ; 
	    $ctx->addfile( $FH );
	  #while ( <$FH> ) { $ctx -> add ( $_ ) }
	    close $FH ;
	  }

	  utime @t3[0,1] , $_ unless $o{0} ; # <- -- --- 時刻情報を破壊するので注意。もしくは秒の小数点以下の情報が消える。
      my $digest = $o{0} ? '---' : $ctx->hexdigest ;
      next if $o{2} && ! $seenD{ $digest } ++ ;
      if ( $o{D} && ! $o{0} ) { unlink $_ ; next } ; 
  	  my @out = ( sprintf ($nfmt , $size)  , $digest , map ( dtwhen $_ , @t3 ) , $_ ) ;

scripts/wc-l  view on Meta::CPAN

    if ( ! $o{g} ) { 
        open $FH , '<' , $_[0] 
      } else { 
        open $FH , '-|' , 'gzcat' , $_[0] ; 
        #open $FH [ $_ ] , '-|' , 'gzcat' , $ARGV[$_] ; # open $FH, "gzcat '$ARGV[$_]' |" より良いと思った
      }
  } else { 
    $FH = * STDIN 
  } ; 

  binmode $FH , ":gzip(gzip)" if $o{z} ; 

  my $header = <$FH> if $o{'='} ; # <-- 一応意味はある。-+ スイッチオプションで対応できないか? 
  my $ret = lineNum $FH ; 
  out1line ( $ret , $fn , $time0 ) ; 
  return $ret  ; 
}

#  ファイルハンドラから行数を返す。
sub lineNum ( $ )  {
  my $last_count = $. ; 

scripts/xlsx2tsv  view on Meta::CPAN

  my $converter = Text::Iconv -> new ("utf-8", ${ cc4iconv } ); # 1251 ---> 932 (shift_jis)
  my $excel = Spreadsheet::XLSX -> new ( $filename , $converter ) ; # (1)
  my @sheets = @{ $excel ->{ Worksheet } } ;  # (2)
  
  # シートの枚数を取り出す
  $o{d} //= '' ;
  ${ sheet_num } = @sheets ; 
  do { say scalar @sheets ; exit if ! defined $o{s} } if $o{d} =~ m's'i ; 

  ## まずシートを取り出す。-s が無ければシート名一覧を取得してすぐに終了。
  binmode STDOUT, ${ cc4out } ; # この分は$filenameの格納する文より後ろに来る。

  $o{s} = $o{s} || do { say for (GREEN 'The sheet names:'), map { decode ${ cc4sheet } , $_ -> { Name } } @sheets ; exit } ; 
  my $s = $sheets [ $o{s} - 1 ] ; # あるシートを表すオブジェクト
  ${ sheet_name } =  decode ${ cc4sheet } , $s -> { Name } ;
  # -dのパラメータに従ってテーブルの行と列の範囲を取り出す。
  ($r1, $r2 , $c1 , $c2 ) = ( $s->{MinRow} , $s ->{MaxRow} , $s -> {MinCol} , $s -> {MaxCol} ) ; # (3)
  say $r1+1 , ".." , $r2+1  if $o{d} =~ '1' ; # 行範囲の出力
  say $c1+1 , ".." , $c2+1  if $o{d} =~ '2' ; # 列範囲の出力
  say n2Xcol $c1 , ".." , n2Xcol $c2  if $o{d} =~ m'A'i ; # -A指定で、列範囲を A,..,Z,AA..ZZで換算して表示
  exit if $o{d} =~ m/0/ || defined $o{p} && $o{p} eq '0' ;