#!/usr/bin/perl
use
Getopt::Std ; getopts
'cf:g:i:nkKqrvy:=~@:'
,\
my
%o
;
use
Term::ANSIColor
qw/:constants color /
;
$Term::ANSIColor::AUTORESET
= 1 ;
sub
Reading ( ) ;
sub
Resulting ( ) ;
sub
sigint1 ( ) ;
sub
sigint2 ( ) ;
sub
cyc_rep ( ) ;
sub
y_init ( ) ;
sub
y_filter ( $ ) ;
my
$cyc_len
=
$o
{
'@'
} // 1e7 ;
my
(
$time0
,
$time00
) = (
time
) x 2 ;
my
@y_ranges
;
my
%kv
;
$o
{f} //= 1 ;
y_init ;
Reading ;
Resulting ;
exit
;
sub
Reading ( ) {
$SIG
{INT} = \
&sigint1
;
$o
{i} //=
"\t"
;
my
$isep
=
eval
qq[qq[$o{i}]
] ;
<>
if
$o
{
'='
} ;
while
( <> ) {
chomp
;
my
@F
=
split
/
$isep
/o,
$_
,
$o
{f} + 1 ;
my
$k
=
join
$isep
,
splice
@F
, 0 ,
$o
{f} ;
my
$v
=
$F
[0] //
''
;
(
$k
,
$v
) = (
$v
,
$k
)
if
$o
{
'~'
} ;
$v
=
defined
$v
?
$v
:
'#undef#'
; # <-- - 列が足りない時に現れる
$kv
{
$k
}{
$v
} ++ ;
cyc_rep
if
$cyc_len
&& $. %
$cyc_len
== 0 ;
}
}
sub
Resulting ( ) {
$SIG
{INT} =
sub
{
print
color(
'reset'
) ;
die
} ;
my
@k
=
keys
%kv
;
if
(
$o
{n} ) {
@k
=
sort
{
$kv
{
$a
} <=>
$kv
{
$b
} }
@k
}
elsif
(
$o
{K} ) {
@k
=
sort
{
$a
<=>
$b
}
@k
}
elsif
(
$o
{k} || 1 ) {
@k
=
sort
{
$a
cmp
$b
}
@k
}
else
{ 1 } ;
@k
=
reverse
@k
if
$o
{r} ;
my
$count
= 0 ;
for
(
@k
){
my
@values
=
keys
%{
$kv
{
$_
}} ;
next
unless
y_filter
scalar
@values
;
my
@out
;
push
@out
,
$_
,
scalar
@values
;
push
@out
, ( sum
values
%{
$kv
{
$_
}} ) .
'#'
if
$o
{c} ; # -c オプションにより、 各キーの単純な出現回数を表示する。
push
@out
, minstr(
@values
) ,
'..'
, maxstr(
@values
)
if
$o
{v} ;
push
@out
,
':'
,
sort
splice
@values
, 0 ,
$o
{g}
if
$o
{g} ;
print
join
(
"\t"
,
@out
) ,
"\n"
;
}
my
$sec
=
time
-
$time00
;
(
my
$Rlines
= $. ) =~ s/(?<=\d)(?=(\d\d\d)+($|\D))/,/g ;
print
STDERR CYAN
"$Rlines lines processed. ($Script ; $sec sec.)\n"
unless
$o
{
q} ;
}
sub
sigint1 ( ) {
alarm
0 ;
print
STDERR YELLOW
"$.-th line processing. "
,
scalar
localtime
() ,
"\n"
;
$SIG
{ALRM} =
sub
{
$SIG
{INT} = \
&sigint1
} ;
alarm
4 ;
$SIG
{INT} = \
&sigint2
;
} ;
sub
sigint2 ( ) {
alarm
0 ;
print
color(
'cyan'
) ; Resulting ;
print
color(
'reset'
) ;
$SIG
{ALRM} =
sub
{
$SIG
{INT} = \
&sigint1
} ;
alarm
4 ;
$SIG
{INT} =
sub
{
die
}
} ;
sub
cyc_rep ( ) {
$| = 1 ;
my
$num
= $. ;
$num
=~ s/(?<=\d)(?=(\d\d\d)+($|\D))/,/g ;
print
STDERR GREEN
$num
,
":\t"
,
sprintf
"%02d:%02d:%02d"
, (
localtime
)[2,1,0] ;
print
STDERR
"\t"
, GREEN
time
-
$time0
,
" sec.\t($Script)"
;
$time0
=
time
;
print
STDERR
"\n"
;
}
sub
y_init ( ) {
$o
{y} //=
''
;
my
@ranges
=
split
/,/ ,
$o
{y} , -1 ;
grep
{
$_
=
$_
.
".."
.
$_
unless
m/\.\./ }
@ranges
;
for
(
@ranges
) {
m/^(\d*)\.\.(\d*)/ ;
push
@y_ranges
, [ ( $1 || 1 ) , ( $2 ||
"Inf"
) ] ;
}
}
sub
y_filter ( $ ) {
return
not 0
unless
@y_ranges
;
for
(
@y_ranges
) {
return
not 0
if
$_
->[0] <=
$_
[0] &&
$_
[0] <=
$_
->[1] ;
}
return
not 1 ;
}
sub
VERSION_MESSAGE {}
sub
HELP_MESSAGE{
$ARGV
[1] //=
''
;
open
my
$FH
,
'<'
, $0 ;
while
( <
$FH
> ){
s/\$0/
$Script
/g ;
print
$_
if
$ARGV
[1] eq
'opt'
? m/^\ +\-/ : s/^=head1// .. s/^=cut// ;
}
close
$FH
;
exit
0 ;
}