Index: ossp-pkg/cvsfusion/RCS.pm RCS File: /v/ossp/cvs/ossp-pkg/cvsfusion/RCS.pm,v rcsdiff -q -kk '-r1.7' '-r1.8' -u '/v/ossp/cvs/ossp-pkg/cvsfusion/RCS.pm,v' 2>/dev/null --- 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 CBC< RCS>[C< $filename>]C<;> -This creates a new RCS object and (for convinience reasons) optionally -loads an RCS file via C<$rcs-E>BC<($filename)> into it. - =item C<$rcs-E>BC<;> -=item C +Method B creates a new RCS object and (for convinience reasons) +optionally loads an RCS file via C<$rcs-E>BC<($filename)> +into it. Method B destroys the RCS object and frees all its +resources. -This destroys the RCS object. - -=item [C]C<$rcs-E>BC<(">IC<", $path);> +=item C<$rcs-E>BC<($filename);> -=item C>BC<(">IC<");> +=item C<$rcs-E>BC<($filename);> -This sets and/or gets the path to the external command I. Used -Is are C, C and C from GNU RCS and GNU DiffUtils. +Method B loads the RCS file under C<$filename> into RCS object C<$rcs>. +Methid B saves the RCS file content from RCS object C<$rcs> under C<$filename>. =item C<$rcs-E>BC<($filename, $rcstext);> -This parses the RCS file content in C<$rcstext> and -and stores the result in RCS object C<$rcs>. - =item C>BC<($filename);> -This formats and returns the RCS file content in C<$rcs>. +Method B parses the RCS file content in C<$rcstext> and and +stores the result in RCS object C<$rcs>. Method B formats and +returns the RCS file content in C<$rcs>. -=item C<$rcs-E>BC<($filename);> +=item C>BC<($name);> -This loads the RCS file under C<$filename> into RCS object C<$rcs>. +=item C<$rcs-E>BC<($name, $value);> -=item C<$rcs-E>BC<($filename);> +Methods B and B 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>BC<($rev);> + +=item C<$rcs-E>BC<($rev);> + +=item C>BC<();> + +=item C>BC<($num);> + +=item C>BC<($tag);> + +Methods B and B insert and remove a RCS::Revision object +C<$rev> to/from the RCS object C<$rcs>. Method B 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 CBC< RCS::Revision>[ C<$rev>]C<;> + +=item C<$rev-E>BC<;> + +Method B creates a new RCS::Revision object. Method B +destroys the RCS object and frees all its resources. + +=item [C]C<$rev-E>BC<(>[C<$rev>]C<);> + +Method B gets and/or sets the revision number of the object. + +=item C>BC<();> + +=item C>BC<($name);> + +=item C<$rev-E>BC<($name, $value);> + +Methods B and B 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