Prechádzať zdrojové kódy

Use a script to clean up old packages from the ports directory.

Markus Hennecke 13 rokov pred
rodič
commit
aea004aaa9
1 zmenil súbory, kde vykonal 63 pridanie a 0 odobranie
  1. 63 0
      cleanup_packages.pl

+ 63 - 0
cleanup_packages.pl

@@ -0,0 +1,63 @@
+#! /usr/bin/perl
+# $Id: cleanup_packages.pl,v 1.1 2011/06/20 17:39:34 markus Exp $
+# vi: set tabstop=8 noexpandtab shiftwidth=8:
+
+use strict;
+use warnings;
+
+my $portsdir = $ENV{PORTSDIR} || '/usr/ports/';
+
+sub getInstalledPackages () {
+	my %packages = ();
+	open(my $fh, 'pkg_info |')
+	    or die $!;
+	while(<$fh>) {
+		s/[[:space:]]+.*//;
+		chomp;
+		$packages{$_} = 1;
+	}
+	close($fh);
+	return \%packages;
+}
+
+
+sub getAvailablePackages ($) {
+	my $subdir = shift;
+	my $arch = `uname -m`;
+	chomp $arch;
+	my $directory = "$portsdir/packages/$arch/$subdir";
+	my %packages = ();
+	return \%packages if (! -d "$directory");
+	open(my $fh, "ls $directory |")
+	    or die $!;
+	while (<$fh>) {
+		$_ =~ s/\.tgz$//;
+		chomp;
+		$packages{$_} = 1;
+	}
+	close($fh);
+	return \%packages;
+}
+
+
+sub getNotInstalledPackages ($$$) {
+	my $installed = shift;
+	my $available = shift;
+	my $dir = shift;
+	my $arch = `uname -m`;
+	chomp $arch;
+
+	for my $pkg (sort keys %$available) {
+		if (! exists $installed->{$pkg}) {
+			print "rm $portsdir/packages/$arch/$dir/$pkg.tgz\n";
+		}
+	}
+}
+
+print '#! /bin/sh' . "\n";
+my $installed = getInstalledPackages();
+for my $dir ('all', 'cdrom', 'ftp') {
+	my $available = getAvailablePackages($dir);
+	getNotInstalledPackages($installed, $available, $dir);
+}
+