[opensuse] Re: Script to move old versions of rpms from local repository

12 Aug 2009

      Carlos E. R. wrote:
...
...
Anyway, I wrote a small script to do this and to provide a short
    log of what was done. So just in case anyone else has a directory
    full of multiple versions of rpms and would like to separate them
    without having to reinvent the wheel, I've attached the script.
    The script relies on FILE DATE to determine the most recent
    version rather than a parse and sort of the version numbers, so if
    you moved all your rpms to a directory such that they all have the
    same date, this won't work.
Ah... well, perhaps somebody else can chirp in and add that logic to
your script ;-)
Once upon a time, I used the attached Perl script to do so.
I used apt or smart then. Now, with delta rpms, it doesn't work any
more and I'd have to adapt it.

Nevertheless, it might be useful for somebody.

	Joachim

-- 
=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
Joachim Schrod				Email: jschrod@acm.org
Roedermark, Germany

#!/usr/bin/perl
# apt-cache-cleanup				15 Apr 08
#------------------------------------------------------------
# (history at end)

=head1 NAME

apt-cache-cleanup - clean apt archives cache

=head1 SYNOPSIS

B<apt-cache-cleanup> cache_directory

=head1 DESCRIPTION

Deletes rpm archives from the apt cache directory that we don't need
any more.

These are those archives where a package with a new version number
exists and is installed.

=cut

# standard setup

use strict;
use English qw(-no_match_vars);

# Used modules.

use RPM::Header::PurePerl;
use RPM::VersionSort;

# Check arguments, store them in proper variables.

sub usage ( ;$ )
{
    my $exit_code = shift || 0;
    print STDERR "usage: apt-cache-cleanup cache_directory\n";
    exit $exit_code;
}

usage()  if ( @ARGV != 0 && $ARGV[0] eq '-?' );
usage(1)  if ( @ARGV != 1 );

our $dir = shift;

# Get the list of current modules.

our %installed = map { chomp; $_ => 1 } `rpm -qa`;
our %available = ();

chdir $dir  or  die "chdir $dir: $ERRNO\n";

foreach my $rpm_file ( glob('*.rpm') ) {
    tie my %rpm, 'RPM::Header::PurePerl', $rpm_file
      or  die $!;
    push(@{$available{$rpm{NAME}}}, ["$rpm{VERSION}-$rpm{RELEASE}", $rpm_file]);
    untie %rpm;
}

while ( my ($rpm, $version) = each %available ) {
    # If there is only one version of a package, we don't delete it.
    next  if ( @$version == 1 );
    my @versions = sort { rpmvercmp($a->[0], $b->[0]) } @$version;
    # Determine the version that's installed. Delete it and all higher
    # versions from @versions.
    while ( @versions ) {
	$version = pop(@versions);
	last  if exists $installed{"$rpm-$version->[0]"};
    }
    # Den Rest kann man jetzt löschen; wir brauchen ihn nicht mehr.
    unlink map { "$_->[1]" } @versions  if @versions;
}

exit (0);

#======================================================================
#
# Log:
#
# 15 Apr 08 js  Initial revison

Joachim Schrod

tags

participants (1)