head	1.16;
access;
symbols;
locks
	eivind:1.16; strict;
comment	@# @;


1.16
date	2000.03.20.21.33.58;	author eivind;	state Exp;
branches;
next	1.15;

1.15
date	2000.03.20.21.31.57;	author eivind;	state Exp;
branches;
next	1.14;

1.14
date	2000.03.19.16.54.53;	author eivind;	state Exp;
branches;
next	1.13;

1.13
date	2000.03.19.16.48.07;	author eivind;	state Exp;
branches;
next	1.12;

1.12
date	2000.03.19.16.28.05;	author eivind;	state Exp;
branches;
next	1.11;

1.11
date	2000.03.19.15.58.41;	author eivind;	state Exp;
branches;
next	1.10;

1.10
date	2000.03.18.13.50.46;	author eivind;	state Exp;
branches;
next	1.9;

1.9
date	2000.03.18.12.11.03;	author eivind;	state Exp;
branches;
next	1.8;

1.8
date	2000.03.18.11.58.33;	author eivind;	state Exp;
branches;
next	1.7;

1.7
date	2000.03.18.10.49.20;	author eivind;	state Exp;
branches;
next	1.6;

1.6
date	2000.03.18.10.37.02;	author eivind;	state Exp;
branches;
next	1.5;

1.5
date	2000.03.17.17.35.17;	author eivind;	state Exp;
branches;
next	1.4;

1.4
date	2000.03.17.16.50.01;	author eivind;	state Exp;
branches;
next	1.3;

1.3
date	2000.03.17.16.02.58;	author eivind;	state Exp;
branches;
next	1.2;

1.2
date	2000.03.09.18.41.20;	author eivind;	state Exp;
branches;
next	1.1;

1.1
date	2000.03.09.18.25.27;	author eivind;	state Exp;
branches;
next	;


desc
@Temp commit.
@


1.16
log
@Fix typos from last commit.
@
text
@#!/usr/bin/perl
#
# Copyright (c) 2000
#	Eivind Eklund.  All Rights Reserved.
#
# Redistribution and use in source and binary forms, with or without
# modification, are permitted provided that the following conditions
# are met:
# 1. Redistributions of source code must retain the above copyright
#    notice, this list of conditions and the following disclaimer.
# 2. Redistributions in binary form must reproduce the above copyright
#    notice, this list of conditions and the following disclaimer in the
#    documentation and/or other materials provided with the distribution.
# 3. Neither the name of the Author nor the names of any contributors
#    may be used to endorse or promote products derived from this software
#    without specific prior written permission.
# 4. Restrictions on adding further restrictions may not be applied to
#    this code (or derivate works) without prior written approval from
#    the author.
# 5. By submitting changes to this software ("patches" or similar) to
#    the Author without a note explictly stating otherwise, you accept
#    that the Author may incorporate the changes into the software for
#    public release under this license.  You further give the Author
#    the right to re-release any public release of this software under
#    any other license of his choice, including the changes you submit.
#    You accept full responsibility for ensuring that you are allowed
#    to grant these rights.
# 6. By making changes to this software, you accept to hold the Author
#    harmless should any of your changes by mistake be submitted to
#    the Author without a note (per clause 5.), even if it is incorporated
#    into the public version.  Your only rememdy shall be to be able
#    get your changes removed from subsequent releases of the public
#    version, as long as the Author has been notified of the errant
#    inclusion within 3 months of the first public release containing
#    the changes.
#
# THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND
# ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
# IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
# ARE DISCLAIMED.  IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE
# FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
# DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
# OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
# HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
# LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
# OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
# SUCH DAMAGE.
#
# $Id: CVSFile.pm,v 1.15 2000/03/20 21:31:57 eivind Exp eivind $
#
# Please contact the author before doing substantial work on this
# code; he is trying to coordinate the software projects he initiate
# in order to maximize the return on invested time for all involved.
# (Ie: If you are doing work in order to support free software, you
# don't want to duplicate work other people are doing.  If you are
# doing work in connection with commercial development, you don't want
# to waste time.  Talk to me!)
#
# Contact info:
#  E-mail: perhaps@@yes.no, eivind@@FreeBSD.org
#  Additional contact information is kept up to date on my FreeBSD.org
#  account - finger eivind@@FreeBSD.org for up-to-date info.  Both of these
#  addresses should be available permanently.
#
# License comments:
# Note that clause 4 prevent you from slapping the GPL or similar
# restrictions on this code.  (Slapping the GPL this code would have
# made it non-restributable anyway; but from experience, I don't
# expect most people to # do detailed analyzis of license
# interactions.)
#
# The intention of clause 5 and 6 is to allow me to handle patches
# safely without a lot of paperwork, while keeping my option of fixing
# it if I find better ways of making the license improve activity on the
# free version of this code.
#

use strict;

package CVSFile;

use Carp;

use vars qw(@@EXPORT);

sub TOK_EMPTYLINE { return 1 }
sub TOK_KEYWORD   { return 2 }
sub TOK_NUM       { return 3 }
sub TOK_SEMICOLON { return 4 }
sub TOK_SYMBOL    { return 5 }
sub TOK_STRING    { return 6 }
sub TOK_ID        { return 7 }

@@EXPORT = qw(TOK_EMPTYLINE TOK_KEYWORD TOK_NUM TOK_SEMICOLON);

