--- RCS.pm 2004/04/23 09:23:38 1.2
+++ RCS.pm 2004/04/23 12:21:44 1.3
@@ -94,6 +94,20 @@
return $old;
}
+# quote/unquote a RCS string
+sub _string_quote {
+ my ($str) = @_;
+ $str =~ s|\@|\@\@|sg;
+ $str = '@' . $str . '@';
+ return $str;
+}
+sub _string_unquote {
+ my ($str) = @_;
+ $str =~ s|^\@(.*)\@$|$1|s;
+ $str =~ s|\@\@|\@|sg;
+ return $str;
+}
+
sub load ($$) {
my $self = shift;
my ($file) = @_;
@@ -137,14 +151,20 @@
push(@{$self->{'rcs'}->{'header'}->{-order}}, 'access');
}
elsif ($rcs =~ s/^symbols((?:\s+$re_sym:$re_rev)*)\s*;//s) {
- my $symbols = {};
- map { $symbols->{$1} = $2 if (m/^(.+):(.+)$/s); } split(/\s+/, $1);
+ my $symbols = { -order => [] };
+ map { if (m/^(.+):(.+)$/s) {
+ $symbols->{$1} = $2;
+ push(@{$symbols->{-order}}, $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 = {};
- map { $locks->{$1} = $2 if (m/^(.+):(.+)$/); } split(/\s+/, $1);
+ my $locks = { -order => [] };
+ map { if (m/^(.+):(.+)$/s) {
+ $locks->{$1} = $2;
+ push(@{$locks->{-order}}, $1);
+ } } split(/\s+/, $1);
$self->{'rcs'}->{'header'}->{'locks'} = $locks;
push(@{$self->{'rcs'}->{'header'}->{-order}}, 'locks');
}
@@ -153,11 +173,11 @@
push(@{$self->{'rcs'}->{'header'}->{-order}}, 'strict');
}
elsif ($rcs =~ s/^comment\s+\@($re_str)\@\s*;//s) {
- $self->{'rcs'}->{'header'}->{'comment'} = $1;
+ $self->{'rcs'}->{'header'}->{'comment'} = &_string_unquote($1);
push(@{$self->{'rcs'}->{'header'}->{-order}}, 'comment');
}
elsif ($rcs =~ s/^expand\s+\@($re_str)\@\s*;//s) {
- $self->{'rcs'}->{'header'}->{'expand'} = $1;
+ $self->{'rcs'}->{'header'}->{'expand'} = &_string_unquote($1);
push(@{$self->{'rcs'}->{'header'}->{-order}}, 'expand');
}
elsif ($rcs =~ s/^([a-z]+)(\s*[^;]*);//s) {
@@ -228,10 +248,10 @@
while (1) {
$rcs =~ s|^\s*||s;
if ($rcs =~ s/^log\s+\@($re_str)\@\s*//s) {
- $self->{'rcs'}->{'delta'}->{$rev}->{'log'} = $1;
+ $self->{'rcs'}->{'delta'}->{$rev}->{'log'} = &_string_unquote($1);
}
elsif ($rcs =~ s/^text\s+\@($re_str)\@\s*//s) {
- $self->{'rcs'}->{'delta'}->{$rev}->{'text'} = $1;
+ $self->{'rcs'}->{'delta'}->{$rev}->{'text'} = &_string_unquote($1);
$textseen = 1;
}
elsif ($textseen == 0 and $rcs =~ s/^([a-z]+)(\s*[^;]*);//s) {
@@ -261,7 +281,11 @@
my @kw_deltatext = (qw(log text));
# generate header section
- foreach my $header (@kw_header) {
+ foreach my $header (
+ @kw_header,
+ ( grep { not grep(/^\Q$_\E$/, @kw_header) }
+ @{$self->{'rcs'}->{'header'}->{-order}} )
+ ) {
my $tag = '';
$tag = $1 if ($header =~ s/([@\-])$//s);
my $val = $self->{'rcs'}->{'header'}->{$header};
@@ -276,16 +300,22 @@
}
elsif (ref($val) eq 'HASH') {
if (keys(%{$val}) > 0) {
- foreach my $v (keys(%{$val})) {
- $rcs .= sprintf("\n\t%s:%s", $v, $val->{$v});
+ if (defined($val->{-order})) {
+ foreach my $v (@{$val->{-order}}) {
+ $rcs .= sprintf("\n\t%s:%s", $v, $val->{$v});
+ }
+ }
+ else {
+ foreach my $v (keys(%{$val})) {
+ $rcs .= sprintf("\n\t%s:%s", $v, $val->{$v});
+ }
}
}
}
else {
if ($val ne '') {
if ($tag eq '@') {
- $val =~ s|\@|\@\@|sg;
- $rcs .= "\t\@$val\@";
+ $rcs .= "\t" . &_string_quote($val);
}
else {
$rcs .= "\t$val";
@@ -299,9 +329,66 @@
$rcs .= "\n";
# generate delta section(s)
- foreach my $rev (@{$self->{'rcs'}->{'delta'}->{-order}}) {
+ sub revlist ($$) {
+ my ($self, $branchfirst) = @_;
+ my @revs = ();
+ &nextrev(\@revs, $self->{'rcs'}->{'header'}->{'head'}, $branchfirst);
+ sub nextrev ($$$) {
+ my ($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);
+ }
+ if (defined($next) and $next ne '') {
+ &nextrev($revs, $next, $branchfirst);
+ }
+ }
+ else {
+ if (defined($next) and $next ne '') {
+ &nextrev($revs, $next, $branchfirst);
+ }
+ foreach my $branch (@{$branches}) {
+ &nextrev($revs, $branch, $branchfirst);
+ }
+ }
+ return;
+ }
+ return @revs;
+ }
+ my @revlist = &revlist($self, 0);
+ foreach my $rev (@revlist) {
+ my $delta = $self->{'rcs'}->{'delta'}->{$rev};
+ $rcs .= "\n";
+ $rcs .= $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";
+ $rcs .= "next\t" . $delta->{'next'} . ";\n";
+ }
+
+ # generate description section
+ my $desc = $self->{'rcs'}->{'header'}->{'desc'};
+ $rcs .= "\n\ndesc\n" . &_string_quote($desc) . "\n";
+
+ # generate deltatext section(s)
+ @revlist = &revlist($self, 1);
+ foreach my $rev (@revlist) {
my $delta = $self->{'rcs'}->{'delta'}->{$rev};
+ $rcs .= "\n";
+ $rcs .= "\n";
$rcs .= $rev."\n";
+ $rcs .= "log\n" . &_string_quote($delta->{'log'}) . "\n";
+ $rcs .= "text\n" . &_string_quote($delta->{'text'}) . "\n";
}
# write new RCS file for disk
|
