home *** CD-ROM | disk | FTP | other *** search
/ Chip 2007 January, February, March & April / Chip-Cover-CD-2007-02.iso / boot / i386 / rescue / usr / lib / rpm / rpmsort < prev    next >
Encoding:
Text File  |  2006-11-29  |  2.1 KB  |  77 lines
  1. #! /usr/bin/perl -w
  2.  
  3. # This program is free software; you can redistribute it and/or
  4. # modify it under the terms of the GNU General Public License
  5. # as published by the Free Software Foundation; either version 2
  6. # of the License, or (at your option) any later version.
  7. #
  8. # This program is distributed in the hope that it will be useful,
  9. # but WITHOUT ANY WARRANTY; without even the implied warranty of
  10. # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  11. # GNU General Public License for more details.
  12. #
  13. # You should have received a copy of the GNU General Public License
  14. # along with this program; if not, write to the Free Software
  15. # Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307,
  16. # USA.
  17.  
  18. use Getopt::Long qw(:config gnu_getopt);
  19.  
  20. sub rpm_cmp_versions {
  21.     my ($evr1, $evr2) = @_;
  22.  
  23.     sub _rpm_cmp {
  24.     my ($s1, $s2) = @_;
  25.  
  26.     return defined $s1 <=> defined $s2
  27.         unless defined $s1 && defined $s2;
  28.  
  29.     my ($r, $x1, $x2);
  30.     do {
  31.         $s1 =~ s/^[^a-zA-Z0-9]+//;
  32.         $s2 =~ s/^[^a-zA-Z0-9]+//;
  33.         if ($s1 =~ /^\d/ || $s2 =~ /^\d/) {
  34.         $s1 =~ s/^0*(\d*)//;  $x1 = $1;
  35.         $s2 =~ s/^0*(\d*)//;  $x2 = $1;
  36.         $r = length $x1 <=> length $x2 || $x1 cmp $x2;
  37.         } else {
  38.         $s1 =~ s/^([a-zA-Z]*)//;  $x1 = $1;
  39.         $s2 =~ s/^([a-zA-Z]*)//;  $x2 = $1;
  40.         return 0
  41.             if $x1 eq '' && $x2 eq '';
  42.         $r = $x1 cmp $x2;
  43.         }
  44.     } until $r;
  45.     return $r;
  46.     }
  47.  
  48.     my ($e1, $v1, $r1) = $evr1 =~ /^(?:(\d*):)?(.*?)(?:-([^-]*))?$/;
  49.     my ($e2, $v2, $r2) = $evr2 =~ /^(?:(\d*):)?(.*?)(?:-([^-]*))?$/;
  50.     my $r = _rpm_cmp($e1 || 0, $e2 || 0);
  51.     $r = _rpm_cmp($v1, $v2)
  52.     unless $r;
  53.     $r = _rpm_cmp($r1, $r2)
  54.     unless $r;
  55.     return $r;
  56. }
  57.  
  58. my $reorder = sub { return @_ };
  59. my $key = 0;
  60.  
  61. GetOptions ("r|reverse"        => sub { $reorder = sub { return reverse @_ } },
  62.         "k|key=i"        => \$key)
  63. or do {
  64.     print STDERR "Usage\n";
  65.     exit 1;
  66. };
  67.  
  68. if ($key == 0) {
  69.     # Sort by entire lines
  70.     map { print } &$reorder(sort { rpm_cmp_versions($a, $b) } <>);
  71. } else {
  72.     # Sort by field $key
  73.     my @data = map { [(split)[$key-1], $_] } <>;
  74.     map { print } &$reorder(map { $_->[1] }
  75.         sort { rpm_cmp_versions($a->[0], $b->[0]) } @data);
  76. }
  77.