#
# For use in 'sort' internally; sorts by recursion depth, then numerically,
# oldest first.
#
# Note: This do NOT work cross-module - I have no idea why, but it
# doesn't.   Seems like a perl bug.
sub _revision_cmp() {
    my @@a = split(/\./, $a);
    my @@b = split(/\./, $b);
    my ($a1, $b1);
    if (@@a != @@b) {
	return @@a <=> @@b;
    }
    while ($a1 = shift @@a) {
	$b1 = shift @@b;
	if ($a1 != $b1) {
	    return $a1 <=> $b1;
	}
    }
    return 0;
}

#
# Escape a string in memory to the format RCS expects
#
sub _stringize($) {
    my $str = shift;
    $str =~ s/@@/@@@@/g;
    return $str;
}

#
# Read in an RCS/CVS file from disk, creating an in-memory object from it
#
sub new($$) {
    my $class = shift;		# The class to bless this into
    my $filename = shift;	# The file to read

    my $self = {};		# The CVS file definition
    my $reader;			# The CVSFile::Reader used for this file
    my ($token, $text);

    bless $self, $class;

    $reader = CVSFile::Reader->ReadFile($filename);

    ($token, $text) = $reader->GetToken();
    die "admin:Bad format (bad head)\n" if $token != TOK_KEYWORD;
    die "admin:Bad format (missing head)\n" if $text ne "head";
    ($token, $text) = $reader->GetToken();
    die "admin:Bad format (bad head 2)\n" if $token != TOK_NUM;
    $self->{head} = $text;
    ($token, $text) = $reader->GetToken();
    die "admin:Bad format (bad post-head 1)\n" if $token != TOK_SEMICOLON;
    ($token, $text) = $reader->GetToken();
    die "admin:Bad format (bad post-head 2)\n" if $token != TOK_KEYWORD;
    if ($text eq "branch") {
	($token, $text) = $reader->GetToken();
	die "admin:Bad format (bad branch)\n" if $token != TOK_NUM;
	$self->{branch} = $text;
	($token, $text) = $reader->GetToken();
	die "admin:Bad format (bad post-branch 1)\n"
	    if $token != TOK_SEMICOLON;
	($token, $text) = $reader->GetToken();
	die "admin:Bad format (bad post-branch 2)\n" if $token != TOK_KEYWORD;
    }
    die "admin:Bad format (missing access)\n" if $text ne "access";
    $self->{access} = [];
    ($token, $text) = $reader->GetToken();
    while ($token != TOK_SEMICOLON) {
	push(@@{$self->{access}}, $text);
	($token, $text) = $reader->GetToken();
    }
    ($token, $text) = $reader->GetToken();
    die "admin:Bad format (bad post-access 1)\n" if $token != TOK_KEYWORD;
    die "admin:Bad format (missing symbols)\n" if $text ne "symbols";

    # XXX We probably want another symbol format, too
    $self->{symbols} = {};
    $self->{_SymbolsOrder} = [];
    ($token, $text) = $reader->GetToken();
    while ($token == TOK_SYMBOL) {
	my $name = $text;
	($token, $text) = $reader->GetToken();
	die "admin:Bad format (malformed number in symbol)\n"
	    if $token != TOK_NUM;
	$self->{symbols}->{$name} = $text;
	push(@@{$self->{_SymbolsOrder}}, $name);
	($token, $text) = $reader->GetToken();
    }
    die "admin:Bad format (bad symbol list - $token:\"$text\")\n" if $token != TOK_SEMICOLON;
    ($token, $text) = $reader->GetToken();
    die "admin:Bad format (bad post-symbol 1)\n" if $token != TOK_KEYWORD;
    die "admin:Bad format (missing locks)\n" if $text ne "locks";

    $self->{locks} = {};
    ($token, $text) = $reader->GetToken();
    while ($token == TOK_SYMBOL) {
	my $name = $text;
	($token, $text) = $reader->GetToken();
	die "admin:Bad format (malformed number in lock)\n"
	    if $token != TOK_NUM;
	$self->{locks}->{$name} = $text;
	($token, $text) = $reader->GetToken();
    }
    die "admin:Bad format (bad locks list)\n" if $token != TOK_SEMICOLON;
    ($token, $text) = $reader->GetToken();
    die "admin:Bad format (bad post-locks 1)\n" if $token != TOK_KEYWORD;
    if ($text eq "strict") {
	$self->{strict} = 1;
	($token, $text) = $reader->GetToken();
	die "admin:Bad format (bad strict keyword)\n" if $token != TOK_SEMICOLON;
	($token, $text) = $reader->GetToken();
    } else {
	$self->{strict} = 0;
    }
    if ($token == TOK_KEYWORD && $text eq "comment") {
	($token, $text) = $reader->GetToken();
	die "admin:Bad format (bad comment keyword)\n" if $token != TOK_STRING;
	$self->{comment} = $text;
	($token, $text) = $reader->GetToken();
	die "admin:Bad format (bad comment term)\n" if $token != TOK_SEMICOLON;
	($token, $text) = $reader->GetToken();
    } else {
	$self->{comment} = undef;
    }
    if ($token == TOK_KEYWORD && $text eq "expand") {
	($token, $text) = $reader->GetToken();
	die "admin:Bad format (bad expand keyword)\n" if $token != TOK_STRING;
	$self->{expand} = $text;
	($token, $text) = $reader->GetToken();
	die "admin:Bad format (bad expand term)\n" if $token != TOK_SEMICOLON;
	($token, $text) = $reader->GetToken();
    } else {
	$self->{expand} = undef;
    }
    die "admin:Missing termination\n" if $token != TOK_EMPTYLINE;
    while ($token == TOK_EMPTYLINE) {
	($token, $text) = $reader->GetToken();
    }
    $self->{deltas} = {};
    $self->{_DeltaOrder} = [];
    die "admin:Bad format\n" if $token != TOK_NUM;
    for (;;) {
	my $deltanum = $text;
	my $delta;

	push(@@{$self->{_DeltaOrder}}, $deltanum);
	$self->{deltas}->{$deltanum} = {};
	$delta = $self->{deltas}->{$deltanum};
	($token, $text) = $reader->GetToken();
	# date
	die "deltas:Bad date 1\n" if $token != TOK_KEYWORD;
	die "deltas:Missing date\n" if $text ne "date";
	($token, $text) = $reader->GetToken();
	die "deltas:Bad date 2\n" if $token != TOK_NUM;
	$delta->{date} = $text;
	($token, $text) = $reader->GetToken();
	die "deltas:Bad date 3\n" if $token != TOK_SEMICOLON;
	# author
	($token, $text) = $reader->GetToken();
	die "deltas:Bad author 1\n" if $token != TOK_KEYWORD;
	die "deltas:Missing author\n" if $text ne "author";
	($token, $text) = $reader->GetToken(TOK_ID);
	die "deltas:Bad author 2\n" if $token != TOK_ID;
	$delta->{author} = $text;
	($token, $text) = $reader->GetToken();
	die "deltas:Bad author 3\n" if $token != TOK_SEMICOLON;
	# state
	($token, $text) = $reader->GetToken();
	die "deltas:Bad state 1\n" if $token != TOK_KEYWORD;
	die "deltas:Missing state\n" if $text ne "state";
	($token, $text) = $reader->GetToken();
	die "deltas:Bad state 2 ($token)\n" if $token != TOK_KEYWORD;
	$delta->{state} = $text;
	($token, $text) = $reader->GetToken();
	die "deltas:Bad state 3\n" if $token != TOK_SEMICOLON;
	# branches
	($token, $text) = $reader->GetToken();
	die "deltas:Bad branches 1\n" if $token != TOK_KEYWORD;
	die "deltas:Missing branches\n" if $text ne "branches";
	$delta->{branches} = [];
	($token, $text) = $reader->GetToken();
	while ($token != TOK_SEMICOLON) {
	    push(@@{$delta->{branches}}, $text);
	    ($token, $text) = $reader->GetToken();
	}
	# next
	($token, $text) = $reader->GetToken();
	die "deltas:Bad next 1\n" if $token != TOK_KEYWORD;
	die "deltas:Missing next\n" if $text ne "next";
	($token, $text) = $reader->GetToken();
	if ($token == TOK_NUM) {
	    $delta->{next} = $text;
	    ($token, $text) = $reader->GetToken();
	} else {
	    $delta->{next} = undef;
	}
	die "deltas:Bad next 3\n" if $token != TOK_SEMICOLON;

	($token, $text) = $reader->GetToken();
	die "deltas:Bad format (missing empty line)\n"
	    if $token != TOK_EMPTYLINE;
	($token, $text) = $reader->GetToken();
	if ($token == TOK_EMPTYLINE) {
	    last;
	}
    }
    # OK, so we got the delta headers - now read the description
    while ($token == TOK_EMPTYLINE) {
	($token, $text) = $reader->GetToken();
    }
    die "desc:Bad format 1\n" if $token != TOK_KEYWORD;
    die "desc:Bad format 2\n" if $text  ne "desc";
    ($token, $text) = $reader->GetToken();
    die "desc:Bad format 3\n" if $token != TOK_STRING;
    $self->{desc} = $text;
    ($token, $text) = $reader->GetToken();
    die "desc:Bad format 4\n" if $token != TOK_EMPTYLINE;
    ($token, $text) = $reader->GetToken();
    die "desc:Bad format 5\n" if $token != TOK_EMPTYLINE;

    my $deltanum;		# A delta number from the file
    my %unreceieveddeltas;
    foreach $deltanum (keys %{$self->{deltas}}) {
	$unreceieveddeltas{$deltanum} = 1;
    }
    $self->{_DeltatextOrder} = [];
    eval {
	for (;;) {
	    do {
		($token, $text) = $reader->GetToken();
	    } while ($token == TOK_EMPTYLINE);
	    die "deltatext:Bad format 1: $token\n" if $token != TOK_NUM;
	    die "deltatext:Messup ($text not expected)\n"
		if !exists($unreceieveddeltas{$text});
	    delete $unreceieveddeltas{$text};
	    $deltanum = $text;
	    push(@@{$self->{_DeltaTextOrder}}, $deltanum);
	    ($token, $text) = $reader->GetToken();
	    die "deltatext:Bad format 2\n" if $token != TOK_KEYWORD;
	    die "deltatext:Missing 'log'\n" if $text ne "log";
	    ($token, $text) = $reader->GetToken();
	    die "deltatext:Bad format 3\n" if $token != TOK_STRING;
	    $self->{deltas}->{$deltanum}->{log} = $text;
	    ($token, $text) = $reader->GetToken();
	    die "deltatext:$deltanum:Bad format 4 ($token)\n"
		if $token != TOK_KEYWORD;
	    die "deltatext:Missing 'text'\n" if $text ne "text";
	    ($token, $text) = $reader->GetToken();
	    die "deltatext:Bad format 5\n" if $token != TOK_STRING;
	    $self->{deltas}->{$deltanum}->{text} = $text;
	    ($token, $text) = $reader->GetToken();
	    die "deltatext:Bad format 6\n" if $token != TOK_EMPTYLINE;
	    ($token, $text) = $reader->GetToken();
	    die "deltatext:Bad format 7\n" if $token != TOK_EMPTYLINE;
	}
    };
    if ($@@ && $@@ !~ /^eof:/) {
	die "$@@\n";
    }
    #
    # Read the entire file - now check that the data is sane
    #

    # Was there any data we didn't get?
    if (keys %unreceieveddeltas) {
	die "rcsfile: Missing deltas " .
	    join(',', keys %unreceieveddeltas) . "\n";
    }

    # OK; we're ready to play!
    return $self;
}

