view release on metacpan or  search on metacpan

expskip  view on Meta::CPAN

  do { say STDERR RED "Specify the parameter for `-T' such as `$0 -T 1m'."  ; exit } if ! defined $arg ;
  my $cmd = '' ;
  do { 
    no warnings 'experimental::smartmatch' ;
    $cmd = "seq 20 | $0"           when '20' ; # -T 20 で "expskip" に seq 20 の結果を与える。
    $cmd = "seq 20 | $0 -f5"       when 'f5' ; # -T f5 で "expskip -f5" をシミュレート
    $cmd = "seq 20 | $0 -p0"       when 'p0' ; # -T p0 で "expskip -p0" をシミュレート
    $cmd = "$0 <(seq 4) <(seq 10)" when 'm2' ; # -T m2 で、複数のファイルを与える。
    $cmd = "seq 1e6 | $0"          when '1m' ; # -T 1m で "expskip" に 100万までの数を与える。
    $cmd = "seq 1e5 | $0 -e0"      when 'e0' ; # -T e0
    $cmd = "seq 1e5 | $0 -f5"      when 'f5' ; # -T f5
    $cmd = "seq 100 | tr 0-9 A-H | $0 -: 'yellow green bold italic'" ; # -T ac で、数字以外と行番号の色づけを同時にテスト。
    $cmd = "seq 1e7 | $0"          when 'E7' ; # -T E7 で 1000万までの数を与える。なお、seq 1e7が1e7+1の数を与える。
  } for $arg ; 
  $cmd = join " " , $cmd , @ARGV [ $A0 .. $#ARGV ] ;  # <-- @ARGV に'や"があると思ったように動作しないであろう。
  say STDERR YELLOW BOLD ">  $cmd" ;
  system $cmd ;
  exit ;
}

getopts "::2:b:e:f:tp:zA:B:T:",\my%o ; # <-- -T以外のオプションを読み取る。(ただし動作検証のため、Tはここに残した。)
eval "use PerlIO::gzip;1" or die "Can't import PerlIO::gzip despite -z instruction. ($Script)\n" if $o{z} ; 
sub lineOut ( $ ) ; # lineOutのような関数名いくつかのうち、どれかが使われる。
sub eachFile ( $ ) ; 
sub fitCheck ( $ ) ; 
$| = 1 ; #  <- 毎回フラッシュ(使われる状況を考えると多分これで良いと思われる。) 
$o{b} //= 10 ; # 基数の指定。base 
$o{e} //= 2 ;  # 最初と最後のそれぞれ何行を出力するか。Edge 
$o{f} ||= 1 ;  # 開始行を指定する。0でもundefでも値が1になるようにする。from 
$o{A} //= 0 ;  # 合致する行の何行後までさらに続けて出力するか After 
$o{B} //= 0 ;  # 合致する行の何行前にさかのぼって続けて出力するか Before
my (@nums0, @nums) ; # 何行目を-bと-pの機能で出力するかについての行番号を保管。0はマスターを意味する。
my $oc ; # 各ファイルで出力した行を数える。

