#! env perl
use
Term::ANSIColor
qw[ color :constants ]
;
$Term::ANSIColor::AUTORESET
= 1 ;
eval
"use PerlIO::gzip;1"
or
die
"Can't import PerlIO::gzip despite -z instruction. ($Script)\n"
if
$o
{z} ;
sub
lineOut ( $ ) ;
sub
eachFile ( $ ) ;
sub
niceNumber ( $ ) ;
$| = 1 ;
my
(
@nums0
,
@nums
) ;
$o
{b} //= 10 ;
$o
{e} //= 2 ;
$o
{f} //= 1 ;
$o
{A} //= 0 ;
$o
{B} //= 0 ;
& Init ;
& traverse ;
exit
0 ;
sub
Init ( ) {
sub
lineOutSub ( $ ) ;
sub
lineOutColon ( $ ) {
$_
[0]->[0],
":\t"
,
$_
[0]->[1] }
sub
lineOutG ( $ ) { GREEN
$_
[0]->[0] , RESET
"\t"
,
$_
[0]->[1] }
sub
lineOutQ ( $ ) {
$_
[0]->[1] }
sub
lineOutTime ( $ ) {
sprintf
(
"%02d:%02d:%02d\t"
, @{[
localtime
]}[2,1,0]), lineOutSub
$_
[0] }
* lineOutSub =
$o
{g} ? * lineOutG :
$o
{
q} ? * lineOutQ : * lineOutColon ;
* lineOut = $o{t}
?
*lineOutTime
: * lineOutSub ;
select
* STDERR
if
$o
{E} ;
@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]) ;
my
@t
= @{
$t
{
$o
{p}//1}} ;
grep
{
$_
<
$o
{b} ||
$_
==
'Inf'
}
@t
} ;
}
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 ( $ ) {
@nums
=
@nums0
;
my
$fh
=
$_
[0] ;
my
$rd
;
my
@stockLines
;
* flag_E =
$o
{E} ?
sub
{
print
STDOUT
$_
} :
sub
{} ;
if
(
$o
{e} > 0 ) {
while
( <
$fh
> ) {
& flag_E ;
push
@stockLines
, [ $. ,
$_
] ;
last
if
$. >=
$o
{e} ;
}
}
print
lineOut
$_
for
@stockLines
;
while
( <
$fh
> ) {
& flag_E ;
push
@stockLines
, [ $. ,
$_
] ;
my
$lf
=
shift
@stockLines
;
$rd
=
$o
{A}+1
if
niceNumber
$lf
->[0] ;
print
lineOut
$lf
if
$rd
-- > 0 &&
$lf
->[0] >
$o
{e} ;
}
print
lineOut
$_
for
grep
{
$_
->[0] >
$o
{e} }
@stockLines
;
}
sub
niceNumber ( $ ) {
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 {
$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 ;
}