--- RCS.pm 2004/04/23 15:03:27 1.6
+++ RCS.pm 2004/04/23 17:58:17 1.7
@@ -36,7 +36,7 @@
use IO::File;
@ISA = qw(Exporter);
-@EXPORT_OK = qw(new destroy DESTROY dump tool load save parse format);
+@EXPORT_OK = qw(new destroy DESTROY dump tool load save parse format revapply trunk2branch);
# create new object
sub new ($;$) {
@@ -138,6 +138,30 @@
return;
}
+# INTERNAL: structured revision to sequential number mapping
+sub _rev_rev2num ($$) {
+ my ($self, $rev) = @_;
+ foreach my $num (keys(%{$self->{'rcs'}->{'rev'}})) {
+ next if ($num eq '-count');
+ return $num if ($self->{'rcs'}->{'rev'}->{$num} eq $rev);
+ }
+ my $num = sprintf("REV-NUM(%d)", $self->{'rcs'}->{'rev'}->{-count}++);
+ $self->{'rcs'}->{'rev'}->{$num} = $rev;
+ return $num;
+}
+
+# INTERNAL: sequential number to structured revision mapping
+sub _rev_num2rev ($$) {
+ my ($self, $num) = @_;
+ return $self->{'rcs'}->{'rev'}->{$num};
+}
+
+# INTERNAL: check whether argument is a valid sequential number
+sub _rev_isnum ($$) {
+ my ($self, $num) = @_;
+ return (($num =~ m|^REV-NUM\(\d+\)$| and defined($self->{'rcs'}->{'rev'}->{$num})) ? 1 : 0);
+}
+
# parse a RCS file content into object
# (see rcsfile(5) for reference)
sub parse ($$) {
@@ -147,13 +171,14 @@
$self->{'rcs'} = {
'header' => { -order => [] },
'delta' => { -order => [] },
+ 'rev' => { -count => 0 },
};
# pre-generate reusable regular expressions
my $re_num = qr/[\d.]+/;
my $re_rev = qr/\d+(?:\.\d+)*/;
- my $re_special = qr/[$,.:;@]/;
- my $re_idchar = qr/[^$,.:;@]/;
+ my $re_special = qr/[\$,.:;\@]/;
+ my $re_idchar = qr/[^\$,.:;\@]/;
my $re_id = qr/(?:${re_num})?${re_idchar}+(?:${re_idchar}|${re_num})*/;
my $re_sym = qr/\d?${re_idchar}+(?:${re_idchar}|\d)*/;
my $re_str = qr/(?:\@\@|[^@])*/s;
@@ -163,32 +188,37 @@
while (1) {
$rcs =~ s|^\s*||s;
if ($rcs =~ s/^head\s+($re_rev)\s*;//s) {
- $self->{'rcs'}->{'header'}->{'head'} = $1;
+ $self->{'rcs'}->{'header'}->{'head'} = $self->_rev_rev2num($1);
push(@{$self->{'rcs'}->{'header'}->{-order}}, 'head');
}
elsif ($rcs =~ s/^branch\s+($re_rev)\s*;//s) {
- $self->{'rcs'}->{'header'}->{'branch'} = $1;
+ $self->{'rcs'}->{'header'}->{'branch'} = $self->_rev_rev2num($1);
push(@{$self->{'rcs'}->{'header'}->{-order}}, 'branch');
}
elsif ($rcs =~ s/^access((?:\s+$re_id)*)\s*;//s) {
- $self->{'rcs'}->{'header'}->{'access'} = [ split(/\s+/, $1) ];
+ $self->{'rcs'}->{'header'}->{'access'} =
+ (defined($1) ? [ split(/\s+/, $1) ] : []);
push(@{$self->{'rcs'}->{'header'}->{-order}}, 'access');
}
elsif ($rcs =~ s/^symbols((?:\s+$re_sym:$re_rev)*)\s*;//s) {
my $symbols = { -order => [] };
- map { if (m/^(.+):(.+)$/s) {
- $symbols->{$1} = $2;
+ if (defined($1)) {
+ map { if (m/^(.+):(.+)$/s) {
+ $symbols->{$1} = $self->_rev_rev2num($2);
push(@{$symbols->{-order}}, $1);
- } } split(/\s+/, $1);
+ } } split(/\s+/, $1);
+ }
$self->{'rcs'}->{'header'}->{'symbols'} = $symbols;
push(@{$self->{'rcs'}->{'header'}->{-order}}, 'symbols');
}
elsif ($rcs =~ s/^locks((?:\s+$re_id:$re_rev)*)\s*;//s) {
my $locks = { -order => [] };
- map { if (m/^(.+):(.+)$/s) {
- $locks->{$1} = $2;
- push(@{$locks->{-order}}, $1);
- } } split(/\s+/, $1);
+ if (defined($1)) {
+ map { if (m/^(.+):(.+)$/s) {
+ $locks->{$1} = $self->_rev_rev2num($2);
+ push(@{$locks->{-order}}, $1);
+ } } split(/\s+/, $1);
+ }
$self->{'rcs'}->{'header'}->{'locks'} = $locks;
push(@{$self->{'rcs'}->{'header'}->{-order}}, 'locks');
}
@@ -225,7 +255,7 @@
while (1) {
$rcs =~ s|^\s*||s;
if ($rcs =~ s/^($re_rev)//s) {
- my $rev = $1;
+ my $rev = $self->_rev_rev2num($1);
$self->{'rcs'}->{'delta'}->{$rev} = {};
push(@{$self->{'rcs'}->{'delta'}->{-order}}, $rev);
while (1) {
@@ -240,10 +270,12 @@
$self->{'rcs'}->{'delta'}->{$rev}->{'state'} = $1;
}
elsif ($rcs =~ s/^branches(?:\s+((?:\s*$re_rev)*))?\s*;//s) {
- $self->{'rcs'}->{'delta'}->{$rev}->{'branches'} = [ split(/\s+/, $1) ];
+ $self->{'rcs'}->{'delta'}->{$rev}->{'branches'} =
+ (defined($1) and $1 ne '' ? [ map { $self->_rev_rev2num($_) } split(/\s+/, $1) ] : []);
}
elsif ($rcs =~ s/^next(?:\s*($re_rev))?\s*;//s) {
- $self->{'rcs'}->{'delta'}->{$rev}->{'next'} = $1;
+ $self->{'rcs'}->{'delta'}->{$rev}->{'next'} =
+ (defined($1) and $1 ne '' ? $self->_rev_rev2num($1) : '');
}
elsif ($rcs =~ m/^desc\s+/s) {
last;
@@ -276,9 +308,9 @@
while (1) {
$rcs =~ s|^\s*||s;
if ($rcs =~ s/^($re_rev)//s) {
- my $rev = $1;
+ my $rev = $self->_rev_rev2num($1);
if (not defined($self->{'rcs'}->{'delta'}->{$rev})) {
- croak "deltatext section for unknown revision \"$rev\" found";
+ croak "deltatext section for unknown revision \"".$self->_rev_num2rev($rev)."\" found";
}
my $textseen = 0;
while (1) {
@@ -326,22 +358,22 @@
sub _revlist ($$) {
my ($self, $branchfirst) = @_;
my @revs = ();
- &nextrev(\@revs, $self->{'rcs'}->{'header'}->{'head'}, $branchfirst);
- sub nextrev ($$$) {
- my ($revs, $rev, $branchfirst) = @_;
+ &nextrev($self, \@revs, $self->{'rcs'}->{'header'}->{'head'}, $branchfirst);
+ sub nextrev ($$$$) {
+ my ($self, $revs, $rev, $branchfirst) = @_;
push(@{$revs}, $rev);
my $next = $self->{'rcs'}->{'delta'}->{$rev}->{'next'};
my $branches = $self->{'rcs'}->{'delta'}->{$rev}->{'branches'};
if ($branchfirst) {
foreach my $branch (@{$branches}) {
- &nextrev($revs, $branch, $branchfirst);
+ &nextrev($self, $revs, $branch, $branchfirst);
}
- &nextrev($revs, $next, $branchfirst) if (defined($next) and $next ne '');
+ &nextrev($self, $revs, $next, $branchfirst) if (defined($next) and $next ne '');
}
else {
- &nextrev($revs, $next, $branchfirst) if (defined($next) and $next ne '');
+ &nextrev($self, $revs, $next, $branchfirst) if (defined($next) and $next ne '');
foreach my $branch (@{$branches}) {
- &nextrev($revs, $branch, $branchfirst);
+ &nextrev($self, $revs, $branch, $branchfirst);
}
}
return;
@@ -350,23 +382,30 @@
}
# INTERNAL: generate output of a value in RCS syntax and layout
-sub _genvalue ($$) {
- my ($val, $tag) = @_;
+sub _genvalue ($$$) {
+ my ($self, $val, $tag) = @_;
my $rcs = '';
if (ref($val) eq 'ARRAY' and @{$val} > 0) {
foreach my $v (@{$val}) {
+ $v = $self->_rev_num2rev($v) if ($self->_rev_isnum($v));
$rcs .= "\n\t$v";
}
}
elsif (ref($val) eq 'HASH' and keys(%{$val}) > 0) {
if (defined($val->{-order})) {
- foreach my $v (@{$val->{-order}}) {
- $rcs .= sprintf("\n\t%s:%s", $v, $val->{$v});
+ foreach my $k (@{$val->{-order}}) {
+ my $v = $val->{$k};
+ $v = $self->_rev_num2rev($v) if ($self->_rev_isnum($v));
+ $k = $self->_rev_num2rev($k) if ($self->_rev_isnum($k));
+ $rcs .= sprintf("\n\t%s:%s", $k, $v);
}
}
else {
- foreach my $v (keys(%{$val})) {
- $rcs .= sprintf("\n\t%s:%s", $v, $val->{$v});
+ foreach my $k (keys(%{$val})) {
+ my $v = $val->{$k};
+ $v = $self->_rev_num2rev($v) if ($self->_rev_isnum($v));
+ $k = $self->_rev_num2rev($k) if ($self->_rev_isnum($k));
+ $rcs .= sprintf("\n\t%s:%s", $k, $v);
}
}
}
@@ -375,6 +414,7 @@
$rcs .= "\t" . &_string_quote($val);
}
else {
+ $val = $self->_rev_num2rev($val) if ($self->_rev_isnum($val));
$rcs .= "\t$val";
}
}
@@ -417,29 +457,29 @@
$tag = $1 if ($header =~ s/([@\-])$//s);
my $val = $self->{'rcs'}->{'header'}->{$header};
if (defined($val)) {
- $rcs .= $header . &_genvalue($val, $tag). ";";
+ $rcs .= $header . $self->_genvalue($val, $tag). ";";
$rcs .= ($tag eq '-' ? " " : "\n");
}
}
$rcs .= "\n";
# generate delta section(s)
- my @revlist = &_revlist($self, 0);
+ my @revlist = $self->_revlist(0);
foreach my $rev (@revlist) {
my $delta = $self->{'rcs'}->{'delta'}->{$rev};
$rcs .= "\n";
- $rcs .= $rev."\n";
+ $rcs .= $self->_rev_num2rev($rev)."\n";
$rcs .= "date\t" . $delta->{'date'} . ";\t";
$rcs .= "author " . $delta->{'author'} . ";\t";
$rcs .= "state " . $delta->{'state'} . ";\n";
$rcs .= "branches";
if (@{$delta->{'branches'}} > 0) {
foreach my $v (@{$delta->{'branches'}}) {
- $rcs .= "\n\t$v";
+ $rcs .= "\n\t". $self->_rev_num2rev($v);
}
}
$rcs .= ";\n";
- $rcs .= "next\t" . $delta->{'next'} . ";\n";
+ $rcs .= "next\t" . (defined($delta->{'next'}) ? $self->_rev_num2rev($delta->{'next'}) : "") . ";\n";
}
# generate description section
@@ -447,12 +487,12 @@
$rcs .= "\n\ndesc\n" . &_string_quote($desc) . "\n";
# generate deltatext section(s)
- @revlist = &_revlist($self, 1);
+ @revlist = $self->_revlist(1);
foreach my $rev (@revlist) {
my $delta = $self->{'rcs'}->{'delta'}->{$rev};
$rcs .= "\n";
$rcs .= "\n";
- $rcs .= $rev."\n";
+ $rcs .= $self->_rev_num2rev($rev)."\n";
$rcs .= "log\n" . &_string_quote($delta->{'log'}) . "\n";
$rcs .= "text\n" . &_string_quote($delta->{'text'}) . "\n";
}
@@ -460,6 +500,18 @@
return $rcs;
}
+# apply a translation function onto all RCS revisions
+sub revapply ($$) {
+ my ($self, $sub) = @_;
+ foreach my $num (keys(%{$self->{'rcs'}->{'rev'}})) {
+ $self->{'rcs'}->{'rev'}->{$num} =
+ &$sub($self->{'rcs'}->{'rev'}->{$num});
+ }
+ return;
+}
+
+1;
+
__END__
=pod
|
