touch-dirs

#!/usr/bin/env perl
# $Id: touch-dirs,v 1.9 2021年03月30日 08:00:14 tom Exp $
# Traverse the given directory tree(s), and set the modification time on each
# directory to match the newest file in the directory (or its subdirectories).
# Ignore symbolic links.
#
# This is used to make "identical" tarballs from a given directory at different
# times, using "archive -t".

use warnings;
use strict;

use Getopt::Std;
use File::stat;

use vars qw($opt_n $opt_v);

sub touch_dirs($) {
my $pathname = $_[0];
my $newest = 0;
my $modtime;
my $lnktime = 0;
my @list;
my $sb;
my $n;
my $dh;

printf "** %s\n", $pathname if $opt_v;

if ( opendir( DIR, $pathname ) ) {
@list = sort readdir(DIR);
closedir DIR;
}
else {
printf STDERR "can't opendir $pathname: $!\n";
return 0;
}

for $n ( 0 .. $#list ) {
next if ( $list[$n] eq "." );
next if ( $list[$n] eq ".." );

my $item = $pathname . "/" . $list[$n];

$sb = lstat $item;
next unless $sb;
if ( $sb->mode & 020000 ) { # symbolic link
my $sb2 = stat $item;
if ($sb2) {
printf "...links %s\n", scalar localtime $sb2->mtime if $opt_v;
$lnktime = $sb2->mtime if ( $lnktime < $sb2->mtime );
}
next;
}
else {
next unless ( -f $item or -d $item );
}

printf "%d:%s\n", $n, $item if $opt_v;
$modtime = $sb->mtime;
if ( $sb->mode & 040000 ) {
$modtime = &touch_dirs($item);
}
if ( $modtime > $newest ) {
printf "...newer %s\n", scalar localtime $modtime if $opt_v;
$newest = $modtime;
}
}

$newest = $lnktime if ( $newest == 0 );

if ( $newest ne 0 ) {
if ($opt_n) {
$sb = lstat $pathname;
if ( $sb->mtime ne $newest ) {
printf "...touch %s %s\n", scalar localtime $newest, $pathname;
}
}
else {
utime $newest, $newest, $pathname;
}
}
return $newest;
}

&getopts('nv');

if ( $#ARGV >= 0 ) {
while ( $#ARGV >= 0 ) {
&touch_dirs( shift @ARGV );
}
}
else {
&touch_dirs(".");
}