vcs.maemo.org Git - maemian/blob - lib/Maemian/Relation/Version.pm

   1 # -*- perl -*-
   2 # Maemian::Relation::Version -- comparison operators on Debian versions
   3
   4 # Copyright (C) 1998 Christian Schwarz and Richard Braakman
   5 # Copyright (C) 2004-2009 Russ Allbery <rra@debian.org>
   6 # Copyright (C) 2009 Adam D. Barratt <adam@adam-barratt.org.uk>
   7 #
   8 # This program is free software; you can redistribute it and/or modify it
   9 # under the terms of the GNU General Public License as published by the Free
  10 # Software Foundation; either version 2 of the License, or (at your option)
  11 # any later version.
  12 #
  13 # This program is distributed in the hope that it will be useful, but WITHOUT
  14 # ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
  15 # FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
  16 # more details.
  17 #
  18 # You should have received a copy of the GNU General Public License along with
  19 # this program.  If not, see <http://www.gnu.org/licenses/>.
  20
  21 package Maemian::Relation::Version;
  22
  23 use strict;
  24 use warnings;
  25
  26 use Carp qw(croak);
  27
  28 use base 'Exporter';
  29 BEGIN {
  30     our @EXPORT = qw(versions_equal versions_lte versions_gte versions_lt
  31                      versions_gt versions_compare);
  32 }
  33
  34 use AptPkg::Config '$_config';
  35 my $versioning = $_config->system->versioning;
  36
  37 =head1 NAME
  38
  39 Maemian::Relation::Version - Comparison operators on Debian versions
  40
  41 =head1 SYNOPSIS
  42
  43     print "yes\n" if versions_equal('1.0', '1.00');
  44     print "yes\n" if versions_gte('1.1', '1.0');
  45     print "no\n" if versions_lte('1.1', '1.0');
  46     print "yes\n" if versions_gt('1.1', '1.0');
  47     print "no\n" if versions_lt('1.1', '1.1');
  48     print "yes\n" if versions_compare('1.1', '<=', '1.1');
  49
  50 =head1 DESCRIPTION
  51
  52 This module provides five functions for comparing version numbers.  The
  53 underlying implementation uses C<libapt-pkg-perl> to ensure that
  54 the results match what dpkg will expect.
  55
  56 =head1 FUNCTIONS
  57
  58 =over 4
  59
  60 =item versions_equal(A, B)
  61
  62 Returns true if A is equal to B (C<=>) and false otherwise.
  63
  64 =cut
  65
  66 sub versions_equal {
  67     my ($p, $q) = @_;
  68     my $result;
  69
  70     return 1 if $p eq $q;
  71
  72     $result = $versioning->compare($p, $q);
  73
  74     return ($result == 0);
  75 }
  76
  77 =item versions_lte(A, B)
  78
  79 Returns true if A is less than or equal (C<< <= >>) to B and false
  80 otherwise.
  81
  82 =cut
  83
  84 sub versions_lte {
  85     my ($p, $q) = @_;
  86     my $result;
  87
  88     return 1 if $p eq $q;
  89
  90     $result = $versioning->compare($p, $q);
  91
  92     return ($result <= 0);
  93 }
  94
  95 =item versions_gte(A, B)
  96
  97 Returns true if A is greater than or equal (C<< >= >>) to B and false
  98 otherwise.
  99
 100 =cut
 101
 102 sub versions_gte {
 103     my ($p, $q) = @_;
 104     my $result;
 105
 106     return 1 if $p eq $q;
 107
 108     $result = $versioning->compare($p, $q);
 109
 110     return ($result >= 0);
 111 }
 112
 113 =item versions_lt(A, B)
 114
 115 Returns true if A is less than (C<<< << >>>) B and false otherwise.
 116
 117 =cut
 118
 119 sub versions_lt {
 120     my ($p, $q) = @_;
 121     my $result;
 122
 123     return 0 if $p eq $q;
 124
 125     $result = $versioning->compare($p, $q);
 126
 127     return ($result < 0);
 128 }
 129
 130 =item versions_gt(A, B)
 131
 132 Returns true if A is greater than (C<<< >> >>>) B and false otherwise.
 133
 134 =cut
 135
 136 sub versions_gt {
 137     my ($p, $q) = @_;
 138     my $result;
 139
 140     return 0 if $p eq $q;
 141
 142     $result = $versioning->compare($p, $q);
 143
 144     return ($result > 0);
 145 }
 146
 147 =item versions_compare(A, OP, B)
 148
 149 Returns true if A OP B, where OP is one of C<=>, C<< <= >>, C<< >= >>,
 150 C<<< << >>>, or C<<< >> >>>, and false otherwise.
 151
 152 =cut
 153
 154 sub versions_compare {
 155     my ($p, $op, $q) = @_;
 156     if    ($op eq  '=') { return versions_equal($p, $q) }
 157     elsif ($op eq '<=') { return versions_lte  ($p, $q) }
 158     elsif ($op eq '>=') { return versions_gte  ($p, $q) }
 159     elsif ($op eq '<<') { return versions_lt   ($p, $q) }
 160     elsif ($op eq '>>') { return versions_gt   ($p, $q) }
 161     else { croak("unknown operator $op") }
 162 }
 163
 164 =back
 165
 166 =head1 AUTHOR
 167
 168 Originally written by Russ Allbery <rra@debian.org> for Maemian and adapted
 169 to use libapt-pkg-perl by Adam D. Barratt <adam@adam-barratt-org.uk>.
 170
 171 =head1 SEE ALSO
 172
 173 lintian(1)
 174
 175 =cut
 176
 177 1;
 178
 179 # Local Variables:
 180 # indent-tabs-mode: nil
 181 # cperl-indent-level: 4
 182 # End:
 183 # vim: syntax=perl sw=4 sts=4 ts=4 et shiftround