File: Versort.pm

package info (click to toggle)
devscripts 2.12.6%2Bdeb7u2
  • links: PTS, VCS
  • area: main
  • in suites: wheezy
  • size: 3,976 kB
  • sloc: perl: 15,544; sh: 5,482; python: 534; makefile: 170; ansic: 17
file content (56 lines) | stat: -rw-r--r-- 1,716 bytes parent folder | download
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
# Copyright (C) 1998,2002 Julian Gilbey <jdg@debian.org>
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or (at
# your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
# General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program. If not, see <http://www.gnu.org/licenses/>.

# The functions in this Perl module are versort and deb_versort.  They
# each take as input an array of elements of the form [version, data, ...]
# and sort them into decreasing order according to dpkg's
# understanding of version sorting.  The output is a sorted array.  In
# versort, "version" is assumed to be an upstream version number only,
# whereas in deb_versort, "version" is assumed to be a Debian version
# number, possibly including an epoch and/or a Debian revision.
#
# The returned array has the greatest version as the 0th array element.

package Devscripts::Versort;
use Dpkg::Version;

sub versort (@)
{
    return _versort(0, @_);
}

sub deb_versort (@)
{
    return _versort(1, @_);
}

sub _versort ($@)
{
    my ($check, @namever_pairs) = @_;

    foreach my $pair (@namever_pairs) {
	unshift(@$pair, Dpkg::Version->new($pair->[0], check => $check));
    }

    my @sorted = sort { $b->[0] <=> $a->[0] } @namever_pairs;

    foreach my $pair (@sorted) {
	shift @$pair;
    }

    return @sorted;
}

1;