# (出力する)書式の指定 : 各関数は、どれも、1個だけの引数だが、それが無名配列の[行番号,その行の文字列]である。
sub lineOutFnc ( $ ) ; # lineOutのような関数名いくつかのうち、どれかが使われる。テンプレート..と言えば良いかな.
sub lineOutColon ( $ ) { $oc++ ; $_[0][0], ":\t", $_[0][1] }   # 行番号にコロン(:) を付加して出力
sub lineOutCouleur ( $ ) { $oc++ ; color($o{':'}) . "$_[0][0]:" . color('reset') . "\t", $_[0][1] }    # G 
sub lineOutBlunt ( $ ) { $oc++ ; $_[0][1] }   
sub lineOutTime ( $ ) { sprintf("%02d:%02d:%02d\t", @{[localtime]}[2,1,0]), lineOutFnc $_[0] } # <- これだけlineOutFncを中に含む。
* lineOutFnc = ($o{':'}//'')eq"0"? * lineOutBlunt : (exists$o{':'}) ? * lineOutCouleur : * lineOutColon ; 
* lineOut = $o{t}? *lineOutTime : * lineOutFnc ;

@nums0 = do { 
  my %t =(0=>['Inf'],1=>[1],2=>[1,2,4,8],5=>[1,2,5],7=>[1,1.5,2,3,5,7],8=>[1,1.5,2,3,5,8],9=>[1..$o{b}-1]) ; 
  do { say STDERR BOLD RED "-p should has a parameter in {0,1,2,5,7,8,9}" ; exit } if exists $o{p} && !defined $t{$o{p}} ; 
  my @t = @{$t{$o{p}//1}} ; 
  grep {$_ < $o{b} || $_ == 'Inf'} @t 
} ;

& procFiles ; # 複数のファイルも想定して処理。
exit 0 ;

sub procFiles ( ) { # 複数のファイルも想定して処理
  my $files = @ARGV ;
  do {
    my $fileName = shift @ARGV  ; # ファイル名
    my $FH ; # ファイルハンドル
    open $FH , "<" , $fileName or warn "File `$fileName' does not open." and next if defined $fileName ; 
    $FH = *STDIN if ! defined $fileName ; 
    binmode $FH , ":gzip(autopop)" if $o{z}  ; # <-- autopop とは?
    say UNDERLINE $fileName if $files >= 2 ; # ファイルが2個以上指定されていたら、ファイル名を表示する。
    & eachFile ( $FH ) ; 
  } while @ARGV 
}

sub eachFile ( $ ) { # 1個のファイルに対する処理(引数はファイルハンドル。STDINの場合もある。)
  @nums = @nums0 ;
  my $FH = $_[0] ; 
  my $ready ; # この数が正なら出力する。→ 仕組みは、キリの良い数などのトリガーにより、一定値が格納されて、1ずつ減る。
  my @stockLines = () ; # いくつかの行の、文字列を格納する。
  $oc = 0 ; # 出力した行の数を数えるのでここでリセット。
  # 1. 最初の方は、まず一定量読む。
  do { while ( <$FH> ) { last if $. +1 >= $o{f} } } if $o{f} >= 2 ; 
  do { while ( <$FH> ) { push @stockLines , [ $. , $_ ] ; last if @stockLines >= $o{e} } } if $o{e} > 0 ; 
  print lineOut $_ for @stockLines ;
  my $firstEnd = @stockLines ? $stockLines[-1][0] : 0 ; # 最初の段階で読んだ最後の行の行番号
  # 2. 条件に一致するもののみ出力する。
  while ( <$FH> ) { 
     push @stockLines , [ $. , $_ ]  ; # pushとshiftを対にしてFIFOのような仕組み
     my $theNext = shift @stockLines ; 
     $ready = fitCheck $$theNext[0] ? $o{A} + 1 : 0 ;
     print lineOut $theNext if $ready -- > 0  &&  $$theNext[0] > $firstEnd ; 
  }
  # 3. 残っているものを書き出す
  print lineOut $_ for grep { $$_[0] > $o{e} } @stockLines ; 
  # 4. 標準エラー出力に二次情報を書き出す。
  my $n = $. =~ s/(?<=\d)(?=(\d\d\d)+($|\D))/,/gr ;
  my $msg = "-- $n lines are read and $oc lines are output. To suppress this message on STDERR, run as `$Script -20'. " ;
  say STDERR FAINT BOLD $msg if 0 ne ($o{2}//'') ;
}

sub fitCheck ( $ ) { # 行番号を引数に与える。すると、それが出力可能に該当するかを判定する。@numsを暗黙に操作している。
    my $head = shift @nums ;    # 数珠を回すようなイメージで処理をする
    while ( $head < $_[0] ) { push @nums , $head * $o{b} ; $head = shift @nums }
    if ( $head < $_[0] + 1 ) { push @nums , $head * $o{b} ; return $_[0] >= $o{f} } # 
    unshift @nums, $head ; 
    return $_[0] >= $head - $o{B} && $_[0] <= $head + $o{A} && $_[0] >= $o{f} ;  
}

## ヘルプの扱い
sub VERSION_MESSAGE {}
sub HELP_MESSAGE {
    use FindBin qw[ $Script ] ; 
    $ARGV[1] //= '' ;
    open my $FH , '<' , $0 ;
    while(<$FH>){
        s/\$0/$Script/g ;
        print $_ if s/^=head1// .. s/^=cut// and $ARGV[1] =~ /^o(p(t(i(o(ns?)?)?)?)?)?$/i ? m/^\s+\-/ : 1;
    }
    close $FH ;
    exit 0 ;
}

=encoding utf8

=head1

 $0 [-z] [-B 0] [-A 0] [-p 1] [-f 1] [-e 2]  

   大きなテキストファイルの全体を把握しやすくするため、