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 @