#!/usr/bin/perl 
use v5.8.3 ; use strict ; use warnings ; # Already confirmed that 5.001, 5.011, 5.018 is ok.
use List::Util qw[ sum sum0 ] ; 
use Getopt::Std ; getopts ':1efkl:nqrsx:y:=%/:@:' , \my %o  ; 
use Term::ANSIColor qw/color :constants/ ; $Term::ANSIColor::AUTORESET = 1 ;
use FindBin qw[ $Script ] ; 
use autodie qw [ open ] ;
use POSIX qw[ pause ] ;

sub readKeyList ( ) ; # 別ファイルに読み取るべき、行が指定されている場合を想定している。
sub reading ( ) ; # 1. 読む
sub output ( ) ; # 2. 出力する

my $time0 = time ; 
#my $cyc_len = $o{'@'} // 1e7 ; # 何行毎にレポートを発生させるか。
my %strcnt ; # 数える対象の文字列(各行から最後の改行文字列を取り除いたもの) に対して、数えた数を入れる。
my %strcntX ; # $strcntX{$_}{$tail} で度数を表す。
my %strfst ; # 最初の出現位置を保持
my %strlst ; # 最後の出現位置を保持
my $first = <> if $o{q/=/} ;
my $isep = $o{'/'} // "\t" ; # //= do { $o{','} //= "\t" ; eval qq[qq[$o{','}]] } ; # 入力の区切り文字 
my $osep = "\t" ; # 出力用セパレータ
my $readLines ; # 読み取った行数
my @givenL ;   
my %gl ; # 個数を数える対象を指定されて場合は、それを読み取る。

my $sec = $o{'@'} // 15 ; # 何秒おきにアラームを発生させるか

$SIG{ALRM} = sub { 
    (my $n=$.) =~ s/(?<=\d)(?=(\d\d\d)+($|\D))/,/g ; # 3桁ごとに区切る。
    print STDERR GREEN "$n lines read. " , scalar localtime , " " , RESET "\n" ; 
    alarm $sec 
} ; 
sub IntFirst {
    &{ $SIG{ALRM} } ;
    print STDERR BRIGHT_RED 
     'Do you want to get the halfway result? Then type Ctrl + \ again within 2 seconds. '. "\n" .
     'Really want to Quit? Then press Ctrl + "\" or Ctrl + Yen-Mark after 2 seconds later. ' . RESET "\n" ;
    local $SIG{QUIT} = sub { select *STDERR ; & output ; select *STDOUT } ;
    sleep 2 ; # eval { local $SIG{ALRM} = sub { alarm $sec ; die } ; alarm 2 ; 1 while 1  } ; 
    #$SIG{INT} = 'IntFirst' ;
    #return ;
} ;
$SIG{INT} = 'IntFirst' ;

& readKeyList if $o{l} ;
alarm $sec ;
& reading ;  ### 1. 読む
& output ;  ### 2. 出力する
exit ;

sub readKeyList ( ) { 
    open my $FH , '<' , $o{l} ; while ( <$FH> ) { chomp ; push @givenL, $_ ; $gl { $_ } = 1 } ; close $FH ; 
}

