#!/usr/bin/perl use strict; use warnings; die "Arguments missing: $0 [-c] \n" unless @ARGV; my $clear; if ( $ARGV[0] eq "-c" ) { $clear = 1; shift @ARGV; } my $chroot = shift @ARGV or die "chroot directory not specified\n"; my $spec = shift @ARGV or die "Spec file not specified\n"; -d $chroot or die "chroot '$chroot' is not a directory\n"; -r $spec or die "spec file '$spec' is not readable\n"; my @rpms; open F_IN, "<", $spec or die "Cannot open '$spec'\n"; while ( ) { if ( /^\s*(?:%\{.*)?BuildRequires:\s*(\S+)/i ) { local $_ = $1; s/}$//; push @rpms, $_; } elsif ( /^%(prep|build|changelog)/ ) { last; } } close F_IN; sub clear_files { my $rpm = shift; my $files = shift; foreach my $file ( @$files ) { chop $file; my $f = $chroot.$file; local $_; while ( $_ = readlink $f and m#^/# ) { $f = $chroot.$_; } # skip missing files, like "%_excludedocs 0" being active next unless stat $f; # XXX: this truncates mtime to its low resolution value my $mtime = (stat $f)[9]; warn "Mtime failed on $f" unless $mtime; utime 0, $mtime, $f; } } sub check_files { my $rpm = shift; my $files = shift; #my $used = 0; foreach my $file ( @$files ) { chop $file; my $f = $chroot.$file; local $_; while ( $_ = readlink $f and m#^/# ) { $f = $chroot.$_; } my $atime = (stat $f)[8]; if ( not defined $atime ) { print "$rpm: $f no atime\n"; } elsif ( $atime > 0 ) { #print "$rpm: $file accessed\n"; #$used = 1; return; } else { #print "$rpm: $file NOT accessed !\n"; } } print "$rpm may be superfluous !\n";# unless $used; } sub rpm { my @cmd = ("rpm", "--root=$chroot", @_); open my $fh, '-|', @cmd or die "$!: @cmd"; my @data = <$fh>; close $fh; warn $! if $!; return @data; } foreach my $rpm ( @rpms ) { my @files = rpm("-ql", "--what-provides", "$rpm"); next if $files[0] =~ /^no package provides/; #print "*** $rpm ***\n"; if ( $clear ) { clear_files( $rpm, \@files ); } else { check_files( $rpm, \@files ); } #print "\n\n"; }