prtsweep.pl: nicer recognition of built packages
This commit is contained in:
parent
954afb830f
commit
150c874481
@ -1,7 +1,7 @@
|
||||
.\"
|
||||
.\" prtsweep manual page.
|
||||
.\" (C) 2e003 by Martin Opel
|
||||
.\" Revised 2021 by John McQuah
|
||||
.\" Revised 2022 by John McQuah
|
||||
.\"
|
||||
.TH prtsweep 1
|
||||
.SH NAME
|
||||
@ -9,7 +9,7 @@ prtsweep \- sweep old files from the ports directories
|
||||
.SH SYNOPSIS
|
||||
.PP
|
||||
.B prtsweep
|
||||
[\-a] [\-d] [\-n] [PORTDIR ...]
|
||||
[\-a] [\-d] [\-n] [\-q] [PORTDIR ...]
|
||||
.SH DESCRIPTION
|
||||
|
||||
The \fIprtsweep\fP perl script sweeps port directories, deleting unneeded files.
|
||||
@ -17,7 +17,7 @@ The \fIprtsweep\fP perl script sweeps port directories, deleting unneeded files.
|
||||
built package
|
||||
.PP
|
||||
.nf
|
||||
name#version-release.pkg.tar.?z*
|
||||
name#version-release.pkg.tar.*
|
||||
.fi
|
||||
.PP
|
||||
All other files are removed. If a traversal of the ports collections in automatic mode
|
||||
|
||||
@ -19,15 +19,34 @@ our %options = ( auto => 0, dryrun => 0, rmdir => 0, pkgtoo => 0, quiet => 0 );
|
||||
our @portdirs;
|
||||
our $argports;
|
||||
|
||||
######################### main routine ################################
|
||||
parse_args();
|
||||
print_usage() if ((2*$argports-1)*(1-2*$options{auto}) < 0);
|
||||
|
||||
if ($options{auto} == 1) {
|
||||
my @basedirs = getportdirs();
|
||||
foreach my $collection (@basedirs) {
|
||||
print "====> Sweeping port collection $collection\n";
|
||||
foreach my $port (list_subdirs($collection)) {
|
||||
do_sweep($port);
|
||||
}
|
||||
}
|
||||
} else {
|
||||
foreach my $port (@portdirs) {
|
||||
do_sweep($port);
|
||||
}
|
||||
}
|
||||
|
||||
######################### subroutines #################################
|
||||
sub print_usage {
|
||||
print <<EOT;
|
||||
Usage: prtsweep [OPTION]... [PORTDIRS]...
|
||||
|
||||
-a automatic mode, only valid when [PORTDIRS] are omitted
|
||||
-d remove directories of dropped ports (no Pkgfile present)
|
||||
-d remove directories of dropped ports (signature file not found)
|
||||
-n dry-run, don't actually delete anything
|
||||
-p delete any built packages too
|
||||
-q quiet mode
|
||||
-q quiet mode, only print messages when files are removed
|
||||
|
||||
Report bugs on libera.chat #crux-devel
|
||||
EOT
|
||||
@ -36,22 +55,24 @@ EOT
|
||||
|
||||
sub parse_args {
|
||||
foreach my $arg (@ARGV) {
|
||||
next if (-f $arg); # no filenames, only options or directories
|
||||
if ($arg =~ /^-a$/) {
|
||||
if ($arg eq "-a") {
|
||||
$options{auto} = 1;
|
||||
} elsif ($arg =~ /^-d$/) {
|
||||
} elsif ($arg eq "-d") {
|
||||
$options{rmdir} = 1;
|
||||
} elsif ($arg =~ /^-n$/) {
|
||||
} elsif ($arg eq "-n") {
|
||||
$options{dryrun} = 1;
|
||||
} elsif ($arg =~ /^-p$/) {
|
||||
} elsif ($arg eq "-p") {
|
||||
$options{pkgtoo} = 1;
|
||||
} elsif ($arg =~ /^-q$/) {
|
||||
} elsif ($arg eq "-q") {
|
||||
$options{quiet} = 1;
|
||||
} elsif ($arg =~ /^--version$/) {
|
||||
} elsif ($arg eq "--version") {
|
||||
print $version."\n";
|
||||
exit 0;
|
||||
} elsif (-d "$arg") {
|
||||
} elsif ((-d "$arg") || # false for symlink to a portdir,
|
||||
(-f "$arg/.signature")) { # so a second test is needed
|
||||
push (@portdirs, $arg);
|
||||
} elsif (-f "$arg") {
|
||||
print "WARN: $arg is not a port directory or recognized option, ignoring.\n";
|
||||
} else {
|
||||
print_usage();
|
||||
}
|
||||
@ -68,7 +89,8 @@ sub list_subdirs {
|
||||
opendir(DIR, $path) or return;
|
||||
foreach my $entry(sort(readdir(DIR))) {
|
||||
next if ( substr($entry,0,1) eq '.' );
|
||||
push (@list, "$path/$entry") if -d "$path/$entry";
|
||||
push (@list, "$path/$entry") if ((-d "$path/$entry")
|
||||
or (-f "$path/$entry/.signature"));
|
||||
}
|
||||
closedir(DIR);
|
||||
return @list;
|
||||
@ -97,15 +119,15 @@ sub sweep {
|
||||
|
||||
print "=======> $port\n" unless $options{quiet}==1;
|
||||
my @wanted = parse_signature ("$port/.signature");
|
||||
my $builtpkg=($options{pkgtoo} != 1) ? $path[-1].'#.*pkg\.tar.*' :
|
||||
'ReallyLongStringThatWouldNeverMatchAnyBuiltPackage';
|
||||
$builtpkg =~ s/\+/\\\+/;
|
||||
my $builtpkg=$path[-1].'#.*pkg\.tar\.(bz2|gz|lz|xz)$';
|
||||
$builtpkg =~ s/\+/\\\+/; # plus sign in filenames interferes with regex search
|
||||
|
||||
opendir (DIR, $port) or return;
|
||||
foreach my $f (sort(readdir(DIR))) {
|
||||
next if ( $f eq '.' or $f eq '..' );
|
||||
$f =~ s/\+/\\\+/; # plus sign in filenames interferes with regex search
|
||||
if ((grep /$f/, @wanted) >= 1 or ($f =~ /$builtpkg/)) {
|
||||
$f =~ s/\+/\\\+/;
|
||||
if ((grep /$f/, @wanted) >= 1 or
|
||||
($f =~ /$builtpkg/)*($options{pkgtoo}==0)) {
|
||||
print "... keeping file $port/$f.\n" unless $options{quiet} == 1;
|
||||
} else {
|
||||
remove ("$port/$f");
|
||||
@ -127,15 +149,17 @@ sub remove {
|
||||
}
|
||||
|
||||
sub do_sweep {
|
||||
# argument either a real directory (not symlink) or has a signature;
|
||||
# this subroutine determines which condition was satisfied.
|
||||
my $port = shift; my $nf = 0;
|
||||
if (! -f "$port/.signature") {
|
||||
opendir (PORTDIR,$port) or die "cannot open $port for reading\n";
|
||||
opendir (PORTDIR,$port) or return;
|
||||
foreach my $f (readdir PORTDIR) {
|
||||
next if ($f eq '.' or $f eq '..');
|
||||
$nf += 1;
|
||||
}
|
||||
closedir (PORTDIR);
|
||||
print "no signature file, $port does not define a valid port.";
|
||||
print "WARN: $port/.signature not found, invalid port directory.";
|
||||
rm_emptydir($port,$nf);
|
||||
} else {
|
||||
sweep($port);
|
||||
@ -145,10 +169,11 @@ sub do_sweep {
|
||||
sub rm_emptydir {
|
||||
my $port = shift; my $nf = shift;
|
||||
my $msg = ($options{rmdir}==1) ? "\n":
|
||||
" use -d to remove empty directories.\n";
|
||||
"\n Use -d to remove empty directories.\n";
|
||||
my $modal = ($options{dryrun}==0) ? "" : "would be";
|
||||
$msg = ($nf == 0) ? "$msg empty directory $port $modal deleted.\n" :
|
||||
"$msg cannot remove $port: directory not empty\n";
|
||||
my $post = ($nf == 0) ? " Empty directory $port $modal deleted.\n" :
|
||||
" Cannot remove $port: directory not empty\n";
|
||||
$msg = ($options{rmdir}==1) ? "$msg $post" : $msg ;
|
||||
print $msg;
|
||||
rmdir ($port) if (($nf == 0) and ($options{dryrun} == 0));
|
||||
}
|
||||
@ -179,21 +204,3 @@ sub getportdirs {
|
||||
closedir PORTS_DEFS;
|
||||
return @basedirs ;
|
||||
}
|
||||
|
||||
# main
|
||||
parse_args();
|
||||
print_usage() if ((2*$argports-1)*(1-2*$options{auto}) < 0);
|
||||
|
||||
if ($options{auto} == 1) {
|
||||
my @basedirs = getportdirs();
|
||||
foreach my $collection (@basedirs) {
|
||||
print "====> Sweeping port collection $collection\n";
|
||||
foreach my $port (list_subdirs($collection)) {
|
||||
do_sweep($port);
|
||||
}
|
||||
}
|
||||
} else {
|
||||
foreach my $port (@portdirs) {
|
||||
do_sweep($port);
|
||||
}
|
||||
}
|
||||
|
||||
Loading…
Reference in New Issue
Block a user