# Copyright (c) 2003 Lev A. Serebryakov <lev@serebryakov.spb.ru>
#
#    This module is free software; you can redistribute it and/or modify it
#    under the same terms as Perl itself.
#
# This package contains object to store one revision from RCS file.
#
# $Id: Revision.pm 783 2003-12-05 17:08:35Z lev $
#
package Cvs::Repository::Revision;

use strict;

use vars qw($VERSION);
$VERSION  = join('.',0,76,('$LastChangedRevision: 783 $' =~ /^\$\s*LastChangedRevision:\s+(\d+)\s*\$$/),'cvs2svn');

use Cvs::Repository::Exception qw(:INTERNAL);

use constant TYPE_TRUNK        => 0;
use constant TYPE_BRANCH       => 1;
use constant TYPE_BRANCHMAGIC  => 2;
use constant TYPE_VENDOR       => 3;
use constant TYPE_VENDORMAGIC  => 4;

use overload 
  '""'  => \&getString,
  'eq'  => \&equal,
  '=='  => \&equal,
  'ne'  => \&nequal,
  '!='  => \&nequal,
  '<=>' => \&compare,
  'cmp' => \&compare;
  
my $__CACHE = {};  

sub Like
{
  return $_[0] =~ /^(?:\d+\.)+\d+$/;
}

