--- RCS.pm 2004/04/23 17:58:17 1.7
+++ RCS.pm 2004/04/23 21:38:48 1.8
@@ -28,36 +28,84 @@
## RCS.pm: RCS file handling
##
-package RCS;
-
require 5;
+use strict;
+use warnings;
+
+## _________________________________________________________________________
+##
+## Class "RCS::Global" (SHARED)
+## _________________________________________________________________________
+##
+
+package RCS::Global;
+
+# check whether an entry name is valid
+sub valid_entry_name ($$) {
+ my ($obj, $name) = @_;
+
+ my $valid = 0;
+ if (defined($obj->{$name}) and $name !~ m|^-|) {
+ $valid = 1;
+ }
+ return $valid;
+}
+
+# check whether an entry value is valid
+sub valid_entry_value ($$$) {
+ my ($obj, $name, $value) = @_;
+
+ my $type = $obj->{$name}->{-type};
+ my $syntax = $obj->{$name}->{-syntax};
+
+ my $valid = 0;
+ if ($type eq '$' and not ref($value) and $value =~ m|${syntax}|s) {
+ $valid = 1;
+ }
+ elsif ($type eq '@' and ref($value) eq 'ARRAY') {
+ $valid = 1;
+ foreach my $v (@{$value}) {
+ if ($v !~ m|${syntax}|s) {
+ $valid = 0;
+ last;
+ }
+ }
+ }
+ elsif ($type eq '%' and ref($value) eq 'HASH') {
+ $valid = 1;
+ foreach my $k (keys(%{$value})) {
+ if ($k."::".$value->{$k} !~ m|${syntax}|s) {
+ $valid = 0;
+ last;
+ }
+ }
+ }
+ return $valid;
+}
+
+## _________________________________________________________________________
+##
+## Class "RCS::Object" (ABSTRACT)
+## _________________________________________________________________________
+##
+
+package RCS::Object;
+
require Exporter;
use Carp;
-use IO::File;
-@ISA = qw(Exporter);
-@EXPORT_OK = qw(new destroy DESTROY dump tool load save parse format revapply trunk2branch);
+our @ISA = qw(Exporter);
+our @EXPORT_OK = qw(new destroy DESTROY dump);
# create new object
sub new ($;$) {
- my ($proto, $file) = @_;
+ my ($proto) = @_;
# create new object
my $class = ref($proto) || $proto;
my $self = {};
bless ($self, $class);
- # initialize object
- $self->{'tool'} = {
- 'rcs' => 'rcs',
- 'co' => 'co',
- 'diff' => 'diff',
- };
- $self->{'rcs'} = {};
-
- # optionally load file into object
- $rcs->load($file) if (defined($file));
-
# return new object
return $self;
}
@@ -78,7 +126,7 @@
# dump object internals (debugging only)
sub dump ($;$) {
my ($self, $name) = @_;
- $name ||= "rcs";
+ $name ||= "obj";
eval {
use Data::Dumper;
};
@@ -92,17 +140,129 @@
return $dump;
}
-# get and/or set paths to external tools
-sub tool ($;$) {
- my ($self, $tool, $path) = @_;
- my $old = $self->{'tool'}->{$tool};
- if (not defined($old)) {
- croak "tool \"$tool\" not known";
+## _________________________________________________________________________
+##
+## Class "RCS::Revision"
+## _________________________________________________________________________
+##
+
+package RCS::Revision;
+
+require 5;
+require Exporter;
+use Carp;
+
+our @ISA = qw(Exporter RCS::Object);
+our @EXPORT_OK = qw(new destroy DESTROY dump revision set get);
+
+# create new object
+sub new ($;$) {
+ my ($proto, $rev) = @_;
+
+ # create new object
+ my $self = {
+ -rev => undef,
+ -order => [],
+ 'date' => { -type => '$', -syntax => qr/.*/, -value => undef },
+ 'author' => { -type => '$', -syntax => qr/.*/, -value => undef },
+ 'state' => { -type => '$', -syntax => qr/.*/, -value => undef },
+ 'branches' => { -type => '@', -syntax => qr/.*/, -value => undef },
+ 'next' => { -type => '$', -syntax => qr/.*/, -value => undef },
+ 'log' => { -type => '$', -syntax => qr/.*/, -value => undef },
+ 'text' => { -type => '$', -syntax => qr/.*/, -value => undef },
+ };
+ my $class = ref($proto) || $proto;
+ bless ($self, $class);
+
+ # optionally set revision
+ $self->revision($rev) if (defined($rev));
+
+ # return new object
+ return $self;
+}
+
+# get and/or set revision number
+sub revision ($;$) {
+ my ($self, $rev) = @_;
+ my $old_rev = $self->{-rev};
+ if (defined($rev)) {
+ $self->{-rev} = $rev;
}
- if (defined($path)) {
- $self->{'tool'}->{$tool} = $path;
+ return $old_rev;
+}
+
+# set entry into object
+sub set ($$$) {
+ my ($self, $name, $value) = @_;
+
+ if (not RCS::Global::valid_entry_name($self, $name)) {
+ croak "invalid entry \"$name\"";
+ }
+ if (defined($value)) {
+ if (not RCS::Global::valid_entry_value($self, $name, $value)) {
+ croak "invalid value \"$value\" for entry \"$name\"";
+ }
+ }
+ my $old_value = $self->{$name}->{-value};
+ $self->{$name}->{-value} = $value;
+ $self->{-order} = [ grep { $_ ne $name } @{$self->{-order}} ];
+ push(@{$self->{-order}}, $name);
+ return $old_value;
+}
+
+# get entry from object
+sub get ($;$) {
+ my ($self, $name) = @_;
+
+ if (not defined($name)) {
+ return @{$self->{-order}};
+ }
+ if (not RCS::Global::valid_entry_name($self, $name)) {
+ croak "invalid entry \"$name\"";
}
- return $old;
+ return $self->{$name}->{-value};
+}
+
+## _________________________________________________________________________
+##
+## Class "RCS"
+## _________________________________________________________________________
+##
+
+package RCS;
+
+require Exporter;
+use Carp;
+use IO::File;
+
+our @ISA = qw(Exporter RCS::Object);
+our @EXPORT_OK = qw(new destroy DESTROY dump load save parse format insert remove lookup set get);
+
+# create new object
+sub new ($;$) {
+ my ($proto, $file) = @_;
+
+ # create new object
+ my $self = {
+ -order => [],
+ 'head' => { -type => '$', -syntax => qr/.*/, -value => undef },
+ 'access' => { -type => '$', -syntax => qr/.*/, -value => undef },
+ 'symbols' => { -type => '@', -syntax => qr/.*/, -value => undef },
+ 'locks' => { -type => '%', -syntax => qr/.*/, -value => undef },
+ 'strict' => { -type => '%', -syntax => qr/.*/, -value => undef },
+ 'comment' => { -type => '$', -syntax => qr/.*/, -value => undef },
+ 'expand' => { -type => '$', -syntax => qr/.*/, -value => undef },
+ 'desc' => { -type => '$', -syntax => qr/.*/, -value => undef },
+ -revision => { -count => 0 },
+ };
+ my $class = ref($proto) || $proto;
+ bless ($self, $class);
+
+ # optionally load file into object
+ $self->load($file) if (defined($file));
+
+ # return new object
+ return $self;
}
# INTERNAL: quote a RCS string
@@ -139,27 +299,45 @@
}
# INTERNAL: structured revision to sequential number mapping
-sub _rev_rev2num ($$) {
+sub 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);
+ foreach my $num (keys(%{$self->{'-revision'}})) {
+ next if ($num =~ m|^-|);
+ return $num if ($self->{'-revision'}->{$num}->revision() eq $rev);
}
- my $num = sprintf("REV-NUM(%d)", $self->{'rcs'}->{'rev'}->{-count}++);
- $self->{'rcs'}->{'rev'}->{$num} = $rev;
+ my $num = sprintf("REV-NUM(%d)", $self->{'-revision'}->{-count}++);
+ $self->{'-revision'}->{$num} = new RCS::Revision $rev;
return $num;
}
# INTERNAL: sequential number to structured revision mapping
-sub _rev_num2rev ($$) {
+sub num2rev ($$) {
my ($self, $num) = @_;
- return $self->{'rcs'}->{'rev'}->{$num};
+ return $self->{'-revision'}->{$num}->revision();
+}
+
+# INTERNAL: object to sequential number mapping
+sub obj2num ($$) {
+ my ($self, $obj) = @_;
+ foreach my $num (keys(%{$self->{'-revision'}})) {
+ next if ($num =~ m|^-|);
+ return $num if ($self->{'-revision'}->{$num} eq $obj);
+ }
+ my $num = sprintf("REV-NUM(%d)", $self->{'-revision'}->{-count}++);
+ $self->{'-revision'}->{$num} = $obj;
+ return $num;
+}
+
+# INTERNAL: sequential number to object mapping
+sub num2obj ($$) {
+ my ($self, $num) = @_;
+ return $self->{'-revision'}->{$num};
}
# INTERNAL: check whether argument is a valid sequential number
-sub _rev_isnum ($$) {
+sub isrevnum ($$) {
my ($self, $num) = @_;
- return (($num =~ m|^REV-NUM\(\d+\)$| and defined($self->{'rcs'}->{'rev'}->{$num})) ? 1 : 0);
+ return (($num =~ m|^REV-NUM\(\d+\)$| and defined($self->{'-revision'}->{$num})) ? 1 : 0);
}
# parse a RCS file content into object
@@ -167,12 +345,11 @@
sub parse ($$) {
my ($self, $rcs) = @_;
- # clear RCS structure
- $self->{'rcs'} = {
- 'header' => { -order => [] },
- 'delta' => { -order => [] },
- 'rev' => { -count => 0 },
- };
+ # clear entries of object
+ foreach my $entry (keys(%{$self})) {
+ next if ($entry =~ m|^-|);
+ $self->{$entry}->{-value} = undef;
+ }
# pre-generate reusable regular expressions
my $re_num = qr/[\d.]+/;
@@ -188,63 +365,61 @@
while (1) {
$rcs =~ s|^\s*||s;
if ($rcs =~ s/^head\s+($re_rev)\s*;//s) {
- $self->{'rcs'}->{'header'}->{'head'} = $self->_rev_rev2num($1);
- push(@{$self->{'rcs'}->{'header'}->{-order}}, 'head');
+ $self->{'head'}->{-value} = $self->rev2num($1);
+ push(@{$self->{-order}}, 'head');
}
elsif ($rcs =~ s/^branch\s+($re_rev)\s*;//s) {
- $self->{'rcs'}->{'header'}->{'branch'} = $self->_rev_rev2num($1);
- push(@{$self->{'rcs'}->{'header'}->{-order}}, 'branch');
+ $self->{'branch'}->{-value} = $self->rev2num($1);
+ push(@{$self->{-order}}, 'branch');
}
elsif ($rcs =~ s/^access((?:\s+$re_id)*)\s*;//s) {
- $self->{'rcs'}->{'header'}->{'access'} =
- (defined($1) ? [ split(/\s+/, $1) ] : []);
- push(@{$self->{'rcs'}->{'header'}->{-order}}, 'access');
+ $self->{'access'}->{-value} = (defined($1) ? [ split(/\s+/, $1) ] : []);
+ push(@{$self->{-order}}, 'access');
}
elsif ($rcs =~ s/^symbols((?:\s+$re_sym:$re_rev)*)\s*;//s) {
my $symbols = { -order => [] };
if (defined($1)) {
map { if (m/^(.+):(.+)$/s) {
- $symbols->{$1} = $self->_rev_rev2num($2);
+ $symbols->{$1} = $self->rev2num($2);
push(@{$symbols->{-order}}, $1);
} } split(/\s+/, $1);
}
- $self->{'rcs'}->{'header'}->{'symbols'} = $symbols;
- push(@{$self->{'rcs'}->{'header'}->{-order}}, 'symbols');
+ $self->{'symbols'}->{-value} = $symbols;
+ push(@{$self->{-order}}, 'symbols');
}
elsif ($rcs =~ s/^locks((?:\s+$re_id:$re_rev)*)\s*;//s) {
my $locks = { -order => [] };
if (defined($1)) {
map { if (m/^(.+):(.+)$/s) {
- $locks->{$1} = $self->_rev_rev2num($2);
+ $locks->{$1} = $self->rev2num($2);
push(@{$locks->{-order}}, $1);
} } split(/\s+/, $1);
}
- $self->{'rcs'}->{'header'}->{'locks'} = $locks;
- push(@{$self->{'rcs'}->{'header'}->{-order}}, 'locks');
+ $self->{'locks'}->{-value} = $locks;
+ push(@{$self->{-order}}, 'locks');
}
elsif ($rcs =~ s/^strict\s*;//s) {
- $self->{'rcs'}->{'header'}->{'strict'} = "";
- push(@{$self->{'rcs'}->{'header'}->{-order}}, 'strict');
+ $self->{'strict'}->{-value} = "";
+ push(@{$self->{-order}}, 'strict');
}
#elsif ($rcs =~ s/^comment\s+\@($re_str)\@\s*;//s) { # would maximally span 32K
elsif ($rcs =~ s/^comment\s+\@//s) {
my $str = '';
- 1 while ($rcs =~ s/^((?:\@\@|[^@])+)/$str .= $1, ''/se);
+ 1 while ($rcs =~ s/^((?:\@\@|[^@]){1,32000})/$str .= $1, ''/se);
$rcs =~ s/\@\s*;//s;
- $self->{'rcs'}->{'header'}->{'comment'} = &_string_unquote($str);
- push(@{$self->{'rcs'}->{'header'}->{-order}}, 'comment');
+ $self->{'comment'}->{-value} = &_string_unquote($str);
+ push(@{$self->{-order}}, 'comment');
}
#elsif ($rcs =~ s/^expand\s+\@($re_str)\@\s*;//s) { # would maximally span 32K
elsif ($rcs =~ s/^expand\s+\@//s) {
my $str = '';
- 1 while ($rcs =~ s/^((?:\@\@|[^@])+)/$str .= $1, ''/se);
+ 1 while ($rcs =~ s/^((?:\@\@|[^@]){1,32000})/$str .= $1, ''/se);
$rcs =~ s/\@\s*;//s;
- $self->{'rcs'}->{'header'}->{'expand'} = &_string_unquote($str);
- push(@{$self->{'rcs'}->{'header'}->{-order}}, 'expand');
+ $self->{'expand'}->{-value} = &_string_unquote($str);
+ push(@{$self->{-order}}, 'expand');
}
elsif ($rcs =~ s/^([a-z]+)(?:\s*([^;]*));//s) {
- $self->{'rcs'}->{'header'}->{$1} = $2;
- push(@{$self->{'rcs'}->{'header'}->{-order}}, $1);
+ # currently intentionally just ignored, because does not occur at all
}
else {
last;
@@ -255,33 +430,31 @@
while (1) {
$rcs =~ s|^\s*||s;
if ($rcs =~ s/^($re_rev)//s) {
- my $rev = $self->_rev_rev2num($1);
- $self->{'rcs'}->{'delta'}->{$rev} = {};
- push(@{$self->{'rcs'}->{'delta'}->{-order}}, $rev);
+ my $num = $self->rev2num($1);
+ my $rev = $self->num2obj($num);
while (1) {
$rcs =~ s|^\s*||s;
if ($rcs =~ s/^date\s+($re_date)\s*;//s) {
- $self->{'rcs'}->{'delta'}->{$rev}->{'date'} = $1;
+ $rev->set('date', $1);
}
elsif ($rcs =~ s/^author\s+($re_id)\s*;//s) {
- $self->{'rcs'}->{'delta'}->{$rev}->{'author'} = $1;
+ $rev->set('author', $1);
}
elsif ($rcs =~ s/^state(?:\s*($re_id))?\s*;//s) {
- $self->{'rcs'}->{'delta'}->{$rev}->{'state'} = $1;
+ $rev->set('state', $1);
}
elsif ($rcs =~ s/^branches(?:\s+((?:\s*$re_rev)*))?\s*;//s) {
- $self->{'rcs'}->{'delta'}->{$rev}->{'branches'} =
- (defined($1) and $1 ne '' ? [ map { $self->_rev_rev2num($_) } split(/\s+/, $1) ] : []);
+ $rev->set('branches',
+ defined($1) ? [ map { $self->rev2num($_) } split(/\s+/, $1) ] : []);
}
elsif ($rcs =~ s/^next(?:\s*($re_rev))?\s*;//s) {
- $self->{'rcs'}->{'delta'}->{$rev}->{'next'} =
- (defined($1) and $1 ne '' ? $self->_rev_rev2num($1) : '');
+ $rev->set('next', (defined($1) and $1 ne '' ? $self->rev2num($1) : ''));
}
elsif ($rcs =~ m/^desc\s+/s) {
last;
}
elsif ($rcs =~ s/^([a-z]+)(?:\s*([^;]*));//s) {
- $self->{'rcs'}->{'delta'}->{$rev}->{$1} = $2;
+ # currently intentionally just ignored, because does not occur at all
}
else {
last;
@@ -298,36 +471,34 @@
#if ($rcs =~ s/^desc\s+\@($re_str)\@\s*//s) { # would maximally span 32K
if ($rcs =~ s/^desc\s+\@//s) {
my $str = '';
- 1 while ($rcs =~ s/^((?:\@\@|[^@])+)/$str .= $1, ''/se);
+ 1 while ($rcs =~ s/^((?:\@\@|[^@]){1,32000})/$str .= $1, ''/se);
$rcs =~ s/\@\s*//s;
- $self->{'rcs'}->{'header'}->{'desc'} = &_string_unquote($str);
- push(@{$self->{'rcs'}->{'header'}->{-order}}, 'desc');
+ $self->{'desc'}->{-value} = &_string_unquote($str);
+ push(@{$self->{-order}}, 'desc');
}
# parse deltatext section(s)
while (1) {
$rcs =~ s|^\s*||s;
if ($rcs =~ s/^($re_rev)//s) {
- my $rev = $self->_rev_rev2num($1);
- if (not defined($self->{'rcs'}->{'delta'}->{$rev})) {
- croak "deltatext section for unknown revision \"".$self->_rev_num2rev($rev)."\" found";
- }
+ my $num = $self->rev2num($1);
+ my $rev = $self->num2obj($num);
my $textseen = 0;
while (1) {
$rcs =~ s|^\s*||s;
#if ($rcs =~ s/^log\s+\@($re_str)\@\s*//s) { # would maximally span 32K
if ($rcs =~ s/^log\s+\@//s) {
my $str = '';
- 1 while ($rcs =~ s/^((?:\@\@|[^@])+)/$str .= $1, ''/se);
+ 1 while ($rcs =~ s/^((?:\@\@|[^@]){1,32000})/$str .= $1, ''/se);
$rcs =~ s/\@\s*//s;
- $self->{'rcs'}->{'delta'}->{$rev}->{'log'} = &_string_unquote($str);
+ $rev->set('log', &_string_unquote($str));
}
#elsif ($rcs =~ s/^text\s+\@($re_str)\@\s*//s) { # would maximally span 32K
elsif ($rcs =~ s/^text\s+\@//s) {
my $str = '';
- 1 while ($rcs =~ s/^((?:\@\@|[^@])+)/$str .= $1, ''/se);
+ 1 while ($rcs =~ s/^((?:\@\@|[^@]){1,32000})/$str .= $1, ''/se);
$rcs =~ s/\@\s*//s;
- $self->{'rcs'}->{'delta'}->{$rev}->{'text'} = &_string_unquote($str);
+ $rev->set('text', &_string_unquote($str));
$textseen = 1;
}
#elsif ($textseen == 0 and $rcs =~ s/^([a-z]+)(?:\s+\@($re_str)\@\s*)?//s) { # would maximally span 32K
@@ -335,10 +506,10 @@
my ($keyword, $with_str) = ($1, $2);
my $str = '';
if ($with_str) {
- 1 while ($rcs =~ s/^((?:\@\@|[^@])+)/$str .= $1, ''/se);
+ 1 while ($rcs =~ s/^((?:\@\@|[^@]){1,32000})/$str .= $1, ''/se);
$rcs =~ s/\@\s*//s;
}
- $self->{'rcs'}->{'delta'}->{$rev}->{$keyword} = $str;
+ # currently intentionally just ignored, because does not occur at all
}
else {
last;
@@ -358,12 +529,14 @@
sub _revlist ($$) {
my ($self, $branchfirst) = @_;
my @revs = ();
- &nextrev($self, \@revs, $self->{'rcs'}->{'header'}->{'head'}, $branchfirst);
+ if (defined($self->{'head'}->{-value})) {
+ &nextrev($self, \@revs, $self->{'head'}->{-value}, $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'};
+ my $next = $self->num2obj($rev)->get('next');
+ my $branches = $self->num2obj($rev)->get('branches');
if ($branchfirst) {
foreach my $branch (@{$branches}) {
&nextrev($self, $revs, $branch, $branchfirst);
@@ -387,7 +560,7 @@
my $rcs = '';
if (ref($val) eq 'ARRAY' and @{$val} > 0) {
foreach my $v (@{$val}) {
- $v = $self->_rev_num2rev($v) if ($self->_rev_isnum($v));
+ $v = $self->num2rev($v) if ($self->isrevnum($v));
$rcs .= "\n\t$v";
}
}
@@ -395,16 +568,16 @@
if (defined($val->{-order})) {
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));
+ $v = $self->num2rev($v) if ($self->isrevnum($v));
+ $k = $self->num2rev($k) if ($self->isrevnum($k));
$rcs .= sprintf("\n\t%s:%s", $k, $v);
}
}
else {
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));
+ $v = $self->num2rev($v) if ($self->isrevnum($v));
+ $k = $self->num2rev($k) if ($self->isrevnum($k));
$rcs .= sprintf("\n\t%s:%s", $k, $v);
}
}
@@ -414,7 +587,7 @@
$rcs .= "\t" . &_string_quote($val);
}
else {
- $val = $self->_rev_num2rev($val) if ($self->_rev_isnum($val));
+ $val = $self->num2rev($val) if ($self->isrevnum($val));
$rcs .= "\t$val";
}
}
@@ -449,13 +622,11 @@
# generate header section
foreach my $header (
- @kw_header,
- ( grep { not grep(/^\Q$_\E$/, @kw_header) }
- @{$self->{'rcs'}->{'header'}->{-order}} )
+ @kw_header, (grep { not grep(/^\Q$_\E$/, @kw_header) } @{$self->{-order}})
) {
my $tag = '';
$tag = $1 if ($header =~ s/([@\-])$//s);
- my $val = $self->{'rcs'}->{'header'}->{$header};
+ my $val = $self->{$header}->{-value};
if (defined($val)) {
$rcs .= $header . $self->_genvalue($val, $tag). ";";
$rcs .= ($tag eq '-' ? " " : "\n");
@@ -466,54 +637,127 @@
# generate delta section(s)
my @revlist = $self->_revlist(0);
foreach my $rev (@revlist) {
- my $delta = $self->{'rcs'}->{'delta'}->{$rev};
+ my $obj = $self->num2obj($rev);
$rcs .= "\n";
- $rcs .= $self->_rev_num2rev($rev)."\n";
- $rcs .= "date\t" . $delta->{'date'} . ";\t";
- $rcs .= "author " . $delta->{'author'} . ";\t";
- $rcs .= "state " . $delta->{'state'} . ";\n";
+ $rcs .= $obj->revision()."\n";
+ $rcs .= "date\t" . $obj->get('date') . ";\t";
+ $rcs .= "author " . $obj->get('author') . ";\t";
+ $rcs .= "state " . $obj->get('state') . ";\n";
$rcs .= "branches";
- if (@{$delta->{'branches'}} > 0) {
- foreach my $v (@{$delta->{'branches'}}) {
- $rcs .= "\n\t". $self->_rev_num2rev($v);
+ my $branches = $obj->get('branches');
+ if (@{$branches} > 0) {
+ foreach my $v (@{$branches}) {
+ $rcs .= "\n\t". $self->num2rev($v);
}
}
$rcs .= ";\n";
- $rcs .= "next\t" . (defined($delta->{'next'}) ? $self->_rev_num2rev($delta->{'next'}) : "") . ";\n";
+ my $next = $obj->get('next');
+ $rcs .= "next\t" . (defined($next) and $next ne '' ? $self->num2rev($next) : "") . ";\n";
}
# generate description section
- my $desc = $self->{'rcs'}->{'header'}->{'desc'};
+ my $desc = $self->{'desc'}->{-value};
$rcs .= "\n\ndesc\n" . &_string_quote($desc) . "\n";
# generate deltatext section(s)
@revlist = $self->_revlist(1);
foreach my $rev (@revlist) {
- my $delta = $self->{'rcs'}->{'delta'}->{$rev};
+ my $obj = $self->num2obj($rev);
$rcs .= "\n";
$rcs .= "\n";
- $rcs .= $self->_rev_num2rev($rev)."\n";
- $rcs .= "log\n" . &_string_quote($delta->{'log'}) . "\n";
- $rcs .= "text\n" . &_string_quote($delta->{'text'}) . "\n";
+ $rcs .= $obj->revision()."\n";
+ my $log = $obj->get('log') || '';
+ my $text = $obj->get('text') || '';
+ $rcs .= "log\n" . &_string_quote($log) . "\n";
+ $rcs .= "text\n" . &_string_quote($text) . "\n";
}
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});
+# insert a revision object
+sub insert ($$) {
+ my ($self, $obj) = @_;
+ $self->obj2num($obj);
+}
+
+# remove a revision object
+sub remove ($$) {
+ my ($self, $obj) = @_;
+ my $num = $self->obj2num($obj);
+ delete $self->{-revision}->{$num};
+}
+
+# lookup a revision object
+sub lookup ($;$) {
+ my ($self, $id) = @_;
+
+ if (not defined($id)) {
+ return values(%{$self->{-revision}});
+ }
+ else {
+ if ($id =~ m|^\d+(\.\d+)*$|) {
+ # lookup by revision number
+ my $num = $self->rev2num($id);
+ my $obj = $self->num2obj($num);
+ return $obj;
+ }
+ else {
+ # lookup by symbolic tag
+ foreach my $symbol (keys(%{$self->{'symbols'}->{-value}})) {
+ if ($symbol eq $id) {
+ my $num = $self->{'symbols'}->{-value}->{$symbol};
+ my $obj = $self->num2obj($num);
+ return $obj;
+ }
+ }
+ }
}
- return;
+ return undef;
+}
+
+# set entry into object
+sub set ($$$) {
+ my ($self, $name, $value) = @_;
+
+ if (not RCS::Global::valid_entry_name($self, $name)) {
+ croak "invalid entry \"$name\"";
+ }
+ if (defined($value)) {
+ if (not RCS::Global::valid_entry_value($self, $name, $value)) {
+ croak "invalid value \"$value\" for entry \"$name\"";
+ }
+ }
+ my $old_value = $self->{$name}->{-value};
+ $self->{$name}->{-value} = $value;
+ $self->{-order} = [ grep { $_ ne $name } @{$self->{-order}} ];
+ push(@{$self->{-order}}, $name);
+ return $old_value;
+}
+
+# get entry from object
+sub get ($;$) {
+ my ($self, $name) = @_;
+
+ if (not defined($name)) {
+ return @{$self->{-order}};
+ }
+ if (not RCS::Global::valid_entry_name($self, $name)) {
+ croak "invalid entry \"$name\"";
+ }
+ return $self->{$name}->{-value};
}
1;
__END__
+## _________________________________________________________________________
+##
+## Manual Page
+## _________________________________________________________________________
+##
+
=pod
=head1 NAME
@@ -533,38 +777,90 @@
=item C<my $rcs = >B<new>C< RCS>[C< $filename>]C<;>
-This creates a new RCS object and (for convinience reasons) optionally
-loads an RCS file via C<$rcs-E<gt>>B<load>C<($filename)> into it.
-
=item C<$rcs-E<gt>>B<destroy>C<;>
-=item C<undef $rcs;>
+Method B<new> creates a new RCS object and (for convinience reasons)
+optionally loads an RCS file via C<$rcs-E<gt>>B<load>C<($filename)>
+into it. Method B<destroy> destroys the RCS object and frees all its
+resources.
-This destroys the RCS object.
-
-=item [C<my $old_path = >]C<$rcs-E<gt>>B<tool>C<(">I<tool>C<", $path);>
+=item C<$rcs-E<gt>>B<load>C<($filename);>
-=item C<my $path = $rcs-E<gt>>B<tool>C<(">I<tool>C<");>
+=item C<$rcs-E<gt>>B<save>C<($filename);>
-This sets and/or gets the path to the external command I<tool>. Used
-I<tool>s are C<rcs>, C<co> and C<diff> from GNU RCS and GNU DiffUtils.
+Method B<load> loads the RCS file under C<$filename> into RCS object C<$rcs>.
+Methid B<save> saves the RCS file content from RCS object C<$rcs> under C<$filename>.
=item C<$rcs-E<gt>>B<parse>C<($filename, $rcstext);>
-This parses the RCS file content in C<$rcstext> and
-and stores the result in RCS object C<$rcs>.
-
=item C<my $rcstext = $rcs-E<gt>>B<format>C<($filename);>
-This formats and returns the RCS file content in C<$rcs>.
+Method B<parse> parses the RCS file content in C<$rcstext> and and
+stores the result in RCS object C<$rcs>. Method B<format> formats and
+returns the RCS file content in C<$rcs>.
-=item C<$rcs-E<gt>>B<load>C<($filename);>
+=item C<my $value = $rcs-E<gt>>B<get>C<($name);>
-This loads the RCS file under C<$filename> into RCS object C<$rcs>.
+=item C<$rcs-E<gt>>B<set>C<($name, $value);>
-=item C<$rcs-E<gt>>B<save>C<($filename);>
+Methods B<get> and B<set> get and/or set the value of the RCS entry
+identified by C<$name>. Known entries are:
+
+ Name Type Example
+ head scalar '1.42'
+ branch scalar '1.7'
+ access array reference [ 'foo', 'bar' ]
+ symbols hash reference { 'FOO' => '1.1', 'BAR' => '1.2' }
+ locks hash reference { 'foo' => '1.3', 'bar' => '1.4' }
+ strict scalar 1
+ comment scalar 'foo bar'
+ expand scalar 'b'
+ desc scalar 'foo bar'
+
+=item C<$rcs-E<gt>>B<insert>C<($rev);>
+
+=item C<$rcs-E<gt>>B<remove>C<($rev);>
+
+=item C<my @revlist = $rcs-E<gt>>B<lookup>C<();>
+
+=item C<my $rev = $rcs-E<gt>>B<lookup>C<($num);>
+
+=item C<my $rev = $rcs-E<gt>>B<lookup>C<($tag);>
+
+Methods B<insert> and B<remove> insert and remove a RCS::Revision object
+C<$rev> to/from the RCS object C<$rcs>. Method B<lookup> lookups the
+RCS file content revision(s) and returns either all existing revision
+objects or a particular revision looked up by revision number or
+revision tag. The result objects are of type RCS::Revision.
+
+=item C<my $rev = >B<new>C< RCS::Revision>[ C<$rev>]C<;>
+
+=item C<$rev-E<gt>>B<destroy>C<;>
+
+Method B<new> creates a new RCS::Revision object. Method B<destroy>
+destroys the RCS object and frees all its resources.
+
+=item [C<my $rev = >]C<$rev-E<gt>>B<revision>C<(>[C<$rev>]C<);>
+
+Method B<revision> gets and/or sets the revision number of the object.
+
+=item C<my @names = $rev-E<gt>>B<get>C<();>
+
+=item C<my $value = $rev-E<gt>>B<get>C<($name);>
+
+=item C<$rev-E<gt>>B<set>C<($name, $value);>
+
+Methods B<get> and B<set> get and/or set the value of the RCS::Revision
+entry identified by C<$name>. Known entries are:
-This saves the RCS file content from RCS object C<$rcs> under C<$filename>.
+ Name Type Example
+ date scalar 2004.04.24.10.20.30
+ author scalar foo
+ state scalar Exp;
+ branches array reference [ '1.1.1', '1.3.2', '1.4.2' ]
+ next scalar '1.2'
+ log scalar 'foo bar'
+ text scalar "a0 1\nfoo bar\n"
=back
|
