Blame SOURCES/rpmsort

67e50c
#! /usr/bin/perl -w
67e50c
67e50c
# This program is free software; you can redistribute it and/or
67e50c
# modify it under the terms of the GNU General Public License
67e50c
# as published by the Free Software Foundation; either version 2
67e50c
# of the License, or (at your option) any later version.
67e50c
#
67e50c
# This program is distributed in the hope that it will be useful,
67e50c
# but WITHOUT ANY WARRANTY; without even the implied warranty of
67e50c
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
67e50c
# GNU General Public License for more details.
67e50c
#
67e50c
# You should have received a copy of the GNU General Public License
67e50c
# along with this program; if not, write to the Free Software
936cd0
# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston,
936cd0
# MA 02110-1301 USA.
67e50c
67e50c
use Getopt::Long qw(:config gnu_getopt);
67e50c
67e50c
sub rpm_cmp_versions {
67e50c
    my ($evr1, $evr2) = @_;
67e50c
67e50c
    sub _rpm_cmp {
67e50c
	my ($s1, $s2) = @_;
67e50c
67e50c
	return defined $s1 <=> defined $s2
67e50c
	    unless defined $s1 && defined $s2;
67e50c
67e50c
	my ($r, $x1, $x2);
67e50c
	do {
67e50c
	    $s1 =~ s/^[^a-zA-Z0-9]+//;
67e50c
	    $s2 =~ s/^[^a-zA-Z0-9]+//;
67e50c
	    if ($s1 =~ /^\d/ || $s2 =~ /^\d/) {
67e50c
		$s1 =~ s/^0*(\d*)//;  $x1 = $1;
67e50c
		$s2 =~ s/^0*(\d*)//;  $x2 = $1;
67e50c
		$r = length $x1 <=> length $x2 || $x1 cmp $x2;
67e50c
	    } else {
67e50c
		$s1 =~ s/^([a-zA-Z]*)//;  $x1 = $1;
67e50c
		$s2 =~ s/^([a-zA-Z]*)//;  $x2 = $1;
67e50c
		return 0
67e50c
		    if $x1 eq '' && $x2 eq '';
67e50c
		$r = $x1 cmp $x2;
67e50c
	    }
67e50c
	} until $r;
67e50c
	return $r;
67e50c
    }
67e50c
67e50c
    my ($e1, $v1, $r1) = $evr1 =~ /^(?:(\d*):)?(.*?)(?:-([^-]*))?$/;
67e50c
    my ($e2, $v2, $r2) = $evr2 =~ /^(?:(\d*):)?(.*?)(?:-([^-]*))?$/;
67e50c
    my $r = _rpm_cmp($e1 || 0, $e2 || 0);
67e50c
    $r = _rpm_cmp($v1, $v2)
67e50c
	unless $r;
67e50c
    $r = _rpm_cmp($r1, $r2)
67e50c
	unless $r;
67e50c
    return $r;
67e50c
}
67e50c
67e50c
my $reorder = sub { return @_ };
67e50c
my $key = 0;
67e50c
67e50c
GetOptions ("r|reverse"	    => sub { $reorder = sub { return reverse @_ } },
67e50c
	    "k|key=i"	    => \$key)
67e50c
or do {
67e50c
    print STDERR "Usage\n";
67e50c
    exit 1;
67e50c
};
67e50c
67e50c
if ($key == 0) {
67e50c
    # Sort by entire lines
67e50c
    map { print } &$reorder(sort { rpm_cmp_versions($a, $b) } <>);
67e50c
} else {
67e50c
    # Sort by field $key
67e50c
    my @data = map { [(split)[$key-1], $_] } <>;
67e50c
    map { print } &$reorder(map { $_->[1] }
67e50c
        sort { rpm_cmp_versions($a->[0], $b->[0]) } @data);
67e50c
}