Skip site navigation (1)Skip section navigation (2)
Date:      Thu, 31 Jan 2002 16:44:46 +0000
From:      Marc Silver <marcs@draenor.org>
To:        freebsd-ports@freebsd.org
Subject:   cleaning up of /usr/ports/distfiles
Message-ID:  <20020131164446.A97807@draenor.org>

next in thread | raw e-mail | index | archive | help

--NzB8fVQJ5HfG6fxh
Content-Type: text/plain; charset=us-ascii
Content-Disposition: inline

Hi there,

Redirecting this mail here as per Kris Kennaway's suggestion...  :)

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

--NzB8fVQJ5HfG6fxh
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";
    }
  }
}

--NzB8fVQJ5HfG6fxh--

To Unsubscribe: send mail to majordomo@FreeBSD.org
with "unsubscribe freebsd-ports" in the body of the message




Want to link to this message? Use this URL: <https://mail-archive.FreeBSD.org/cgi/mid.cgi?20020131164446.A97807>