# 読取り
sub reading ( ) { 

    our $timec = time ; 
    our $intflg ;

    # -x オプションの扱い
    sub treat_x { 
        my @F = split /($isep)/, $_ , $o{x} + 1  ; 
        $_ = join '' , splice @F, 0 , 2 * $o{x} - 1 ;
        shift @F ; 
        my $tail = join '' , @F ; # , $o{x} , 1 ; # pop @F ; 
        $strcntX { $_ }{ $tail } ++ ;
    }

    sub fcntbare { $strcnt { $_ } ++ }
    sub fcntfilt { $strcnt { $_ } ++ if exists $gl { $_ } }
    sub fcntbareC { $strcnt { $_ } ++ ; $strfst { $_ } //= $. ; $strlst { $_ } = $. }
    sub fcntfiltC { if(exists $gl{$_} ){ $strcnt { $_ } ++ ; $strfst { $_ } //= $. ; $strlst { $_ } = $. } } 
    sub fcnt ; 

    * fcnt = * fcntbare if ! exists $o{l} ; 
    * fcnt = * fcntfilt if exists $o{l} ;
    * fcnt = * fcntbareC if ! exists $o{l} && $o{':'} ; 
    * fcnt = * fcntfiltC if exists $o{l} && $o{':'} ;

    if ( ! $o{x} ) { while ( <> ) { chomp ; fcnt } }
    if (   $o{x} ) { while ( <> ) { chomp ; treat_x ; fcnt } } 

    $readLines = $. ;
}
 
sub output ( ) { 

    our @y_ranges = () ; # 出力される値の範囲が指定された場合の挙動を指定する。
    # 次の2個の関数は、出力すべき値の範囲をフィルターの様に指定する。
    sub y_init ( ) { 
         my @ranges = split /,/ , $o{y} // '' , -1 ; 
        grep { $_ = $_ . ".." . $_ unless m/\.\./ }  @ranges ; # = split /,/ , $o{y} // '' , -1 ; 
        do { m/^(\d*)\.\.(\d*)/ ; push @y_ranges , [ $1||1 , $2||'Inf' ] } for @ranges ; 
    }
    sub y_filter ( $ ) { 
        do { return not 0 if $_->[0] <= $_[0] && $_[0] <= $_->[1] } for @y_ranges ; 
        return @y_ranges ? not 1 : not 0 ; # 指定が無かった場合はとにかく真を返す。
    }
    
    y_init  ; 

    # キー集合、特にその順序の調整 
    my @k ;
    @k = defined $o{l} ? @givenL : sort keys %strcnt ; # <-- - ここの sort を消そうかどうか迷った。
    @k = sort { $strcnt{$a} <=> $strcnt{$b} } @k if $o{f} ;  # -f オプションによりコンテンツの数であらかじめ、ソートする 
    @k = sort { $a cmp $b } @k if $o{k} ;  # -k オプションによりキー文字列であらかじめ、ソートする 
    @k = sort { $a <=> $b } @k if $o{n} ; # -n オプションによりキー文字列であらかじめ、ソートする 
    @k = reverse @k if $o{r} ;   # r オプションで逆順ソート
    our $totalSum = sum0 ( values %strcnt ) ; # 総行数の格納。
    our $outLines = 0 ; # 出力した行数
    our $cumsum =  0  ; # 累和カウンタ

    # 書き出し
    #my $header ; 
    my $header = "LINE_STR" unless defined $first ; 
    $header = "FREQ" . $osep . $header ; 
    $header = "RATIO" . $osep . $header if $o{'%'} ; 
    $header = "ACCUM" . $osep . $header if $o{'s'} ;
    $header = "CUMRA" . $osep . $header if $o{'s'} && $o{'%'} ;
    $header = "WHERE" . $osep . $header if $o{':'} ; 
    $header = $header . $osep . "RIGHT_FIELDS.." if $o{x} ;
    $header .= "\n" ;
    $o{'='} ? print $header : $o{q} ? 0 : print STDERR GREEN $header ;  


    for ( @k ) { 

        sub tailx {
            my @keys = sort {  $strcntX{$_}{$b} <=> $strcntX{$_}{$a} } keys %{ $strcntX{ $_ } } ; 
            my $out = '' ; 
            for my $k ( @keys ) { $out .= "\t[$k]x$strcntX{$_}{$k}" } ; 
            return $out ; 
        }

        sub headS { 
            $cumsum += $strcnt { $_ } ;
            return $cumsum . sprintf ( "\t%5.2f%%", 100.0 * $cumsum / $totalSum) if $o{'%'} ;   
            return $cumsum ;
        }

        sub headW { 
            $strfst{$_} //= 0 ; 
            $strlst{$_} //= 0 ; 
            return "$strfst{$_}-$strlst{$_}:" ; 
        }

        $strcnt{ $_ } //=  0 ;
        next unless y_filter ( $strcnt{$_} ) ; 
        print headW () , "\t" if exists $o{':'} ; # -: オプションにより、どの行番号で現れたのかを出力。
        print headS () , "\t" if exists $o{s} ; # -s オプションにより、累和を表示。 
        printf "%5.2f%%$osep", 100.0 * $strcnt{$_} / $totalSum if $o{'%'} ;  
        print $o{1} ? $_ : $strcnt{$_} . $osep . $_ ; # -1オプションがあれば個数を表示しない。
        print tailx()  if exists $o{x} ; 
        print "\n" ;
        $outLines ++ ; 
    } 

    my $procsec = time - $time0 ; # このプログラムの処理にかかった秒数。比較する2個の時刻は秒単位なので、±1秒未満の誤差は発生する。
    $readLines //= $. ; # Ctrl+Cの連打で必要となる処理。

    return if exists $o{q} ; 
    print STDERR CYAN "$readLines lines processed. " ; 
    print STDERR CYAN "$totalSum lines are counted. " ; 
    print STDERR CYAN "$outLines lines output. " ; 
    print STDERR CYAN "($Script ; $procsec sec.)\n" ;
}

## ヘルプの扱い
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 datafile 
  $0 < datafile 
  cat datafile | $0 

オプションに関して

 [入力に関係するオプション]
 
    -= : 先頭行をヘッダ(列名の並びなどでありデータでは無い)と見なして処理
    -@ num : 入力ファイルを読む際に、何行毎に標準エラー出力に報告を出すか。未指定なら1000万行毎。
    -l ファイル名 : 個数を数える文字列の対象を含んだファイル名を指定する。出力順序がファイルの各行に記載の順序になる。
    -l は、プロセス置換 <( ) を使うと便利。; -l により、メモリを節約できる。; -l と -@ が共にあると、見つかった行数しかざたない。

 [出力のオプション]

    -f : 出現数で整列する    -fr なら逆順にする
    -k : キー文字列で整列する    -kr なら逆順にする
    -n : キー文字列を数と見なして整列する    -nr なら逆順にする
    -r : 上記を逆順にする。

    -s : 累和を出力
    -% : データ件数全体に対する割合を出力
    -1 : 個数を出力しない。出現したキー文字列のみ出力。
    -q : 最後の二次情報を出力しない。

    -y 数値範囲 : 頻度が指定回数のもののみ出力。例 -y 1..3 なら3以下。 3.. なら3以上。2,4,6..8 なら2と4と6,7,8。

 [派生のオプション]
     -x 切断位置 ; 
     -, str ; 入力区切り文字
 

その他: 
  * freqfreq のような、頻度の頻度を出力するオプションを作りたい。オプションは -F で表したい。
  * Ctrl+Cの挙動を文書化したい。
=cut
