view release on metacpan or  search on metacpan

dufolder  view on Meta::CPAN

#!/usr/bin/perl
# use 5.030 ; 
use strict ; 
use warnings ; 
use feature qw [ say state ] ;
use Cwd ; 
use File::Spec ; 
use Getopt::Std ; getopts '.,:b:i:l:B:G:' , \my %o ; 
use List::Util qw[ max sum0 ] ;
use POSIX qw [ strftime ] ; 
use Term::ANSIColor qw[ :constants ] ; $Term::ANSIColor::AUTORESET = 1 ;
binmode STDOUT , ':utf8' ;

$o{b} //= 512 ; # stat関数で1個のファイルのブロック数を得た場合に、それを何倍したら、ディスクを占有するバイト数になるか。
my $optI0 = 0 eq ($o{i} // '' ) ; # -i0の指定があるか否か。 inodeで一致するものは1個しか受け付けないようにする。
my $optL0 = 0 eq ($o{l} // '' ) ; # -l0の指定があるか否か。stat 関数を使うか lstat 関数を使うかを指定。
my $optc0 = 0 eq ($o{','}//'' ) ; # -,0の指定があるか否か。千進法区切りで,を使うか否かを指定。
$ARGV[0] = '.' if @ARGV == 0 ;

# 特殊な関数

sub d3 ($)  ; # 数を3桁区切りに変換することもできるようにする。# -,0が指定されたら3桁区切りにしない。
* d3 = $optc0 ? sub ( $ ) { $_[0] } : sub ( $ ) { $_[0] =~ s/(?<=\d)(?=(\d\d\d)+($|\D))/,/gr } ; 
sub xstat ( $ ) ; #{ lstat $_ } ; 
* xstat = $optL0 ? sub ( $ ) { stat $_ } : sub ( $ ) { lstat $_ } ; # if $optL0 ;

# メインとなる部分

my $datetime = strftime ( '%Y-%m-%d(%a) %H:%M:%S %Z(%z)', localtime () ) ; 
my @files ; # 探索したファイルを収納する。
my @visible ; # 非ドットファイルの全体。
my $d0 = cwd ; 
& getFiles ( $_ , \@files , \@visible ) for @ARGV ; 
if ( exists $o{B} ) { & fileDimTable ( $o{'.'} ? @files : @visible ) ; exit } 

& prepCommands ( \@files , \@visible , $datetime, my $msg , my $change , my $cmd1 , my $cmd2 ) ; # change はファイルの変更個数, 
do { say $msg ; exit } unless exists $o{G} ; # -Gの指定があればさらに続く。
if ( $o{G} =~ /0/ ) { say "$cmd1\n$cmd2" } ; # -Gに0があれば、コマンド文を表示
if ( $o{G} =~ /1/ ) { & againCheck ( $change ) and exit } ; # -G に1があれば、もしも前のコミットでこのコマンドでコミット済みなら終了。
if ( $o{G} =~ /[12]/ ) { do { my $out2 = qx[$cmd2] ; binmode STDOUT , ':raw' ; say "-- ->", BOLD $out2 //'' } } ; # コミット実行! 
exit ; 

# 上記を構造化するために切り出した関数

sub getFiles ( $ $$ ) { 
  state $inodes ;
  state $c2 = do { File::Spec -> catfile ( '' , '.' ) } ; # ディレクトリ階層の区切りの直後にドットがあるパターン "/."
  my @found = split /\n/ , qx [ find $_[0] ] , 0 ; # find コマンドで見つけたファイルを格納。
  @found = grep { ! $inodes -> { ( xstat $_ ) [ 1 ] } ++ }  @found if ! $optI0 ; # inodeで過去に一致したものは除去する
  push @{ $_[1] } , @found ;
  push @{ $_[2] } , grep { ! m/\Q$c2\E/ } @found ; 
}

sub prepCommands ( $$$ $$$$ ) { 
  sub sumdu ( @ ) { sum0 map { my @s = xstat $_ ; max ( $s[7] , $o{b} * $s[12] ) } @_ } # <-- Unixコマンドduと同じ事をしたつもり。
  my ($b1,$b2) = map { sumdu ( @{ $_ [ $_ ] } ) } 0 , 1 ; # バイト単位の数値なのでbを変数名に用いた。
  my ($l1,$l2) = map { scalar @{ $_ [ $_ ] } } 0 , 1 ; # 配列の長さ l 
  $_[3] = sprintf "du: %s / %s = %0.3f", d3 $b1, d3 $b2 , $b1 / $b2 ;
  $_[3] .= sprintf "  obj: %s / %s = %0.2f  -- %s", d3 $l1 , d3 $l2 , $l1 / $l2 , $_[2] ;
  $_[5] = qq[ git status > /dev/null 2>&1 && git diff --raw HEAD~..HEAD | wc -l # -- -> ] ; 
  $_[4] = (`$_[5]` =~ s/\n$//sr) ;
  $_[5] .= BOLD $_[4]  ;# 何個のファイルが HEADとその前の間で変更があったか。
  $_[6] = qq[ git commit --allow-empty -m '$_[3]' ] ; # --amend 
}

sub againCheck ( $ ) {
  if ( $_[0] eq 0 ) { # さらに確かさを高めるために、計2個の条件で調べる。
    my $p1 = qr | .* [0-9] .*/.* [0-9] .*=.* [0-9] .* |x ; # <-- 少し雑な条件かも。しかし、きちんと書くと、バグの元になりやすい。
    my $pattern = qr| du: $p1 obj: $p1 -- .*\d{4}-\d{2}-\d{2} .* \d{2}:\d{2}:\d{2} |x ; # 
    return 1 if qx [ git log -n1 --oneline ] =~ m/$pattern/s ;
  } ; 
}

sub fileDimTable ( @ ) { # -B8 で起動
  say join "\t" , qw[ dir? occ. Size bsize Blocks S/B(1) S/B(2) inode filename ] ;  
  do { my @s = stat $_ ; say join "\t" , -d $_ ? "D":"" , $s[12]*$o{b}, @s[7,11,12], & pratio ( @s[7,12] ) , $s[1], $_ } for @_ ;

  sub pratio ($$) { 
    my $o1 = $_[1] == 0 ? $_[0] == 0 ? "'0/0'" : '-' : sprintf '%1.2f' , $_[0] / $_[1] ; 
    my $o2 = $_[1] <= $o{B} ? 0 < $_[1] ? '+infty' : '-' : sprintf '%1.2f' , $_[0] / ( $_[1] - $o{B} ) ; 
    return ( $o1, $o2 ) ;# 〜 ↑ $o{B} つまり-Bで与える数が難しい状況があるかも。
  }
}

#   2022-03-01 thu ; Toshiyuki Shimono 下野寿之 (統計数理研究所 特任研究員)

## ヘルプの扱い
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 ;
  exit 0 ;
}