#
# Format of self (similar to the rcsfile(5) format):
#
# {expand}          => string (can be undef)
# {access}          => []
# {comment}         => string
# {head}            => version
# {symbols}         => { symbol => version }
# {_SymbolsOrder}   => [ symbol, ... ]
# {strict}          => number
# {locks}           => { id => version }
# {desc}            => string
# {_DeltaOrder}     => [ revision, ... ]
# {_DeltaTextOrder} => [ revision, ... ]
# {deltas}          => {
#                         version => {
#                            {state}  => string
#                            {log}    => string
#                            {author} => string
#                            {date}   => string
#                            {next}   => version
#                         }
#                      }
#
# As far as I can tell, {next} are pure mumbo-jumbo - the revisions
# can only be interpreted one way.  Weird stuff.
#

#
# Get the checked in data for a particular version
#
sub GetVersion($$) {
    my $self = shift;		# CVSfile to fetch from
    my $version = shift;	# Version to look for

    my $lookat;			# The version we are presently looking at
				# while trying to reconstruct the target
    my @@reconstruct;		# The version we have so far reconstructed,
				# split into lines.
    my $addaccum;
    my $delaccum;

    #
    # The head is simple and often requested, so do a special case for it
    #
    if ($self->{'head'} eq $version) {
	return $self->{deltas}->{$version}->{text};
    }

    $lookat = $self->{head};
    @@reconstruct = ();
    while ($self->{deltas}->{$lookat}->{text} =~ /([^\n]*\n?)/g) {
	push(@@reconstruct, $1);
    }
    for (;;) {
	if ($lookat eq $version) {
	    return join('', @@reconstruct);
	}
	if ($version =~ /^$lookat\./) {
	    # We got what is supposed to be the parent of this revision.
	    # Now, let us see if we can find a way towards our wanted
	    # revision.
	    my @@version = split(/\./, $version);
	    my @@lookat  = split(/\./, $lookat);
	    $lookat = join('.', splice(@@version, 0, @@lookat + 1)) . ".1";
	} else {
	    die "badversion:Cannot find any parent for $lookat\n"
		if !exists($self->{deltas}->{$lookat}->{'next'});
	    $lookat = $self->{deltas}->{$lookat}->{'next'};
	}
	#
	# We have got a delta to apply
	#
	my @@delta;
	my $deltaline;
	$addaccum = 0;
	$delaccum = 0;
	@@delta = ();
	while ($self->{deltas}->{$lookat}->{text} =~ /([^\n]*\n?)/g) {
	    push(@@delta, $1);
	}
	while ($deltaline = shift @@delta) {
	    chomp $deltaline;
	    if ($deltaline =~ /^d(\d+) (\d+)$/) {
		# Delete lines
		splice(@@reconstruct, $1 + $addaccum - $delaccum - 1, $2);
		$delaccum += $2;
	    } elsif ($deltaline =~ /^a(\d+) (\d+)$/) {
		# Add lines
		splice(@@reconstruct, $1 - $delaccum + $addaccum, 0,
		       splice(@@delta, 0, $2));
		$addaccum += $2;
	    } else {
		die "Looks like a malformed delta for $lookat, dude: \"$deltaline\"\n";
	    }
	}
    }
}

