gen_rpmlists

• package main
  • wanted
  • rpmverparse
  • rpmvercmp
• EOF

#!/usr/bin/perl  -w
#
# make lists of "newest" RPMs in directory trees;
#

use strict;
use File::Find;

my @distlist = qw(valhalla psyche shrike);    # maintained distributions
my $dist;                                     # each distribution
my $base_url = "http://tautology.unh.edu/linux";   # where RPMs are found on web
my $base_dir = "/usr/local/misc";       # where distribution directories are
my $list_dir = "$base_dir/cislinux";    # where generated lists are
my %url_of;        # URL for a given name/arch
my %version_of;    # newest version seen for a given name/arch
my %release_of;    # newest release seen for a given name/arch
my $key;           # iterator
my @distdirs;      # directories for a given distribution
my $dir;           # each directory processed
my $name;          # name of package
my $arch;          # architecture of package

foreach $dist (@distlist) {
    undef %url_of;
    undef %version_of;
    undef %release_of;

    print "Doing $dist...\n";
    @distdirs = glob("$base_dir/${dist}*");
    foreach $dir (@distdirs) {
        print "Scanning $dir...\n";
        find( { wanted => \&wanted, follow => 0 }, $dir );
    }

    open( F, ">$list_dir/${dist}_rpms" )
      || die "Opening output file for $dist failed: $!\n";
    foreach $key ( keys %url_of ) {
        ( $name, $arch ) = split ( /,/, $key );
        print F
          "$url_of{$key} $name $version_of{$key} $release_of{$key} $arch\n";
    }
    close(F);
}

sub wanted {
    my $url;     # URL for the file
    my $poop;    # rpm -qp output for file
    my ( $name, $version, $release, $arch );    # split-up output
    my $result;                                 # comparison result

    if (/^.*\.rpm\z/s) {
        ( $url = $File::Find::name ) =~ s^$base_dir^$base_url^;
        chomp( $poop =
`/bin/rpm -qp --queryformat '%{NAME} %{VERSION} %{RELEASE} %{ARCH}\n' $_`
        );
        ( $name, $version, $release, $arch ) = split ( / /, $poop );
        if ( $url_of{"$name,$arch"} ) {         # already seen a URL for this...
            $result = rpmvercmp( $version, $version_of{"$name,$arch"} );
            if (
                $result > 0
                || ( $result == 0
                    && rpmvercmp( $release, $release_of{"$name,$arch"} ) > 0 )
              )
            {
                $url_of{"$name,$arch"}     = $url;
                $version_of{"$name,$arch"} = $version;
                $release_of{"$name,$arch"} = $release;
            }
        }
        else {
            $url_of{"$name,$arch"}     = $url;
            $version_of{"$name,$arch"} = $version;
            $release_of{"$name,$arch"} = $release;
        }
    }
}

sub rpmverparse {
    my ($ver) = @_;

    my @verparts = ();

    while ( $ver ne "" ) {
        if ( $ver =~ /^([A-Za-z]+)/ ) {    # leading letters
            push ( @verparts, $1 );
            $ver =~ s/^[A-Za-z]+//;
        }
        elsif ( $ver =~ /^(\d+)/ ) {       # leading digits
            push ( @verparts, $1 );
            $ver =~ s/^\d+//;
        }
        else {                             # remove non-letter, non-digit
            $ver =~ s/^.//;
        }
    }
    return @verparts;
}

sub rpmvercmp {
    my ( $a, $b ) = @_;
    my @aparts;
    my @bparts;                            # array of version "tokens"
    my $apart;
    my $bpart;
    my $result;

    if ( $a eq $b ) {
        return 0;
    }
    @aparts = rpmverparse($a);
    @bparts = rpmverparse($b);
    while ( @aparts && @bparts ) {
        $apart = shift (@aparts);
        $bpart = shift (@bparts);
        if ( $apart =~ /^\d+$/ && $bpart =~ /^\d+$/ ) {    # numeric
            if ( $result = ( $apart <=> $bpart ) ) {
                return $result;
            }
        }
        elsif ( $apart =~ /^[A-Za-z]+/ && $bpart =~ /^[A-Za-z]+/ ) {    # alpha
            if ( $result = ( $apart cmp $bpart ) ) {
                return $result;
            }
        }
        else {    # "arbitrary" in original code
            return -1;
        }
    }
    if (@aparts) {    # left over stuff in a, assume it's newer
        return 1;
    }
    elsif (@bparts) {    # leftover in b, assume it's newer
        return -1;
    }
    else {               # "should never happen"
        return 0;
    }
}