#
# 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 parsed RCS file.
#
# It stores `Admin' part & collection of deltas
#
# $Id: File.pm 1243 2005-11-13 15:33:48Z lev $
#
package Cvs::Repository::File;

use strict;

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

use Cvs::Repository::Exception qw(:INTERNAL);
use Cvs::Repository::Reader;
use Cvs::Repository::Delta;
use Cvs::Repository::DeltaCache;

sub New
{
  my $proto    = shift;
  my $name     = shift;
  my $CB       = shift || {};
  my $needtext = shift || 0;

  my $class = ref($proto) || $proto;
  my $self = bless({},$class);

  my $s;
  my $reader;

  $self->{'head'}       = undef;
  $self->{'branch'}     = undef;
  $self->{'access'}     = '';
  $self->{'symbols'}    = {};
  $self->{'locks'}      = '';
  $self->{'comment'}    = '';
  $self->{'expand'}     = '';
  $self->{'desc'}       = '';
  $self->{'newphrases'} = {};
  $self->{'deltas'}     = {};
  $self->{'_tree'}      = undef;
  $self->{'_name'}      = $name;
  $self->{'_tips'}      = undef;
  $self->{'_rev2sym'}   = undef;
  $self->{'_exec'}      = 0;

  foreach my $event (qw(InvalidSymbol)) {
    $CB->{$event} = 1 unless exists $CB->{$event} && defined $CB->{$event};
  }
  
  $reader = Cvs::Repository::Reader->New($name);
  $self->{'_exec'} = 1 if-x $name;

  # Fill buffer up to 'desc' line.
  $reader->fillBuffer(sub { return $_[0] !~ /\bdesc\b/; });

  $s = $reader->readWord();
  throw "Could not find 'head' line" unless defined $s;
  throw "Invalid first word '$s', 'head' expected" if $s ne 'head';
  # Read head revision
  $s = $reader->readUpToSemicolon();
  throw "Could not find head revision" unless defined $s;
  eval {
    $self->{'head'} = Cvs::Repository::Revision->New($s);
  };
  rethrow "Invalid head revision '$s'";

  # Ok, now we should find 'branch' or 'access'
  $s = $reader->readWord();
  throw "Could not find 'branch' or 'access' line" unless defined $s;
  throw "Invalid word '$s', 'branch' or 'access' expected" if $s ne 'branch' && $s ne 'access';

  if($s eq 'branch') {
    $s = $reader->readUpToSemicolon();
    throw "Could not find branch revision" unless defined $s;
    # $str could be empty. It is Ok here.
    if($s) {
      eval {
        $self->{'branch'} = Cvs::Repository::Revision->New($s);
      };
      rethrow "Invalid branch revision '$s'";
    }
    # and now we MUST find 'access'
    $s = $reader->readWord();
    throw "Could not find 'access' line" unless defined $s;
    throw "Invalid word '$s', 'access' expected" if $s ne 'access';
  }

  # Access should be here in any case
  $s = $reader->readUpToSemicolon();
  throw "Could not find access specification" unless defined $s;
  $self->{'access'} = $s;

  # And now: symbol
  $s = $reader->readWord();
  throw "Could not find 'symbols' line" unless defined $s;
  throw "Invalid word '$s', 'symbols' expected" if $s ne 'symbols';

  $s = $reader->readUpToSemicolon();
  throw "Could not find 'symbols' specification" unless defined $s;
  if($s) {
    foreach my $sm (split(/\s+/,$s)) {
      throw "Invalid 'symbols' specification: '$sm'" if $sm !~ /^(\S+)\s*:\s*(\S+)$/;
      my $sym = $1;
      my $rev = $2;
      # Check symbol format
      condthrow("Symbol '$sym' contains invalid characters",$CB,'InvalidSymName',$self,$rev,$sym) unless $sym =~ /^[[:alpha:]][[:graph:]]*$/i && $sym !~ /[\$,\.:;\@]/;
      condthrow("Symbol '$sym' encountered more than once",$CB,'DoubleRev',$self,$rev,$sym) if exists $self->{'symbols'}->{$sym};
      eval {
        $self->{'symbols'}->{$sym} = Cvs::Repository::Revision->New($rev);
      };
      condrethrow("Invalid symbol '$sym' revision '$rev'",$CB,'InvalidSymRev',$self,$rev,$sym);
    }
  }

  # Ok, here should be 'locks'
  $s = $reader->readWord();
  throw "Could not find 'locks' line" unless defined $s;
  throw "Invalid word '$s', 'locks' expected" if $s ne 'locks';

  $s = $reader->readUpToSemicolon();
  throw "Could not find locks specification" unless defined $s;
  $self->{'locks'} = $s;

  # Hard case: here could be 'strict;' or something else...
  $s = $reader->readWord();
  throw "Could not find 'strict;' line or something else" unless defined $s;
  if      ($s eq 'strict')  {
    $s = $reader->readUpToSemicolon();
    throw "Could not find 'strict;' semicolon" unless defined $s;
    throw "Invalid 'strict' specification: 'strict $s;'" if $s;
    $self->{'locks'} .= '; strict';
  } elsif ($s eq 'strict;') {
    $self->{'locks'} .= '; strict';
  } else {
    # put it back!
    $reader->ungetLine($s);
  }

  # Here could be 'comment', or 'expand' or 'anyword' or proper revision
  $s = $reader->readWord();
  throw "Could not find 'comment', 'expand', newphrases or deltas" unless defined $s;
  
  # Here is comment
  if($s eq 'comment') {
    ($s,undef,undef) = $reader->readString();
    throw "Could not find 'comment' string" unless defined $s;
    $self->{'comment'} = $s;
    $s = $reader->readUpToSemicolon();
    throw "Could not find ';' after 'comment'" unless defined $s;
    throw "Unexpected word '$s', after 'comment'" if $s;
    $s = $reader->readWord();
    throw "Could not find 'expand', newphrases or deltas" unless defined $s;
  }

  if($s eq 'expand') {
    ($s,undef,undef) = $reader->readString();
    throw "Could not find 'expand' string" unless defined $s;
    $self->{'expand'} = $s;
    $s = $reader->readUpToSemicolon();
    throw "Could not find ';' after 'expand'" unless defined $s;
    throw "Unexpected word '$s', after 'expand'" if $s;
    $s = $reader->readWord();
    throw "Could not find newphrases or deltas" unless defined $s
  }

  # Parse newphrases
  while($s !~ /^[0-9.]+$/ && $s ne 'desc') {
    my $str = $reader->readUpTopSemicolon();
    throw "Could not find newphrase '$s' data" unless defined $str;
    $self->{'newphrases'}->{$s} = $str;
    $s = $reader->readWord();
    throw "Could not find newphrases or deltas" unless defined $s
  }
  # Put revision for first delta BACK
  $reader->ungetLine($s);

  # Start to parse deltas
  my $r = 1;
  while($r) {
    my $d = Cvs::Repository::Delta->New();
    eval {
      $r = $d->Read($reader);
    };
    rethrow "Could not read delta";
    if($r) {
      my $rev = $d->rev()->getString();
      throw "Double delta for revision '$rev'" if exists $self->{'deltas'}->{$rev};
      $self->{'deltas'}->{$rev} = $d;
    } else {
      $d = undef;
    }
  }

  # and read 'desc' now
  $s = $reader->readWord();
  throw "Could not find 'desc' line" unless defined $s;
  throw "Invalid word '$s', 'desc' expected" if $s ne 'desc';
  ($s,undef,undef) = $reader->readString();
  throw "Could not find 'desc' string" unless defined $s;
  $self->{'desc'} = $s;

  # And read logs for deltas
  while(1) {
    $s = $reader->readWord();
    last unless defined $s;
    my $rev;
    eval {
      $rev = Cvs::Repository::Revision->New($s);
    };
    rethrow "Invalid deltatext revision '$s'";
    throw "Deltatext for unknown delta '$s'" unless exists $self->{'deltas'}->{$s};
    eval {
      $self->{'deltas'}->{$s}->readDeltaText($reader,$needtext);
    };
    rethrow "Could not read deltatext '$s'";
  }
  
  # Close $reader explicitly
  undef $reader;

  return $self;
}

