view release on metacpan or  search on metacpan

scripts/fileday  view on Meta::CPAN

#!/usr/bin/perl 
use 5.014 ; use strict ; use warnings  ;
use feature qw [ say ] ;
use Time::HiRes qw[gettimeofday tv_interval] ; 
use Term::ANSIColor qw [ :constants color ] ; $Term::ANSIColor::AUTORESET = 1 ; 
use File::Spec::Functions qw[ catfile splitdir rel2abs updir ] ; 
use Getopt::Std ; 
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:dHMmrSv:x:y' , \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 ; # plain files ; 
    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 ;
    }

    ## print CYAN "@nondir" ;
    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{v} && $o{v} eq "0" ;
    say STDERR " --  " , REVERSE ITALIC " Process time: " , CLEAR " " , 
     sprintf( "%.6f", tv_interval $time_start , [ gettimeofday ] ) , " second(s)." ;
  }
}

## ヘルプの扱い
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 ;
    $o{v} = 0 ;
    exit 0 ;
}

=encoding utf8
=head1

　$0 [dirname]
    

 オプション: 

  -y : 年単位で集計
  -m : 月単位で集計
  -d : 日単位で集計 (初期設定)
  -H : 時単位で集計
  -M : 分単位で集計
  -S : 秒単位で集計

  -. 0 : 隠しファイルを処理対象としないことの指定
  -b 0 : バイト数の合計の出力の抑制の指定
  -r : ディレクトリを再帰的に下に辿る。
  -~ : 出力の時間順を逆にする。
  -v 0 : 処理に要した秒数の情報の抑制の指定