Index: ossp-pkg/cvsfusion/RCS.pm
RCS File: /v/ossp/cvs/ossp-pkg/cvsfusion/RCS.pm,v
rcsdiff -q -kk '-r1.6' '-r1.7' -u '/v/ossp/cvs/ossp-pkg/cvsfusion/RCS.pm,v' 2>/dev/null
--- 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