sub buildRevisionsTree
{
  my $self = shift;
  my $CB   = shift || {};

  # Set default behavior for known errors
  foreach my $event (qw(LostRevision)) {
    $CB->{$event} = 1 unless exists $CB->{$event} && defined $CB->{$event};
  }

  # No head is not-conditional error, it could not be switched-off
  throw "No 'head' revision '".$self->{'head'}."' was loaded" unless exists $self->{'deltas'}->{$self->{'head'}};
  # Call build tree quasi-recursive procedure from head
  $self->{'deltas'}->{$self->{'head'}}->buildTree($self->{'deltas'});
  # And now check tree integrity!
  while(my ($r,$d) = each %{$self->{'deltas'}}) {
    if      (!defined $d->{'_tp'}) {
      # "too many roots" is not-conditional error
      throw "Too many roots: '$self->{'_tree'}->{'rev'}' and '$r'" if defined $self->{'_tree'};
      $self->{'_tree'} = $d;
    }
    if(!defined $d->{'_tn'} && !defined $d->{'_tp'} && $d != $self->{'_tree'}) {
      condthrow("Revision '$r' is not in revisions tree",$CB,'LostRevision',$self,$r);
      # If we here, we could delete this revision from pool
      delete $self->{'deltas'}->{$r};
    }
  }
}

