Added lots more modules from lintian. Maemian appears to work.

[maemian] / lib / Maemian / Relation / Version.pm

diff --git a/lib/Maemian/Relation/Version.pm b/lib/Maemian/Relation/Version.pm
new file mode 100644 (file)
index 0000000..31f50cd
--- /dev/null
+++ b/lib/Maemian/Relation/Version.pm
@@ -0,0 +1,183 @@
+# -*- perl -*-
+# Maemian::Relation::Version -- comparison operators on Debian versions
+
+# Copyright (C) 1998 Christian Schwarz and Richard Braakman
+# Copyright (C) 2004-2009 Russ Allbery <rra@debian.org>
+# Copyright (C) 2009 Adam D. Barratt <adam@adam-barratt.org.uk>
+#
+# 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/>.
+
+package Maemian::Relation::Version;
+
+use strict;
+use warnings;
+
+use Carp qw(croak);
+
+use base 'Exporter';
+BEGIN {
+    our @EXPORT = qw(versions_equal versions_lte versions_gte versions_lt
+                     versions_gt versions_compare);
+}
+
+use AptPkg::Config '$_config';
+my $versioning = $_config->system->versioning;
+
+=head1 NAME
+
+Maemian::Relation::Version - Comparison operators on Debian versions
+
+=head1 SYNOPSIS
+
+    print "yes\n" if versions_equal('1.0', '1.00');
+    print "yes\n" if versions_gte('1.1', '1.0');
+    print "no\n" if versions_lte('1.1', '1.0');
+    print "yes\n" if versions_gt('1.1', '1.0');
+    print "no\n" if versions_lt('1.1', '1.1');
+    print "yes\n" if versions_compare('1.1', '<=', '1.1');
+
+=head1 DESCRIPTION
+
+This module provides five functions for comparing version numbers.  The
+underlying implementation uses C<libapt-pkg-perl> to ensure that
+the results match what dpkg will expect.
+
+=head1 FUNCTIONS
+
+=over 4
+
+=item versions_equal(A, B)
+
+Returns true if A is equal to B (C<=>) and false otherwise.
+
+=cut
+
+sub versions_equal {
+    my ($p, $q) = @_;
+    my $result;
+
+    return 1 if $p eq $q;
+
+    $result = $versioning->compare($p, $q);
+    
+    return ($result == 0);
+}
+
+=item versions_lte(A, B)
+
+Returns true if A is less than or equal (C<< <= >>) to B and false
+otherwise.
+
+=cut
+
+sub versions_lte {
+    my ($p, $q) = @_;
+    my $result;
+
+    return 1 if $p eq $q;
+
+    $result = $versioning->compare($p, $q);
+
+    return ($result <= 0);
+}
+
+=item versions_gte(A, B)
+
+Returns true if A is greater than or equal (C<< >= >>) to B and false
+otherwise.
+
+=cut
+
+sub versions_gte {
+    my ($p, $q) = @_;
+    my $result;
+
+    return 1 if $p eq $q;
+
+    $result = $versioning->compare($p, $q);
+
+    return ($result >= 0);
+}
+
+=item versions_lt(A, B)
+
+Returns true if A is less than (C<<< << >>>) B and false otherwise.
+
+=cut
+
+sub versions_lt {
+    my ($p, $q) = @_;
+    my $result;
+
+    return 0 if $p eq $q;
+
+    $result = $versioning->compare($p, $q);
+
+    return ($result < 0);
+}
+
+=item versions_gt(A, B)
+
+Returns true if A is greater than (C<<< >> >>>) B and false otherwise.
+
+=cut
+
+sub versions_gt {
+    my ($p, $q) = @_;
+    my $result;
+
+    return 0 if $p eq $q;
+
+    $result = $versioning->compare($p, $q);
+
+    return ($result > 0);
+}
+
+=item versions_compare(A, OP, B)
+
+Returns true if A OP B, where OP is one of C<=>, C<< <= >>, C<< >= >>,
+C<<< << >>>, or C<<< >> >>>, and false otherwise.
+
+=cut
+
+sub versions_compare {
+    my ($p, $op, $q) = @_;
+    if    ($op eq  '=') { return versions_equal($p, $q) }
+    elsif ($op eq '<=') { return versions_lte  ($p, $q) }
+    elsif ($op eq '>=') { return versions_gte  ($p, $q) }
+    elsif ($op eq '<<') { return versions_lt   ($p, $q) }
+    elsif ($op eq '>>') { return versions_gt   ($p, $q) }
+    else { croak("unknown operator $op") }
+}
+
+=back
+
+=head1 AUTHOR
+
+Originally written by Russ Allbery <rra@debian.org> for Maemian and adapted
+to use libapt-pkg-perl by Adam D. Barratt <adam@adam-barratt-org.uk>.
+
+=head1 SEE ALSO
+
+lintian(1)
+
+=cut
+
+1;
+
+# Local Variables:
+# indent-tabs-mode: nil
+# cperl-indent-level: 4
+# End:
+# vim: syntax=perl sw=4 sts=4 ts=4 et shiftround