OSSP CVS Repository

ossp - Check-in [4545]
Not logged in
[Honeypot]  [Browse]  [Home]  [Login]  [Reports
[Search]  [Ticket]  [Timeline
  [Patchset]  [Tagging/Branching

Check-in Number: 4545
Date: 2004-Apr-23 23:38:48 (local)
2004-Apr-23 21:38:48 (UTC)
User:rse
Branch:
Comment: Entirely work-off the RCS module again in order to split the RCS class into multiple classes. This especially allows us to provide a more reasonable and intuitive API for manipulating the contents of the RCS file.
Tickets:
Inspections:
Files:
ossp-pkg/cvsfusion/RCS.pm      1.7 -> 1.8     438 inserted, 142 deleted

ossp-pkg/cvsfusion/RCS.pm 1.7 -> 1.8

--- 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
 

CVSTrac 2.0.1