#
# Get an array of revisions in a particular branch (head branch is the
# default)
#
sub GetRevisions($;$) {
    my $self = shift;
    my $baseversion = shift || "1";

    my @@revisions;		# List of revisions in branch

    # Normalize
    $baseversion =~ s/\.$//;

    # Preconditions
    if (!exists($self->{_Branches})) {
	$self->_build_branch_cache();
    }
    if (!exists($self->{_Branches}->{$baseversion})) {
	confess "getrevisions:No such branch $baseversion";
    }

    # Set up to be used as a match regexp in a moment
    $baseversion .= ".";
    $baseversion =~ s|\.|\\.|g;

    foreach (sort _revision_cmp keys %{$self->{deltas}}) {
	if (/^${baseversion}\d+$/) {
	    push(@@revisions, $_);
	}
    }
    return @@revisions;
}

#
# Get a list of the branches available
#
sub GetBranches($;$) {
    my $self = shift;		   # CVSFile to get them from
    my $baseversion = shift || ""; # Which basic revision they should be
				   # childs of (if any)

    my @@branches;

    if ($baseversion ne "" && $baseversion !~ /\.$/) {
	$baseversion .= ".";
    }
    $baseversion =~ s|\.|\\.|g;

    if (!exists($self->{_Branches})) {
	$self->_build_branch_cache();
    }

    #
    # Weed out the branches we want
    #
    foreach (sort _revision_cmp keys %{$self->{_Branches}}) {
	if (/^$baseversion/) {
	    push(@@branches, $_);
	}
    }
    return @@branches;
}

