Date: Thu, 31 Jan 2002 12:19:50 +0000 From: Marc Silver <marcs@draenor.org> To: freebsd-hackers@freebsd.org Subject: cleaning up of /usr/ports/distfiles Message-ID: <20020131121950.F567@draenor.org>
next in thread | raw e-mail | index | archive | help
--xgyAXRrhYN0wYx8y Content-Type: text/plain; charset=us-ascii Content-Disposition: inline Hi there, While looking for a perl substitute for /usr/ports/sysutils/portupgrade/, I came across Lukas Ertl's portupgrade.pl (http://mailbox.univie.ac.at/~le/portsupgrade.html) - One feature however that it didn't have was the ability to remove old distfiles. I sat down and quickly hacked together a small script to clean up old/unused files from /usr/ports/distfiles. It's probably not the prettiest code any of you have ever seen, but I've used it with great success so far. I'm not sure if this is of any use to anyone, or in fact if I'm sending this to the right place, but I'd certainly like any feedback regarding this script, and perhaps it can help the FreeBSD community? Please CC me with flames/comments/suggestions/the_right_place_to_send_this?? as I'm not subscribed to this list. - Marc -- I've learned that being kind is more important than being right. -- Andy Rooney --xgyAXRrhYN0wYx8y Content-Type: application/x-perl Content-Disposition: attachment; filename="distclean.pl" #!/usr/bin/perl -w # # Cleans out old and unused files from /usr/ports/distfiles based on # what is currently installed. Information is collected from # /var/db/pkg and the /usr/ports tree to help identify which files # should and should not be in /usr/ports/distfiles. # # Set $debug to 1 for minor debug information and to 2 for much more # info... :) # # Written by Marc Silver <marcs@draenor.org> # # $Id: distclean.pl,v 1.1 2002/01/31 12:09:27 marcs Exp $; # # # use strict; use File::Find; my( $pkgdir ) = "/var/db/pkg"; my( $distdir ) = "/usr/ports/distfiles"; my( %seen, @inst_pkg, @req_files, @distfiles, @delete, $pkg, $dists, $deleteme, $tmp ); my( $debug ) = 0; # See what packages are installed opendir( PKG, "$pkgdir" ); while( $pkg = readdir( PKG ) ) { if( $pkg ne "." && $pkg ne ".." ) { print "Adding $pkg to list\n" if( $debug ); push( @inst_pkg, $pkg ); } } close( PKG ); # See what's in /usr/ports/distfiles find( \&pushme, $distdir ); sub pushme { $tmp = $File::Find::name; # Strip the path out... $tmp =~ s:$distdir/::; print "Adding $tmp to list of distfiles\n" if( $debug ); push( @distfiles, $tmp ); } # See what SHOULD be in /usr/ports/distfiles. According to latest cvsup # sources. foreach $pkg ( @inst_pkg ) { open( TMP, "$pkgdir/$pkg/+CONTENTS" ); while( <TMP> ) { if( /^\@comment ORIGIN:(.+)$/ ) { my( $origin ) = $1; print "$pkg is from /usr/ports/$origin\n" if( $debug > 1 ); if( -e "/usr/ports/$origin/distinfo" ) { open( REQ, "/usr/ports/$origin/distinfo" ); print "\n$pkg requires the following files:\n" if( $debug > 1 ); while( <REQ> ) { if( /MD5 \((.+)\)/ ) { my( $filename ) = $1; print "o $filename\n" if( $debug > 1 ); push( @req_files, $filename ); } } } close( REQ ); } } close( TMP ); } # Delete FILES that shouldn't be there. We dont remove directories... foreach $deleteme ( @req_files ) { $seen{ $deleteme } = 1 } foreach $deleteme ( @distfiles ) { unless( $seen{ $deleteme } ) { if( ! -d "$distdir/$deleteme" && "$distdir/$deleteme" ne $distdir && "$distdir/$deleteme" ne "$distdir/$distdir" ) { print "Removing $distdir/$deleteme\n"; unlink( "$distdir/$deleteme" ) || warn "could not remove $distdir/$deleteme\n"; } } } --xgyAXRrhYN0wYx8y-- To Unsubscribe: send mail to majordomo@FreeBSD.org with "unsubscribe freebsd-hackers" in the body of the message
Want to link to this message? Use this URL: <https://mail-archive.FreeBSD.org/cgi/mid.cgi?20020131121950.F567>