sub checkSymbols
{
  my $self = shift;
  my $CB   = shift || {};

  # Set default behavior for known errors
  foreach my $event (qw(UnnamedBranch LostBranch DoubleSymbol LostSymbol)) {
    $CB->{$event} = 1 unless exists $CB->{$event} && defined $CB->{$event};
  }

  $self->{'_tips'} = {};
  # Reverse symbol -> revision mapping
  while(my ($s,$r) = each %{$self->{'symbols'}}) {
    # Check: is simple symbol have revision?
    if(!$r->isMagic() && !exists $self->{'deltas'}->{$r}) {
      condthrow("Invalid symbol '$s': no revision '$r'",$CB,'LostSymbol',$self,$r,$s);
      delete $self->{'symbols'}->{$s};
      next;
    }

    # Here is symbol for this revision already?
    if(exists $self->{'_rev2sym'}->{$r}) {
      condthrow("Too many symbols for magic revision '$r'",$CB,'DoubleSymbol',$self,$r) if $r->isMagic();
      # Add symbol to map
      push @{$self->{'_rev2sym'}->{$r}}, $s;
    } else {
      # No symbols for this revision was found
      $self->{'_rev2sym'}->{$r} = [ $s ];
    }
    # If revision is 'magic' one, find tip (sub-head) of this branch
    if($r->isMagic()) {
      # Try to start from first revision in branch
      my $tip;
      my $magic = $r->getMagic();
      if(exists $self->{'_tips'}->{$magic}) {
        # For second symbol
        $tip = $self->{'_tips'}->{$magic};
      } else {
        $tip = $r->getNext();
        # Sanity check. It is very strange to have this error
        throw "Could not generate first revision in branch '$r'" unless defined $tip;
        # Is here branch revisions?
        if(exists $self->{'deltas'}->{$tip}) { # This file have revisions in this branch
          my $d = $self->{'deltas'}->{$tip};
          # Travel sub-tree up to sub-head
          while(defined $d->treeNext()) {
            $d = $d->treeNext();
          }
          $tip = $d->rev();
        } else {                             # This file doesn't have revisions in this branch
          $tip = $r->getBP();
          # Very strange: branch point generation failed!
          throw "Could not generate branch point in branch '$r'" unless defined $tip;
          if(!exists $self->{'deltas'}->{$tip}) {
            condthrow("Could not find branch point '$tip' for '$r'",$CB,'LostBranch',$self,$r,$tip);
            $tip = undef;
          }
        }
      }
      # Store tip of branch by symbol & by magic
      if(defined $tip) {
        $self->{'_tips'}->{$s}     = $tip;
        $self->{'_tips'}->{$magic} = $tip;
      }
    }
  }

  # Ok, make sure, that all branches are symboled
  foreach my $r (keys %{$self->{'deltas'}}) {
    $r = Cvs::Repository::Revision->New($r);
    if($r->isBranch()) {
      my $magic = $r->getMagic();
      condthrow(
        "Branch '$magic' (from '".$r->getBP()."', revision '$r') doesn't have symbol",
        $CB,'UnnamedBranch',
        $self,$r
      ) unless exists $self->{'_rev2sym'}->{$magic};
    }
  }

}

