The Perl and Raku Conference 2025: Greenville, South Carolina - June 27-29 Learn more

#!/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 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 ( $ ) {
# 第1引数は、元の指定ディレクトリからの深さであり、
# 返り値は、そこで経験した最大の深さである。
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{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 {
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{2} = 0 ;
exit 0 ;
}
=encoding utf8
=head1
 filedays [dirname]
カレントディレクトリまたは指定ディレクトリに含まれる通常ファイル全てについて、
各ファイルの日時情報3個(atime,mtime,ctme)を取り出し、それぞれ3つの日付ごとに
ファイルの個数とバイトサイズの合計を、出力する。
出力は7列のTSV形式のテーブルであり、
(1)日付 (2)atimeの日付ごとのファイルの個数 (3) mtime での個数 (4) ctime での個数
(5) atimeの日付ごとに該当するファイル全てのバイト数の合計 (6) mtime での合計 (7) ctimeでの合計
となる。オプションに寄り、日単位の日付だけでは無くて、月単位、年単位などに変更が可能。
※ UNIXコマンドの tabs -11 をあらかじめ実行すると、このコマンド filedays の実行結果が見やすいであろう。
オプション:
-y : 年単位で集計
-m : 月単位で集計
-d : 日単位で集計 (初期設定)
-H : 時単位で集計
-M : 分単位で集計
-S : 秒単位で集計
-. 0 : 隠しファイルを処理対象としないことの指定
-b 0 : バイト数の合計の出力の抑制の指定
-r : ディレクトリを再帰的に下に辿る。
-~ : 出力の時間順を逆にする。
-2 0 : 処理に要した秒数の情報の抑制の指定
=cut