package CheckVer;
use warnings;
use strict;
use integer;

# Since no objects are instantiated here, this file provides just a
# module, not a class.  The subroutines given here compare and check
# vname (virtual package) versions.

# Private subroutines: compare version substrings.  (Some of these
# private subroutines, unlike the public ones below, assume defined
# input.)
sub cmp_ver_char ($$) {
  my( $a , $b  ) = @_;
  my( $a0, $b0 );
  for (
    [ \$a, \$a0 ],
    [ \$b, \$b0 ],
  ) {
    my( $ab, $ab0 ) = @$_;
    $$ab0 = $$ab =~ /^[A-Za-z]$/ ? 0 : 1;
  }
  my $cmp1 = $a0 <=> $b0;
  $cmp1 and return $cmp1;
  $a cmp $b;
}
sub cmp_ver_substr_nondig ($$) {
  my( $a, $b ) = @_;
  my $a_len = length $a;
  my $b_len = length $b;
  for ( my $i = 0; $i < $a_len && $i < $b_len; ++$i ) {
    my $cmp1 = cmp_ver_char substr($a,$i,1), substr($b,$i,1);
    return $cmp1 if $cmp1;
  }
  $a_len <=> $b_len;
}
sub cmp_ver_substr_dig ($$) {
  my( $a, $b ) = @_;
  defined($a) && length($a) or $a = 0;
  defined($b) && length($b) or $b = 0;
  $a <=> $b;
}
sub cmp_ver_substr ($$) {
  my( $a, $b ) = @_;
  defined $a or $a = '';
  defined $b or $b = '';
  while ( length($a) || length($b) ) {
    my( $a_nondig, $a_dig );
    my( $b_nondig, $b_dig );
    for (
      [ \$a, \$a_nondig, \$a_dig ],
      [ \$b, \$b_nondig, \$b_dig ],
    ) {
      my( $ab, $nondig, $dig ) = @$_;
      my $right;
      ( $$nondig, $$dig, $right ) = $$ab =~ /^([^0-9]*)([0-9]*)(.*)/;
      $$ab = $right;
    }
    my $cmp_nondig = cmp_ver_substr_nondig $a_nondig, $b_nondig;
    return $cmp_nondig if $cmp_nondig;
    my $cmp_dig    = cmp_ver_substr_dig    $a_dig   , $b_dig   ;
    return $cmp_dig    if $cmp_dig   ;
  }
  return 0;
}

# Public subroutine: compare version strings.
sub cmp_ver_string ($$) {
  my( $a, $b ) = @_;
  defined($a) && defined($b) && length($a) && length($b)
    or return undef;
  my( $a_epoch, $a_upstream, $a_debian );
  my( $b_epoch, $b_upstream, $b_debian );
  for (
    [ \$a, \$a_epoch, \$a_upstream, \$a_debian ],
    [ \$b, \$b_epoch, \$b_upstream, \$b_debian ],
  ) {
    # Separate the version string into its principal parts.
    # (See Policy 5.6.11, v 3.6.1.1.)
    my( $ab, $epoch, $upstream, $debian ) = @$_;
    ( $$epoch, $$upstream, $$debian ) =
      $$ab =~
        /^(?:([0-9]*):)?([A-Za-z0-9+.:-]*?)(?:-([A-Za-z0-9+.]*))?$/
      or die "$0: bad version number $$ab";
  }
  my $cmp_epoch    = cmp_ver_substr_dig $a_epoch   , $b_epoch   ;
  return $cmp_epoch    if $cmp_epoch  ;
  my $cmp_upstream = cmp_ver_substr     $a_upstream, $b_upstream;
  return $cmp_upstream if $cmp_upstream;
  return             cmp_ver_substr     $a_debian  , $b_debian  ;
}

# Public subroutine: compare or check a vname's version against a given
# $ver requirement.  Note that when no $ver is given to check against,
# the check is always passed.  (But, when a $ver is given and the vname
# has no version, the check is failed.  A vname with no version can pass
# no check, except when no standard is given to check against.)
sub check_ver ($$$) {
  my( $ver0, $rel, $ver ) = @_;
  defined($ver ) && length($ver ) or return '1';
  defined($ver0) && length($ver0) or return '' ;
  my $cmp1  = cmp_ver_string $ver0, $ver;
  !defined( $cmp1 ) || (
    $rel eq '<<' && $cmp1 <  0 ||
    $rel eq '<=' && $cmp1 <= 0 ||
    $rel eq '='  && $cmp1 == 0 ||
    $rel eq '>=' && $cmp1 >= 0 ||
    $rel eq '>>' && $cmp1 >  0
  );
}

1;