sub checkDates
{
  my $self = shift;
  my $CB   = shift || {};

  foreach my $event (qw(TimeMismatch RevMismatch)) {
    $CB->{$event} = 1 unless exists $CB->{$event} && defined $CB->{$event};
  }
  
  foreach my $cd (values %{$self->{'deltas'}}) {
    my $pd = $cd->treePrev();
    next unless $pd;
    next unless $cd->rev()->type() != Cvs::Repository::Revision::TYPE_VENDOR || $pd != $self->tree();

    condthrow(
      "Delta '".$cd->rev()."' goes after '".$pd->rev()."' and time goes backward.",
      $CB,'TimeMismatch',
      $self,$cd,$pd
    ) unless $cd->date() > $pd->date();
  }
}

sub checkOut
{
  my ($self,$cache,$rev,$branch) = @_;
  my $text = undef;
  
  $rev = 'HEAD' unless defined $rev; 

  my $d = $self->deltas($rev,$branch);
  return undef unless defined $d && $d->state() ne 'dead';
  
  # Create stack of revisions. Top of stack will be 'head' revision.
  my @revstack;
  # Push first delta
  push @revstack, $d;
  while($d->rev() != $self->{'head'}) {
    $d = $d->treeStepToHead();
    push @revstack, $d;
  }
  
  # Now we should find latest revision in stack,
  # which text is in cache
  my $hl;
  if(defined $cache && $cache->resultsEnabled()) {
    for($hl = 0; $hl <= $#revstack; ++$hl) {
      last if defined ($text = $cache->getResult($revstack[$hl]));
    }
  }
  
  my $reader = Cvs::Repository::Reader->New($self->{'_name'});
  # We have revision, which have text in stack
  if(defined $text) {
    # We should get copy of conent or it will be changed later :)
    $text = [ @{$text} ];
    # And delete this revision and all others
    if($hl > 0) {
      splice @revstack, $hl, scalar(@revstack) - $hl;
    } else {
      @revstack = ();
    }  
  } else {
    # No revision on stack with cached result, get first one and re-read it
    $d = pop @revstack;
    eval { $d->reReadDeltaText($reader); };
    rethrow("Could not checkout '$rev' from '".$self->{'_name'}."'");
    $text = [ split(/(?<=\n)/,$d->deltatext()) ];
    # Add result to cache, if it is result :)
    $cache->addResult($d,[ @{$text} ]) if defined $cache && $cache->resultsEnabled() && $d->rev() == $self->{'head'};
    # And forgot about deltatext
    $d->discardDeltaText();
  }

  # Apply patches
  while($d = pop @revstack) {
    eval { $text = $d->applyDeltaText($cache,$text,$reader); };
    rethrow("Could not checkout '$rev' from '".$self->{'_name'}."'");
    # Add result to cache
    $cache->addResult($d,[ @{$text} ]) if defined $cache && $cache->resultsEnabled();
  }
  $reader = undef;
  # Return as one big text
  return join('',@{$text});
}

sub getBranchName
{
  my ($self,$r) = @_;
  my $rev = undef;

  return undef unless defined $r && $r;

  # Try to convert parameter to proper revision
  $rev = $self->makeRevision($r);
  return undef unless defined $rev;
  
  # Trunk branch have name 'HEAD'
  if($rev->isTrunk()) {
    #@TODO. Was: $a
    return  'HEAD'  unless wantarray;
    return ('HEAD');
  }
  # Get magic version of revision
  $rev = $rev->getMagic() unless $rev->isMagic();
  # If here is no symbol for this branch, return undef
  return undef unless exists $self->{'_rev2sym'}->{$rev};
  # Return any name unless client want ALL names
  return $self->{'_rev2sym'}->{$rev}->[0] unless wantarray;
  return @{$self->{'_rev2sym'}->{$rev}};
}

sub head
{
  return $_[0]->{'head'};
}

sub branch
{
  return $_[0]->{'branch'};
}

sub access
{
  return $_[0]->{'access'};
}

sub symbols
{
  my ($self,$s) = @_;
  my $rev;
  
  # No param: return whole symbols table
  return $self->{'symbols'} unless defined $s && $s;
  
  # check, is it revision or not, don't use symbols!
  $rev = $self->makeRevision($s,1);
  # If it is revision, process it
  if(defined $rev) {
    return undef unless exists $self->{'_rev2sym'}->{$rev};
    return $self->{'_rev2sym'}->{$rev}->[0] unless wantarray;
    return @{$self->{'_rev2sym'}->{$rev}};
  }
  # Check magic
  if($s eq 'HEAD') {
    return $self->{'head'} unless wantarray;
    return ($self->{'head'});
  }
  if(exists $self->{'symbols'}->{$s}) {
    return $self->{'symbols'}->{$s} unless wantarray;
    return ($self->{'symbols'}->{$s});
  }
  # Could not find anything
  return undef;
}

