prtsweep.pl: nicer recognition of built packages

man1/prtsweep.1

@@ -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

scripts/prtsweep.pl

@@ -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 eq "-a") {
-		if ($arg =~ /^-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.*' :
+	my $builtpkg=$path[-1].'#.*pkg\.tar\.(bz2|gz|lz|xz)$';
-		'ReallyLongStringThatWouldNeverMatchAnyBuiltPackage';
+	$builtpkg =~ s/\+/\\\+/; # plus sign in filenames interferes with regex search
-	$builtpkg =~ s/\+/\\\+/;
 
 	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
+		$f =~ s/\+/\\\+/;
-		if ((grep /$f/, @wanted) >= 1 or ($f =~ /$builtpkg/)) {
+		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" :
+	my $post = ($nf == 0) ? "  Empty directory $port $modal deleted.\n" :
-		"$msg cannot remove $port: directory not empty\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);
-	}
-}