#!/usr/bin/perl
use
Term::ANSIColor
qw [
:constants color ] ;
$Term::ANSIColor::AUTORESET
= 1 ;
use
List::Util
qw [
max min sum sum0 reduce uniq ] ;
use
Cwd
qw [
getcwd abs_path ] ;
use
POSIX
qw[ strftime ]
;
my
$time_start
= [ gettimeofday ] ;
getopts
'~.:b:dHMmrS:x:y2'
, \
my
%o
;
push
@ARGV
,
$o
{x}
if
defined
$o
{x} ;
my
$start_dir
=
$ARGV
[0] //
"."
;
my
$I
= catfile
q[]
,
q[]
;
my
$d0
= ( getcwd ) .
$I
;
chdir
$start_dir
or
do
{
say
STDERR
"Seems no such a directory ``$start_dir''"
;
exit
-1 } ;
$d0
= (getcwd ).
$I
unless
exists
$o
{g} &&
$o
{g} =~ m/a/ ;
$d0
=
''
if
exists
$o
{g} &&
$o
{g} =~ m/A/ ;
& main ;
exit
0 ;
END{
print
RESET
""
} ;
sub
main () {
our
$fmt
=
$o
{y} ?
"%Y"
:
$o
{m} ?
"%Y-%m"
:
$o
{d} ?
"%Y-%m-%d"
:
$o
{H} ?
"%Y-%m-%dT%H"
:
$o
{M} ?
"%Y-%m-%dT%H:%M"
:
$o
{S} ?
"%Y-%m-%dT%H:%M:%S"
:
"%Y-%m-%d"
;
& node_proc ( 0 ) ;
& output () ;
sub
open_dir_error_message ( $ ) {
say
STDERR FAINT BOLD YELLOW
"Cannot open the directory `$_[0]' so skipped."
;
}
sub
node_proc ( $ ) {
my
$dep
=
$_
[0] ;
my
$mdep
=
$dep
;
our
(
%nA
,
%nM
,
%nC
) ;
our
(
%bA
,
%bM
,
%bC
) ;
opendir
my
$dh
,
'.'
or
do
{ open_dir_error_message ( abs_path
"."
) ;
return
() } ;
my
@nondir
;
my
@dirs0
=
readdir
$dh
;
@dirs0
=
grep
{ ! /\A\./ }
@dirs0
if
exists
$o
{
'.'
} &&
$o
{
'.'
} eq
"0"
;
@dirs0
=
grep
{ ! /\A\.{1,2}\Z/ && ( -d
$_
||
do
{
push
@nondir
,
$_
; 0 } ) }
@dirs0
;
my
@dirs
=
grep
{ ! -l
$_
}
@dirs0
;
for
(
@nondir
) {
my
@ti
= (
stat
) [ 7 .. 10] ;
my
$byte
=
shift
@ti
;
@ti
=
map
{ strftime
$fmt
,
localtime
$_
}
@ti
;
$nA
{
$ti
[0] } ++ ;
$nM
{
$ti
[1] } ++ ;
$nC
{
$ti
[2] } ++ ;
$bA
{
$ti
[0] } +=
$byte
;
$bM
{
$ti
[1] } +=
$byte
;
$bC
{
$ti
[2] } +=
$byte
;
}
return
unless
$o
{r} ;
for
(
@dirs
) {
next
unless
chdir
$_
;
$mdep
= max
$mdep
, & node_proc (
$dep
+ 1 ) ;
chdir
$dh
or
die
;
}
closedir
$dh
;
return
$mdep
;
sub
output () {
my
@t0
= (
"when"
,
"#accessed"
,
"#modified"
,
"#created"
) ;
push
@t0
,
"byteSum_A"
,
"byteSum_M"
,
"byteSum_C"
unless
exists
$o
{b} &&
$o
{b} eq
"0"
;
say
join
"\t"
,
@t0
;
my
@k
= uniq
sort
keys
%nA
,
keys
%nM
,
keys
%nC
;
@k
=
reverse
@k
if
$o
{
'~'
} ;
for
(
@k
) {
my
@t
= (
$_
,
$nA
{
$_
} ,
$nM
{
$_
} ,
$nC
{
$_
} ) ;
push
@t
,
$bA
{
$_
} ,
$bM
{
$_
} ,
$bC
{
$_
}
unless
exists
$o
{b} &&
$o
{b} eq
"0"
;
say
join
"\t"
,
map
{
$_
//
''
}
@t
;
}
}
}
END{
exit
if
exists
$o
{2} && (
$o
{2} eq
"0"
) ;
say
STDERR
" -- "
, REVERSE ITALIC
" Process time: "
, CLEAR
" "
,
sprintf
(
"%.6f"
, tv_interval
$time_start
, [ gettimeofday ] ) ,
" second(s)."
;
}
}
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
;
$o
{2} = 0 ;
exit
0 ;
}