#
# Build the branch cache (information about which branches exists, and
# what the maximum revision in each of them are.  Includes the '1'
# branch.)
#
sub _build_branch_cache($) {
    my $self = shift;

    my $version;
    my $revision;
    
    $self->{_Branches} = {};
    foreach $version (keys %{$self->{deltas}}) {
	$version =~ s/\.(\d+)$//;
	$revision = $1;
	if (!exists($self->{_Branches}->{$version})) {
	    $self->{_Branches}->{$version} = { MaxRev => $revision };
	} else {
	    $self->{_Branches}->{$version}->{MaxRev} =
		$self->{_Branches}->{$version}->{MaxRev} >= $revision ?
		    $self->{_Branches}->{$version}->{MaxRev} : $revision;
	}
    }
}

#
# Verify that the object is in a consistent state; die otherwise.
#
# XXX This do not yet do full verification; only a small subset of
# invariants are checked for.
#
sub Invariant($) {
    my $self = shift;

    my $deltanum;
    my %tmp;

    # Verify {deltas} vs {_DeltaOrder}
    foreach $deltanum (keys %{$self->{deltas}}) {
	$tmp{$deltanum} = 1;
    }
    foreach $deltanum ($self->{_DeltaOrder}) {
	die "invariant:Missing delta $deltanum (from _DeltaOrder)\n"
	    if !exists($tmp{$deltanum});
	delete $tmp{$deltanum};
    }
    if (keys %tmp) {
	die "invariant:Missing delta(s) in _DeltaOrder: " .
	    join(', ', sort _revision_cmp keys %tmp) . "\n";
    }

    # Verify {deltas} vs {_DeltaTextOrder}
    foreach $deltanum (keys %{$self->{deltas}}) {
	$tmp{$deltanum} = 1;
    }
    foreach $deltanum ($self->{_DeltaTextOrder}) {
	die "invariant:Missing delta $deltanum (from _DeltaTextOrder)\n"
	    if !exists($tmp{$deltanum});
	delete $tmp{$deltanum};
    }
    if (keys %tmp) {
	die "invariant:Missing delta(s) in _DeltaTextOrder: " .
	    join(', ', sort _revision_cmp keys %tmp) . "\n";
    }

    # Verify {symbols} vs {_SymbolOrder}
    foreach $deltanum (keys %{$self->{symbols}}) {
	$tmp{$deltanum} = 1;
    }
    foreach $deltanum ($self->{_SymbolOrder}) {
	die "invariant:Missing delta $deltanum (from _SymbolOrder)\n"
	    if !exists($tmp{$deltanum});
	delete $tmp{$deltanum};
    }
    if (keys %tmp) {
	die "invariant:Missing delta(s) in _SymbolOrder: " .
	    join(', ', sort _revision_cmp keys %tmp) . "\n";
    }
}

#
# Write out the present CVSFile to a filehandle
#
sub Write($$) {
    my $self = shift;
    my $file = shift;

    my $deltanum;		# The numeric ID of a delta we are examining

    #
    # admin section (ref rcsfile(5))
    #
    print $file "head\t$self->{head};\n";
    if (defined($self->{branch})) {
	print $file "branch\t$self->{branch};\n";
    }
    print $file "access";
    if ($self->{access}) {
	foreach (@@{$self->{access}}) {
	    print $file " $_";
	}
    }
    print $file ";\nsymbols";
    if (@@{$self->{_SymbolsOrder}} > 0) {
	foreach (@@{$self->{_SymbolsOrder}}) {
	    print $file "\n\t$_:$self->{symbols}->{$_}";
	}
    }
    print $file ";\nlocks";
    if (keys %{$self->{locks}}) {
	foreach (keys %{$self->{locks}}) {
	    print $file "\n\t$_:$self->{locks}->{$_}";
	}
    }
    if ($self->{strict}) {
	print $file "; strict";
    }
    print $file ";\n";
    if (defined($self->{comment})) {
	print $file "comment\t@@" . _stringize($self->{comment}) . "@@;\n";
    }
    if (defined($self->{expand})) {
	print $file "expand\t@@" . _stringize($self->{expand}) . "@@;\n";
    }
    print $file "\n";

    #
    # delta section
    #
    foreach $deltanum (@@{$self->{_DeltaOrder}}) {
	my $delta = $self->{deltas}->{$deltanum};
	print $file "\n$deltanum\ndate\t$delta->{date};\tauthor $delta->{author};\tstate";
	if (defined($delta->{state})) {
	    print $file " $delta->{state}";
	}
	print $file ";\nbranches";
	foreach (@@{$delta->{branches}}) {
	    print $file "\n\t$_";
	}
	print $file ";\nnext\t";
	if ($delta->{'next'}) {
	    print $file $delta->{next};
	}
	print $file ";\n";
    }

    print $file "\n\ndesc\n@@" . _stringize($self->{desc}) . "@@\n";

    #
    # deltatext section
    #
    foreach $deltanum (@@{$self->{_DeltaTextOrder}}) {
	my $delta = $self->{deltas}->{$deltanum};
	print $file "\n\n$deltanum\nlog\n@@" . _stringize($delta->{log}) .
	    "@@\ntext\n@@" . _stringize($delta->{text}) . "@@\n";
    }
    return 1;
}


package CVSFile::Reader;

#use CVSFile;
sub TOK_EMPTYLINE { return 1 }
sub TOK_KEYWORD   { return 2 }
sub TOK_NUM       { return 3 }
sub TOK_SEMICOLON { return 4 }
sub TOK_SYMBOL    { return 5 }
sub TOK_STRING    { return 6 }
sub TOK_ID        { return 7 }

