File Coverage

blib/lib/Git/Version/Compare.pm

Criterion	Covered	Total	%
statement	54	54	100.0
branch	12	12	100.0
condition	14	26	53.8
subroutine	9	9	100.0
pod	2	2	100.0
total	91	103	88.3

package Git::Version::Compare;
$Git::Version::Compare::VERSION = '1.004';
use strict;
use warnings;
use Exporter;
use Carp ();

my @ops = qw( lt gt le ge eq ne );

our @ISA         = qw(Exporter);
our @EXPORT_OK   = ( looks_like_git => map "${_}_git", cmp => @ops );
our %EXPORT_TAGS = ( ops => [ map "${_}_git", @ops ], all => \@EXPORT_OK );

# A few versions have two tags, or non-standard numbering:
# - the left-hand side is what `git --version` reports
# - the right-hand side is an internal canonical name
#
# We turn versions into strings, so we can use the fast `eq` and `gt`.
# The 6 elements are integers padded with 0:
# - the 4 parts of the dotted version (padded with as many .0 as needed)
# - '.000' if not an RC, or '-xxx' if an RC (- sorts before . in ascii)
# - the number of commits since the previous tag (for dev versions)
#
# The special cases are pre-computed below, the rest is computed as needed.
my %version_alias = (
    '0.99.7a' => '00.99.07.01.00.0000',
    '0.99.7b' => '00.99.07.02.00.0000',
    '0.99.7c' => '00.99.07.03.00.0000',
    '0.99.7d' => '00.99.07.04.00.0000',
    '0.99.8a' => '00.99.08.01.00.0000',
    '0.99.8b' => '00.99.08.02.00.0000',
    '0.99.8c' => '00.99.08.03.00.0000',
    '0.99.8d' => '00.99.08.04.00.0000',
    '0.99.8e' => '00.99.08.05.00.0000',
    '0.99.8f' => '00.99.08.06.00.0000',
    '0.99.8g' => '00.99.08.07.00.0000',
    '0.99.9a' => '00.99.09.01.00.0000',
    '0.99.9b' => '00.99.09.02.00.0000',
    '0.99.9c' => '00.99.09.03.00.0000',
    '0.99.9d' => '00.99.09.04.00.0000',
    '0.99.9e' => '00.99.09.05.00.0000',
    '0.99.9f' => '00.99.09.06.00.0000',
    '0.99.9g' => '00.99.09.07.00.0000',
    '0.99.9h' => '00.99.09.08.00.0000',    # 1.0.rc1
    '1.0.rc1' => '00.99.09.08.00.0000',
    '0.99.9i' => '00.99.09.09.00.0000',    # 1.0.rc2
    '1.0.rc2' => '00.99.09.09.00.0000',
    '0.99.9j' => '00.99.09.10.00.0000',    # 1.0.rc3
    '1.0.rc3' => '00.99.09.10.00.0000',
    '0.99.9k' => '00.99.09.11.00.0000',
    '0.99.9l' => '00.99.09.12.00.0000',    # 1.0.rc4
    '1.0.rc4' => '00.99.09.12.00.0000',
    '0.99.9m' => '00.99.09.13.00.0000',    # 1.0.rc5
    '1.0.rc5' => '00.99.09.13.00.0000',
    '0.99.9n' => '00.99.09.14.00.0000',    # 1.0.rc6
    '1.0.rc6' => '00.99.09.14.00.0000',
    '1.0.0a'  => '01.00.01.00.00.0000',
    '1.0.0b'  => '01.00.02.00.00.0000',
);

sub looks_like_git {
    return scalar $_[0] =~
        /^(?:v|git\ version\ )?                               # prefix
          [0-9]+(?:[.-](?:0[ab]?|[1-9][0-9a-z]*|[a-zA-Z]+))*  # x.y.z.*
          (?:[.-]?rc[0-9]+)?                                  # rc
          (?:[.-](GIT|[1-9][0-9]*[.-]g[A-Fa-f0-9]+))?         # devel
          (?:\ .*)?                                           # comment
         $/x;
}

sub _normalize {
    my ($v) = @_;
    return undef if !defined $v;

    # minimal consistency check
    Carp::croak "$v does not look like a Git version" if !looks_like_git($v);

    # reformat git.git tag names, output of `git --version`
    $v =~ s/^v|^git version |\.[a-zA-Z]+\..*|[\012\015]+\z//g;
    $v =~ y/-/./;
    $v =~ s/0rc/0.rc/;
    ($v) = split / /, $v;    # drop anything after the version

    # can't use exists() because the assignment in the @ops created the slot
    return $version_alias{$v} if defined $version_alias{$v};

    # split the dotted version string
    my @v = split /\./, $v;
    my ( $r, $c ) = ( 0, 0 );

    # commit count since the previous tag
    ($c) = ( 1, splice @v, -1 ) if $v[-1] eq 'GIT';           # before 1.4
    ($c) = splice @v, -2 if substr( $v[-1], 0, 1 ) eq 'g';    # after  1.4

    # release candidate number
    ($r) = splice @v, -1 if substr( $v[-1], 0, 2 ) eq 'rc';
    $r &&= do { $r =~ s/rc//; sprintf '-%02d', $r };

    # compute and cache normalized string
    return $version_alias{$v} =
        join( '.', map sprintf( '%02d', $_ ), ( @v, 0, 0, 0 )[ 0 .. 3 ] )
      . ( $r || '.00' )
      . sprintf( '.%04d', $c );
}

for my $op (@ops) {
    no strict 'refs';
    *{"${op}_git"} = eval << "OP";
    sub {
        my ( \$v1, \$v2 ) = \@_;
        \$_ = \$version_alias{\$_} ||= _normalize( \$_ ) for \$v1, \$v2;
        return \$v1 $op \$v2;
    }
OP
}

sub cmp_git ($$) {
    my ( $v1, $v2 ) = @_;
    $_ = $version_alias{$_} ||= _normalize( $_ ) for $v1, $v2;
    return $v1 cmp $v2;
}

1;

__END__