sub locks
{
  return $_[0]->{'locks'};
}

sub comment
{
  return $_[0]->{'comment'};
}

sub expand
{
  return $_[0]->{'expand'};
}

sub desc
{
  return $_[0]->{'desc'};
}

sub newphrases
{
  return $_[0]->{'newphrases'} unless defined $_[1] && $_[1];
  return undef unless exists $_[0]->{'newphrases'}->{$_[1]};
  return $_[0]->{'newphrases'}->{$_[1]};
}

sub deltas
{
  my ($self,$r,$b) = @_;
  my $rev = undef;

  # Whole table if no parameter
  return $self->{'deltas'} unless defined $r && $r;

  # Special case: revision is date as unixtime
  if($r =~ /^\d+$/) {
    my $d;
    if(!defined $b || !$b || $b eq 'HEAD') {
      $d = $self->{'_tree'};
      # No revision for this time, if first revision was created before
      return undef if $d->date() > $r;
      # Find forward
      while(1) {
        my $n = $d->treeNext();
        # If next revision before given time?
        if(defined $n && $n->date() < $r) {
          $d = $n;
        } else {
          # No next revision or it is after given time
          last;
        }
      }
      return $d;
    } else {
      # check out on not existing branch is OK.
      return undef unless exists $self->{'symbols'}->{$b};
      # But this is error!
      if(!$self->{'symbols'}->{$b}->isMagic()) {
        $d = $self->{'deltas'}->{$self->{'symbols'}->{$b}};
        return undef unless $d->date() < $r;
        return $d;
      }
      # Check special case: branch created after given time
      my $bp = $self->{'deltas'}->{$self->{'symbols'}->{$b}->getBP()};
      return undef if $bp->date() > $rev;

      # Take root of tree
      $d = $self->{'_tips'}->{$b};
      # Finds backward, we have guarantee, that branch point is OLDER than asked
      while($d != $bp) {
        last if $d->date() < $rev;
        $d = $d->treePrev();
      }
      return $d;
    }
  }

  $rev = $self->makeRevision($r);
  return undef unless defined $rev;

  # Rev is object in any case now!
  if($rev->isMagic()) {
    return undef unless exists $self->{'_tips'}->{$rev};
    $rev = $self->{'_tips'}->{$rev};
  }
  return undef unless exists $self->{'deltas'}->{$rev};
  return $self->{'deltas'}->{$rev};
}

sub tree
{
  return $_[0]->{'_tree'};
}

sub name
{
  return $_[0]->{'_name'};
}

sub exec
{
  return $_[0]->{'_exec'};
}

sub makeRevision
{
  my $rev = undef;
  # Try to convert parameter into revision
  if      (ref($_[1]) eq 'Cvs::Repository::Revision') {
    $rev = $_[1];
  } elsif (Cvs::Repository::Revision::Like($_[1])) {
    eval { $rev = Cvs::Repository::Revision->New($_[1]); };
    $rev = undef if $@;
  }
  # Last variant: check symbols for this name, if it is enabled
  $rev = $_[0]->symbols($_[1]) unless defined $rev || $_[2];
  return $rev;
}

sub DESTROY
{
  my $self = shift;

  foreach my $k (keys %{$self->{'deltas'}}) {
    $self->{'deltas'}->{$k}->breakAllLinks() if defined $self->{'deltas'}->{$k};
    $self->{'deltas'}->{$k} = undef;
    delete $self->{'deltas'}->{$k};
  }
  foreach my $k (keys %{$self->{'_tips'}}) {
    $self->{'_tips'}->{$k} = undef;
    delete $self->{'_tips'}->{$k};

  }
  foreach my $k (keys %{$self->{'_rev2sym'}}) {
    $self->{'_rev2sym'}->{$k} = undef;
    delete $self->{'_rev2sym'}->{$k};

  }
  $self->{'_tree'} = undef;
}

1;