sub ReadFile($$) {
    my $class = shift;
    my $filename = shift;

    local *INFILE;
    my $self = {
	'Infile' => undef,	# File we are reading from
    };

    open(INFILE, "<$filename")
	or die "readerror:Unable to open $filename for read\n";
    $self->{Infile} = *INFILE;
    bless $self, $class;
}

sub GetToken($;$) {
    my $self = shift;
    my $preferred = shift;	# Preferred token type
    my $infile = $self->{'Infile'};

    if (!defined($preferred)) {
	$preferred = -1;
    }

    if (!$self->{CachedLine}) {
	defined($self->{CachedLine} = <$infile>)
	    or die "eof:No more data in file\n";
	chomp $self->{CachedLine};
	$self->{CachedLine} =~ s/^\s*//;
	if ($self->{CachedLine} eq '') {
	    return (TOK_EMPTYLINE, '');
	}
    }
    if ($self->{CachedLine} =~ s/^([0-9.]+)\s*//) {
	return (TOK_NUM, $1);
    } elsif ($self->{CachedLine} =~ s/^@@//) {
	my $outstring = "";
	# OK; @@-delimited string coming up
	$self->{CachedLine} = "$self->{CachedLine}\n";
	for (;;) {
	    while ($self->{CachedLine} =~ s/^([^@@]*)@@@@//) {
		$outstring .= "$1@@";
	    }
	    if ($self->{CachedLine} =~ s/^([^@@]*)@@\s*//) {
		$outstring .= $1;
		chomp $self->{CachedLine};
		return (TOK_STRING, $outstring);
	    }
	    $outstring .= $self->{CachedLine};
	    defined($self->{CachedLine} = <$infile>)
		or die "readerror:No more data in file\n";
	}
    } elsif ($self->{CachedLine} =~ s/^([a-z_][a-z0-9_+\-]*)\s*:\s*//i) {
	return (TOK_SYMBOL, $1);
    } elsif ($self->{CachedLine} =~ s/^([a-z_][a-z_0-9]*)\s*//i) {
	my $tmp = $1;
	if ($preferred != TOK_ID) {
	    if ($tmp =~ /^[a-z]+$/i) {
		return (TOK_KEYWORD, $tmp);
	    }
	}
	return (TOK_ID, $1);
    } elsif ($self->{CachedLine} =~ s/^;\s*//) {
	return (TOK_SEMICOLON, ';');
    } else {
	die "bailout:Non-understandable data in file: \"$self->{CachedLine}\"\n";
    }
}

package main;

#use Data::Dumper;

MAIN: {
    my $filename = $ARGV[0] || "/home/ncvs/src/Makefile,v";
    my $cvsfile = CVSFile->new($filename);
    #print $cvsfile->GetVersion("1.109.2.25");
    #print "Branches: " . join(', ', $cvsfile->GetBranches()) . "\n";
    #print "Revisions: " . join(', ', $cvsfile->GetRevisions()) . "\n";
    open(TESTFILE, ">testfile,v")
	or die "Unable to open testfile,v\n";
    $cvsfile->Write(*TESTFILE);
    #my $cvsfile = CVSFile->new("RCS/testfile-2,v");
    #print $cvsfile->GetVersion("1.2");
    #print Dumper($cvsfile);
    exit(0);
}

1;
@


