Devscripts/Versort.pm

   1 # Copyright (C) 1998,2002 Julian Gilbey <jdg@debian.org>
   2 #
   3 # This program is free software; you can redistribute it and/or modify
   4 # it under the terms of the GNU General Public License as published by
   5 # the Free Software Foundation; either version 2 of the License, or (at
   6 # 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 GNU
  11 # 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, see <http://www.gnu.org/licenses/>.
  15
  16 # The functions in this Perl module are versort and deb_versort.  They
  17 # each take as input an array of elements of the form [version, data, ...]
  18 # and sort them into decreasing order according to dpkg's
  19 # understanding of version sorting.  The output is a sorted array.  In
  20 # versort, "version" is assumed to be an upstream version number only,
  21 # whereas in deb_versort, "version" is assumed to be a Debian version
  22 # number, possibly including an epoch and/or a Debian revision.
  23 #
  24 # The returned array has the greatest version as the 0th array element.
  25
  26 package Devscripts::Versort;
  27 use Dpkg::Version;
  28
  29 sub versort (@)
  30 {
  31     return _versort(0, @_);
  32 }
  33
  34 sub deb_versort (@)
  35 {
  36     return _versort(1, @_);
  37 }
  38
  39 sub _versort ($@)
  40 {
  41     my ($check, @namever_pairs) = @_;
  42
  43     foreach my $pair (@namever_pairs) {
  44         unshift(@$pair, Dpkg::Version->new($pair->[0], check => $check));
  45     }
  46
  47     my @sorted = sort { $b->[0] <=> $a->[0] } @namever_pairs;
  48
  49     foreach my $pair (@sorted) {
  50         shift @$pair;
  51     }
  52
  53     return @sorted;
  54 }
  55
  56 1;