sub New
{
  my $proto  = shift;
  my $class  = ref($proto) || $proto;
  
  my $rev    = shift || '';
  
  return $__CACHE->{$rev} if exists $__CACHE->{$rev};
  
  my @rev = ();
  my $self = bless({},$class);

  # Check generic format: dotted sequence of numbers
  throw "'$rev': general format violation" if $rev !~ /^(?:\d+\.)+\d+$/;
  @rev = split(/\./,$rev);
  # First & second numbers could not be zero and here must be 2 or more numbers
  throw "'$rev': not enough components" if $#rev < 1;
  ### We can parse 0.x and x.0 revisions now...

  $self->{'rev'} = $rev;
  # For Storable:
  $self->{'_'}   = $__CACHE;
  
  # Now try to determine type of revision.

  # Most cases:
  #  Even number of digits. Only vendor branches & external magic will have
  #  odd number of digits (last case will be parsed only if 0 == $strict.
  if($#rev % 2) {
    # Calculate number of zeroes, but scip first two digits
    my $z = 0;
    foreach my $d (@rev[2..$#rev]) {
      ++$z unless $d;
    }
    # Only one zero allowed: in magic branch it will be
    # pre-last digit
    if      (0 == $z) {
      if      (1 == $#rev) { # 2 elements -- trunk revision
        $self->{'type'} = TYPE_TRUNK;
      } elsif (3 == $#rev && 1 == $rev[1] && $rev[2] % 2 != 0) { # More elements & here is 'x.1.(2n+1).x'
        $self->{'type'} = TYPE_VENDOR;
      } elsif ($rev[$#rev - 1] % 2 == 0) { # More elements & here is 'x1.x2. ... .(2n).y
        $self->{'type'} = TYPE_BRANCH;
      } else {
        throw "'$rev': could not determine type of non-magic revision";
      }
    } elsif (1 == $z && !$rev[$#rev - 1]) {
      $self->{'type'} = TYPE_BRANCHMAGIC;
    } else {
      throw "'$rev': too many zeroes";
    }
  } else {
    # Other cases:
    #  Odd number of digits. Only allowed for x.1.(2n+1) VENDORMAGIC if strict
    if(2 == $#rev && 1 == $rev[1] && $rev[2] % 2 != 0) {
      $self->{'type'} = TYPE_VENDORMAGIC;
    } else {
      throw "'$rev': not a vendor branch";
    }
  }
  
  $__CACHE->{$rev} = $self;
  return $self;
}

sub getString
{
  my ($self) = @_;
  return $self->{'rev'};
}

sub type
{
  return $_[0]->{'type'} unless defined $_[1] && $_[1];
  return "--UNKNOWN--" unless $_[0]->{'type'} >= TYPE_TRUNK && $_[0]->{'type'} <= TYPE_VENDORMAGIC;
  return ('TRUNK','BRANCH','MAGIC','VENDOR','VENDOR MAGIC')[$_[0]->{'type'}];
}

sub isMagic
{
  return $_[0]->{'type'} == TYPE_BRANCHMAGIC || $_[0]->{'type'} == TYPE_VENDORMAGIC;
}

sub isTrunk
{
  return $_[0]->{'type'} == TYPE_TRUNK;
}

sub isBranch
{
  return $_[0]->{'type'} == TYPE_BRANCH || $_[0]->{'type'} == TYPE_VENDOR;
}

sub isVendor
{
  return $_[0]->{'type'} == TYPE_VENDOR || $_[0]->{'type'} == TYPE_VENDORMAGIC;
}

sub equal
{
  return $_[0]->{'rev'} eq $_[1]->{'rev'};
}

sub nequal
{
  return $_[0]->{'rev'} ne $_[1]->{'rev'};
}

sub compare
{
  my @l = split(/\./,$_[0]->{'rev'});
  my @r = split(/\./,$_[1]->{'rev'});

  # Remove zeroes from magic numbers
  splice @l,$#l-1,1 if TYPE_BRANCHMAGIC == $_[0]->{'type'};
  splice @r,$#r-1,1 if TYPE_BRANCHMAGIC == $_[1]->{'type'};

  while(@l && @r) {
    my $l = shift @l;
    my $r = shift @r;
    return $l - $r if $l - $r;
  }
  # Special case: branch magic is always greater than point on branch
  return 1  if TYPE_BRANCHMAGIC == $_[0]->{'type'} && $#r == 0;
  return -1 if TYPE_BRANCHMAGIC == $_[1]->{'type'} && $#l == 0;
  # And common cases: more revision, that have some tail
  return 1  if @l;
  return -1 if @r;
  return 0;
}

sub getNext
{
  if      (TYPE_BRANCHMAGIC == $_[0]->{'type'}) {
    my $new = $_[0]->{'rev'};
    $new =~ s/\.0\./\./;
    return $_[0]->New($new.'.1');
  } elsif (TYPE_VENDORMAGIC == $_[0]->{'type'}) {
    return $_[0]->New($_[0]->{'rev'}.'.1');
  } else {
    my @r = split(/\./,$_[0]->{'rev'});
    ++$r[$#r];
    return $_[0]->New(join('.',@r));
  }
}

sub getPrev
{
  my @r = split(/\./,$_[0]->{'rev'});

  if      (TYPE_BRANCHMAGIC == $_[0]->{'type'}) {
    # Remove two last digits
    return $_[0]->New(join('.',@r[0..$#r-2]));
  } elsif (TYPE_VENDORMAGIC == $_[0]->{'type'}) {
    # No previous revision at all
    return undef;
  } else {
    my @r = split(/\./,$_[0]->{'rev'});
    --$r[$#r];
    # and check: is zero?
    if(!$r[$#r]) {
      return undef if TYPE_TRUNK == $_[0]->{'type'};
      return $_[0]->New(join('.',@r[0..$#r-2]));
    } else {
      return $_[0]->New(join('.',@r));
    }
  }
}

sub toHead
{
  if(TYPE_TRUNK == $_[0]->{'type'}) {
    return $_[0]->getNext();
  } else {
    return $_[0]->getPrev();
  }
}

sub fromHead
{
  if(TYPE_TRUNK == $_[0]->{'type'}) {
    return $_[0]->getPrev();
  } else {
    return $_[0]->getNext();
  }
}

sub getBP
{
  if      (TYPE_TRUNK == $_[0]->{'type'}) {
    return undef;
  } elsif (TYPE_VENDOR == $_[0]->{'type'} || TYPE_VENDORMAGIC == $_[0]->{'type'}) {
    return $_[0]->New('1.1');
  } else {
    my @r = split(/\./,$_[0]->{'rev'});
    # Remove two last digits
    return $_[0]->New(join('.',@r[0..$#r-2]));
  }
}

sub getMagic
{
  if      (TYPE_TRUNK == $_[0]->{'type'}) {
    return undef;
  } elsif (TYPE_BRANCHMAGIC == $_[0]->{'type'} || TYPE_VENDORMAGIC == $_[0]->{'type'}) {
    return $_[0];
  } elsif (TYPE_BRANCH == $_[0]->{'type'}) {
    my $r = $_[0]->{'rev'};
    $r =~ s/\.(\d+)\.\d+$/\.0.$1/;
    return $_[0]->New($r);
  } else {
    my $r = $_[0]->{'rev'};
    $r =~ s/\.\d+$//;
    return $_[0]->New($r);
  }
}

sub getParent
{
  if      (TYPE_TRUNK == $_[0]->{'type'}) {
    return undef;
  } elsif (TYPE_BRANCHMAGIC == $_[0]->{'type'} || TYPE_VENDORMAGIC == $_[0]->{'type'}) {
    return $_[0]->getBP();
  } elsif (TYPE_BRANCH == $_[0]->{'type'} || TYPE_VENDOR == $_[0]->{'type'}) {
    return $_[0]->getMagic();
  }
}

sub getFirstRevision
{
  if      (TYPE_TRUNK == $_[0]->{'type'}) {
    return $_[0]->New('1.1');
  } elsif (TYPE_BRANCHMAGIC == $_[0]->{'type'}) {
    my $rev = $_[0]->{'rev'};
    $rev =~ s/\.0\.(\d+)$/.$1.1/;
    return $_[0]->New($rev);
  } elsif (TYPE_VENDORMAGIC == $_[0]->{'type'}) {
    return $_[0]->New($_[0]->{'rev'}.'.1');
  } elsif (TYPE_BRANCH == $_[0]->{'type'} || TYPE_VENDOR == $_[0]->{'type'}) {
    my $rev = $_[0]->{'rev'};
    $rev =~ s/\.(\d+)$/.1/;
    return $_[0]->New($rev);
  }
}

1;