1.15
log
@Die {admin}, die!
Significantly speed up parser.
Get rid of problem when a string started with @@
@
text
@d49 1
a49 1
# $Id: CVSFile.pm,v 1.14 2000/03/19 16:54:53 eivind Exp eivind $
d737 1
a737 1
    if ($self->{CachedLine} =~ s/^([0-9.]+)\s*/) {
d756 1
a756 1
    } elsif ($self->{CachedLine} =~ s/^([a-z_][a-z0-9_+\-]*)\s*:\s*/i) {
d766 1
a766 1
    } elsif ($self->{CachedLine} =~ s/^;\s*/) {
@


1.14
log
@Allow '-' in symbol (tag) names.
@
text
@d49 1
a49 1
# $Id: CVSFile.pm,v 1.13 2000/03/19 16:48:07 eivind Exp eivind $
a141 1
    $self->{admin} = {};
d155 1
a155 1
	$self->{admin}->{branch} = $text;
d342 2
a343 1
	    die "deltatext:Bad format 4\n" if $token != TOK_KEYWORD;
d737 1
a737 2
    if ($self->{CachedLine} =~ /^([0-9.]+)\s*(.*)/) {
	$self->{CachedLine} = $2;
a741 4
	if ($self->{CachedLine} =~ s/^@@//) {
	    # Empty string
	    return (TOK_STRING, $outstring);
	}
d756 1
a756 2
    } elsif ($self->{CachedLine} =~ /^([a-z_][a-z0-9_-]*)\s*:\s*(.*)/i) {
	$self->{CachedLine} = $2;
d766 2
a767 3
    } elsif ($self->{CachedLine} =~ /^(;)\s*(.*)/) {
	$self->{CachedLine} = $2;
	return (TOK_SEMICOLON, $1);
@


1.13
log
@Correct parsing of author ids with '_' and/or numbers in them.
@
text
@d49 1
a49 1
# $Id: CVSFile.pm,v 1.12 2000/03/19 16:28:05 eivind Exp eivind $
d187 1
a187 1
    die "admin:Bad format (bad symbol list)\n" if $token != TOK_SEMICOLON;
d761 1
a761 1
    } elsif ($self->{CachedLine} =~ /^([a-z_][a-z0-9_]*)\s*:\s*(.*)/i) {
@


1.12
log
@License fixups; change from a BSD style to an OVCS style license.
@
text
@d49 1
a49 1
# $Id: CVSFile.pm,v 1.11 2000/03/19 15:58:41 eivind Exp eivind $
d92 1
d260 2
a261 2
	($token, $text) = $reader->GetToken();
	die "deltas:Bad author 2\n" if $token != TOK_KEYWORD;
d270 1
a270 1
	die "deltas:Bad state 2\n" if $token != TOK_KEYWORD;
d327 3
a329 1
	    ($token, $text) = $reader->GetToken();
d702 1
d719 1
a719 1
sub GetToken($) {
d721 1
d724 4
d764 8
a771 3
    } elsif ($self->{CachedLine} =~ /^([a-z]+)\s*(.*)/i) {
	$self->{CachedLine} = $2;
	return (TOK_KEYWORD, $1);
d785 2
a786 1
    my $cvsfile = CVSFile->new("/home/ncvs/src/Makefile,v");
d796 1
@


1.11
log
@Support writing RCS files.
@
text
@d3 1
a3 2
# Copyright (C) 2000
# Copyright (c) 1989, 1993
d17 19
d49 1
a49 1
# $Id: CVSFile.pm,v 1.10 2000/03/18 13:50:46 eivind Exp eivind $
d64 13
@


1.10
log
@Add revision/branch access methods
.,
@
text
@d31 1
a31 1
# $Id: CVSFile.pm,v 1.9 2000/03/18 12:11:03 eivind Exp eivind $
d65 2
a66 1
# For use in 'sort' internally.
d70 1
a70 1
sub _revision_cmp {
d87 9
d144 1
d152 1
d206 1
d212 1
d281 1
d292 1
d301 1
d340 20
a359 15
# {expand}  => string (can be undef)
# {access}  => []
# {comment} => string
# {head}    => version
# {symbols} => { symbol => version }
# {strict}  => number
# {locks}   => { id => version }
# {deltas}  => {
#                version => {
#                   {state}  => string
#                   {log}    => string
#                   {author} => string
#                   {date}   => string
#                   {next}   => version
#                }
d524 135
d742 5
a746 2
    print "Branches: " . join(', ', $cvsfile->GetBranches()) . "\n";
    print "Revisions: " . join(', ', $cvsfile->GetRevisions()) . "\n";
@


1.9
log
@Update copyright/license.
@
text
@d31 1
a31 1
# $Id: CVSFile.pm,v 1.8 2000/03/18 11:58:33 eivind Exp eivind $
d51 2
d64 24
d414 20
d435 3
d439 62
d584 3
a586 1
    print $cvsfile->GetVersion("1.109.2.25");
@


1.8
log
@Version fetching 100% working, including missing newline at EOF.
Also did a small bit of cleanup.
@
text
@d3 3
a5 2
# Copyright (C) 2000, Eivind Eklund.  All Rights Reserved.
# No copying, no license, no anything.  My private use only.
d7 11
a17 1
# $Id: CVSFile.pm,v 1.7 2000/03/18 10:49:20 eivind Exp eivind $
d19 27
@


1.7
log
@Now correctly parses testfile-2 and a complicated version of
src/Makefile,v in FreeBSD.
@
text
@d6 1
a6 1
# $Id: CVSFile.pm,v 1.6 2000/03/18 10:37:02 eivind Exp eivind $
d186 1
a186 1
	
d207 1
a207 3
    #($token, $text) = $reader->GetToken();
    #die "desc:Bad format 6\n" if $token != TOK_EMPTYLINE;
    
d258 1
a258 1
# 
d292 1
a292 1
    
d301 4
a304 1
    @@reconstruct = split(/\n/, $self->{deltas}->{$lookat}->{text});
d307 1
a307 1
	    return join("\n", @@reconstruct) . "\n";
d324 1
a324 1
	my @@delta = split(/\n/, $self->{deltas}->{$lookat}->{text});
d328 4
d333 1
a336 1
	#print "[$1:$addaccum:$delaccum] Deleting $2 at " . ($1 + $addaccum - $delaccum - 1) . "\n";
a341 1
	#print "[$1:$addaccum:$delaccum] Adding $2 at " . ($1 - $delaccum + $addaccum) . "\n";
a346 1
			  
d431 1
a431 1
use Data::Dumper;
d438 1
a438 1
#    print Dumper($cvsfile);
d440 2
@


1.6
log
@Closer to correct logic - manages testfile-1,v correctly.
@
text
@d6 1
a6 1
# $Id: CVSFile.pm,v 1.5 2000/03/17 17:35:17 eivind Exp eivind $
d292 2
d325 2
a326 2
	my $addaccum = 0;
	my $delaccum = 0;
d331 1
d335 1
a335 1
		splice(@@reconstruct, $1 - $delaccum, 0,
d337 1
d433 2
a434 2
    #my $cvsfile = CVSFile->new("RCS/testfile-1,v");
    #print $cvsfile->GetVersion("1.1");
@


1.5
log
@Not yet quite functional code to interpret deltas.
@
text
@d6 1
a6 1
# $Id$
d328 1
a328 1
		splice(@@reconstruct, $1 - 1, $2);
d332 1
a332 1
		splice(@@reconstruct, $1 - 1, 0,
d427 4
a430 4
#    my $cvsfile = CVSFile->new("/home/ncvs/src/Makefile,v");
    my $cvsfile = CVSFile->new("RCS/CVSFile.pm,v");
    #print $cvsfile->GetVersion("1.109.2.25");
    print $cvsfile->GetVersion("1.2");
@


1.4
log
@Kill the 'admin' subdivision for 'head'
Kill 'deltaorder'
Add object structure documentation
Add a 'GetVersion' method (presently only works for the head, but
  will correctly traverse the versions to look for something else.)
@
text
@d6 2
d304 1
a304 1
	    return join("\n", @@reconstruct);
d321 19
a339 1
	# XXX
d427 4
a430 2
    my $cvsfile = CVSFile->new("/home/ncvs/src/Makefile,v");
    $cvsfile->GetVersion("1.109.2.25");
@


1.3
log
@Seemingly correct CVS file parser.
@
text
@d40 1
a40 1
    $self->{admin}->{head} = $text;
a127 1
    $self->{deltaorder} = [];
a132 1
	push(@@{$self->{deltaorder}}, $deltanum);
d210 1
a210 1
    foreach $deltanum (@@{$self->{deltaorder}}) {
d256 70
d404 1
a404 1
#use Data::Dumper;
d408 1
@


1.2
log
@More goo.
@
text
@d22 3
a24 2
sub _read_admin($$) {
    my $self = shift;
d26 2
d30 4
d35 1
a35 1
    ($token, $text) = $self->{Reader}->GetToken();
d38 1
a38 1
    ($token, $text) = $self->{Reader}->GetToken();
d41 1
a41 1
    ($token, $text) = $self->{Reader}->GetToken();
d43 1
a43 1
    ($token, $text) = $self->{Reader}->GetToken();
d46 1
a46 1
	($token, $text) = $self->{Reader}->GetToken();
d49 1
a49 1
	($token, $text) = $self->{Reader}->GetToken();
d52 1
a52 1
	($token, $text) = $self->{Reader}->GetToken();
d57 1
a57 1
    ($token, $text) = $self->{Reader}->GetToken();
d60 1
a60 1
	($token, $text) = $self->{Reader}->GetToken();
d62 1
a62 1
    ($token, $text) = $self->{Reader}->GetToken();
d68 1
a68 1
    ($token, $text) = $self->{Reader}->GetToken();
d71 1
a71 1
	($token, $text) = $self->{Reader}->GetToken();
d75 1
a75 1
	($token, $text) = $self->{Reader}->GetToken();
d78 1
a78 1
    ($token, $text) = $self->{Reader}->GetToken();
d83 1
a83 1
    ($token, $text) = $self->{Reader}->GetToken();
d86 1
a86 1
	($token, $text) = $self->{Reader}->GetToken();
d90 1
a90 1
	($token, $text) = $self->{Reader}->GetToken();
d93 1
a93 1
    ($token, $text) = $self->{Reader}->GetToken();
d97 1
a97 1
	($token, $text) = $self->{Reader}->GetToken();
d99 1
a99 1
	($token, $text) = $self->{Reader}->GetToken();
d104 1
a104 1
	($token, $text) = $self->{Reader}->GetToken();
d107 1
a107 1
	($token, $text) = $self->{Reader}->GetToken();
d109 1
a109 1
	($token, $text) = $self->{Reader}->GetToken();
d114 1
a114 1
	($token, $text) = $self->{Reader}->GetToken();
d117 1
a117 1
	($token, $text) = $self->{Reader}->GetToken();
d119 1
a119 1
	($token, $text) = $self->{Reader}->GetToken();
d125 1
a125 1
	($token, $text) = $self->{Reader}->GetToken();
d128 1
d133 2
d137 1
a137 1
	($token, $text) = $self->{Reader}->GetToken();
d141 1
a141 1
	($token, $text) = $self->{Reader}->GetToken();
d144 1
a144 1
	($token, $text) = $self->{Reader}->GetToken();
d147 1
a147 1
	($token, $text) = $self->{Reader}->GetToken();
d150 1
a150 1
	($token, $text) = $self->{Reader}->GetToken();
d153 1
a153 1
	($token, $text) = $self->{Reader}->GetToken();
d156 1
a156 1
	($token, $text) = $self->{Reader}->GetToken();
d159 1
a159 1
	($token, $text) = $self->{Reader}->GetToken();
d162 1
a162 1
	($token, $text) = $self->{Reader}->GetToken();
d165 1
a165 1
	($token, $text) = $self->{Reader}->GetToken();
d169 1
a169 1
	($token, $text) = $self->{Reader}->GetToken();
d172 1
a172 1
	    ($token, $text) = $self->{Reader}->GetToken();
d175 1
a175 1
	($token, $text) = $self->{Reader}->GetToken();
d178 7
a184 4
	($token, $text) = $self->{Reader}->GetToken();
	die "deltas:Bad next 2\n" if $token != TOK_KEYWORD;
	$delta->{next} = $text;
	($token, $text) = $self->{Reader}->GetToken();
d187 11
a197 3
	
	
	
d199 10
d210 37
d248 5
a252 15
    
    # XXX
}


sub new($$) {
    my $class = shift;		# The class to bless this into
    my $filename = shift;	# The file to read

    my $self = {};		# The CVS file definition

    bless $self, $class;

    $self->{Reader} = CVSFile::Reader->ReadFile($filename);
    $self->_read_admin();
d254 1
d289 2
a290 1
	    or die "readerror:No more data in file\n";
d311 1
a311 1
	    if ($self->{CachedLine} =~ s/^([^@@]*)@@//) {
d323 1
a323 1
    } elsif ($self->{CachedLine} =~ /^([a-z]+)\s*(.*)/) {
d336 2
d340 1
a340 1

@


1.1
log
@Initial revision
@
text
@d117 61
@