merge_rpms

• package main
  • rpmverparse
  • rpmvercmp
• EOF

#!/usr/bin/perl -w

#
# after the redhat update directories are mirrored
# remove old RPMS from RPM directory, link to new
# ones in update dirs (assumes we always want to
# replace older versions with newer ones)
#

use strict;
use File::stat;

my $rhdir       = "/usr/local/misc";       # base directory
my $rpm_dir     = "$rhdir/RedHat/RPMS";    # "master" RPM directory
my $update_base = "$rhdir/updates";        # update base directory

my @update_dirs = (    # list of directories containing update RPMS
    "$update_base/athlon",
    "$update_base/i386",
    "$update_base/i586",
    "$update_base/i686",
    "$update_base/noarch"
);

my $current_rpm;        # single RPM filename
my $rpmout;             # output from rpm -qp command
my $sb;                 # stat output
my $update_dir;         # update directory path
my $update_rpm;         # update RPM filename
my %current_release;    # release of each RPM
my %current_version;    # version of each RPM
my %filename;           # filename of each RPM
my %path;               # path to each unique RPM
my ( $name, $version, $release, $arch );    # split-up output from query
my @current_rpms;    # list of RPM files in directory
my @update_rpms;     # list of update RPM files in directory

opendir( D, $rpm_dir ) || die "Opening $rpm_dir failed: $!\n";
@current_rpms = grep { /\.rpm$/ } readdir(D);
closedir(D);
foreach $current_rpm (@current_rpms) {
    $rpmout =
`rpm -qp --queryformat '%{NAME} %{VERSION} %{RELEASE} %{ARCH}\n' $rpm_dir/$current_rpm`;
    chomp $rpmout;
    ( $name, $version, $release, $arch ) = split ( / /, $rpmout );

    #
    # this assumes that the $name - $arch tuple is different for
    # each current RPM in the CD image...
    #
    $path{"$name $arch"}            = "$rpm_dir/$current_rpm";
    $current_version{"$name $arch"} = $version;
    $current_release{"$name $arch"} = $release;
    $filename{"$name $arch"}        = $current_rpm;
}

foreach $update_dir (@update_dirs) {
    opendir( D, $update_dir ) || die "Opening $update_dir failed: $!\n";
    @update_rpms = sort grep { /\.rpm$/ } readdir(D);
    closedir(D);
    foreach $update_rpm (@update_rpms) {
        $sb = stat("$update_dir/$update_rpm");
        next if $sb->nlink == 2;    # already linked
        $rpmout =
`rpm -qp --queryformat '%{NAME} %{VERSION} %{RELEASE} %{ARCH}\n' $update_dir/$update_rpm`;
        chomp $rpmout;
        ( $name, $version, $release, $arch ) = split ( / /, $rpmout );
        unless ( $filename{"$name $arch"} ) {
            print "NO rpm in $rpm_dir matching $update_rpm\n";
            next;
        }
        if (
            rpmvercmp( $version, $current_version{"$name $arch"} ) > 0
            || (   rpmvercmp( $version, $current_version{"$name $arch"} ) == 0
                && rpmvercmp( $release, $current_release{"$name $arch"} ) > 0 )
          )
        {
            printf "    ... replacing %s with %s ...\n",
              $filename{"$name $arch"}, $update_rpm;
            unlink $path{"$name $arch"};
            link( "$update_dir/$update_rpm", "$rpm_dir/$update_rpm" )
              || die "Ack! link failed: $!\n";
            $path{"$name $arch"}            = "$rpm_dir/$update_rpm";
            $filename{"$name $arch"}        = $update_rpm;
            $current_version{"$name $arch"} = $version;
            $current_release{"$name $arch"} = $release;
        }
        else {
            print "NOT replacing ", $filename{"$name $arch"},
              " with (apparently older) $update_rpm\n";
        }
    }
}
print "Running genhdlist...\n";
system("/usr/lib/anaconda-runtime/genhdlist $rhdir");
chmod( 0644, <$rhdir/RedHat/base/hdlist*> )
  || warn "Chmod failed: $!\n";

#
# parse Red Hat RPM release/version strings into tokens
#
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;
}

#
# compare Red Hat RPM release/version strings
#
sub rpmvercmp {
    my ( $a, $b ) = @_;
    my @aparts;                            # list of version/release tokens
    my @bparts;
    my $apart;                             # individual token from array
    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;
    }
}