##
##  OSSP cvsfusion - CVS Repository Fusion
##  Copyright (c) 2004 Ralf S. Engelschall <rse@engelschall.com>
##  Copyright (c) 2004 The OSSP Project <http://www.ossp.org/>
##  Copyright (c) 2004 Cable & Wireless <http://www.cw.com/>
##
##  This file is part of OSSP cvsfusion, a CVS repository fusion
##  utility which can be found at http://www.ossp.org/pkg/tool/cvsfusion/.
##
##  Permission to use, copy, modify, and distribute this software for
##  any purpose with or without fee is hereby granted, provided that
##  the above copyright notice and this permission notice appear in all
##  copies.
##
##  THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESSED OR IMPLIED
##  WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
##  MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED.
##  IN NO EVENT SHALL THE AUTHORS AND COPYRIGHT HOLDERS AND THEIR
##  CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
##  SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
##  LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF
##  USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND
##  ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
##  OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT
##  OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
##  SUCH DAMAGE.
##
##  RCS.pm: RCS file handling
##

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;

our @ISA       = qw(Exporter);
our @EXPORT_OK = qw(new destroy DESTROY dump);

#   create new object
sub new ($;$) {
    my ($proto) = @_;

    #   create new object
    my $class = ref($proto) || $proto;
    my $self = {};
    bless ($self, $class);

    #   return new object
    return $self;
}

#   destroy object (explicit destructor)
sub destroy ($) {
    my ($self) = @_;
    return;
}

#   destroy object (implicit destructor)
sub DESTROY ($) {
    my ($self) = @_;
    $self->destroy;
    return;
}

#   dump object internals (debugging only)
sub dump ($;$) {
    my ($self, $name) = @_;
    $name ||= "obj";
    eval {
        use Data::Dumper;
    };
    my $d = new Data::Dumper ([$self], [$name]);
    $d->Indent(1);
    $d->Purity(1);
    $d->Terse(0);
    $d->Deepcopy(0);
    my $dump = "# " . ref($self) . " object dump:\n";
    $dump .= $d->Dump();
    return $dump;
}

##  _________________________________________________________________________
##
##                            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;
    }
    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 $self->{$name}->{-value};
}

##  _________________________________________________________________________
##
##                                 Class "RCS"
##  _________________________________________________________________________
##

package RCS;

require Exporter;
use Carp;
use IO::File;
no warnings;

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
sub _string_quote {
    my ($str) = @_;
    $str =~ s|\@|\@\@|sg;
    $str = '@' . $str . '@';
    return $str;
}

#   INTERNAL: unquote a RCS string
sub _string_unquote {
    my ($str) = @_;
    $str =~ s|^\@(.*)\@$|$1|s;
    $str =~ s|\@\@|\@|sg;
    return $str;
}

#   load an RCS file into object
sub load ($$) {
    my ($self, $file) = @_;

    #   read RCS file into buffer
    my $io = new IO::File "<$file"
        or croak "RCS file \"$file\": cannot open for reading";
    my $rcs = '';
    $rcs .= $_ while (<$io>);
    $io->close;

    #   parse RCS file content into object
    $self->parse($rcs);

    return;
}

#   INTERNAL: structured revision to sequential number mapping
sub rev2num ($$) {
    my ($self, $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->{'-revision'}->{-count}++);
    $self->{'-revision'}->{$num} = new RCS::Revision $rev;
    return $num;
}

#   INTERNAL: sequential number to structured revision mapping
sub num2rev ($$) {
    my ($self, $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 isrevnum ($$) {
    my ($self, $num) = @_;
    return (($num =~ m|^REV-NUM\(\d+\)$| and defined($self->{'-revision'}->{$num})) ? 1 : 0);
}

#   parse a RCS file content into object
#   (see rcsfile(5) for reference)
sub parse ($$) {
    my ($self, $rcs) = @_;

    #   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.]+/;
    my $re_rev     = qr/\d+(?:\.\d+)*/;
    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;
    my $re_date    = qr/(?:\d{2}|\d{4})\.\d{2}\.\d{2}\.\d{2}\.\d{2}\.\d{2}/;

    #   parse header section
    while (1) {
        $rcs =~ s|^\s*||s;
        if ($rcs =~ s/^head\s+($re_rev)\s*;//s) {
            $self->{'head'}->{-value} = $self->rev2num($1);
            push(@{$self->{-order}}, 'head');
        }
        elsif ($rcs =~ s/^branch\s+($re_rev)\s*;//s) {
            $self->{'branch'}->{-value} = $self->rev2num($1);
            push(@{$self->{-order}}, 'branch');
        }
        elsif ($rcs =~ s/^access((?:\s+$re_id)*)\s*;//s) {
            $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->rev2num($2);
                push(@{$symbols->{-order}}, $1);
                } } split(/\s+/, $1);
            } 
            $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->rev2num($2);
                    push(@{$locks->{-order}}, $1);
                } } split(/\s+/, $1);
            }
            $self->{'locks'}->{-value} = $locks;
            push(@{$self->{-order}}, 'locks');
        }
        elsif ($rcs =~ s/^strict\s*;//s) {
            $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/^((?:\@\@|[^@]){1,32000})/$str .= $1, ''/se);
            $rcs =~ s/\@\s*;//s;
            $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/^((?:\@\@|[^@]){1,32000})/$str .= $1, ''/se);
            $rcs =~ s/\@\s*;//s;
            $self->{'expand'}->{-value} = &_string_unquote($str);
            push(@{$self->{-order}}, 'expand');
        }
        elsif ($rcs =~ s/^([a-z]+)(?:\s*([^;]*));//s) {
            #   currently intentionally just ignored, because does not occur at all
        }
        else {
            last;
        }
    }

    #   parse delta section(s)
    while (1) {
        $rcs =~ s|^\s*||s;
        if ($rcs =~ s/^($re_rev)//s) {
            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) {
                    $rev->set('date', $1);
                }
                elsif ($rcs =~ s/^author\s+($re_id)\s*;//s) {
                    $rev->set('author', $1);
                }
                elsif ($rcs =~ s/^state(?:\s*($re_id))?\s*;//s) {
                    $rev->set('state', $1);
                }
                elsif ($rcs =~ s/^branches(?:\s+((?:\s*$re_rev)*))?\s*;//s) {
                    $rev->set('branches',
                        defined($1) ? [ map { $self->rev2num($_) } split(/\s+/, $1) ] : []);
                }
                elsif ($rcs =~ s/^next(?:\s*($re_rev))?\s*;//s) {
                    $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) {
                    #   currently intentionally just ignored, because does not occur at all
                }
                else {
                    last;
                }
            }
        }
        else {
            last;
        }
    }

    #   parse description section
    $rcs =~ s|^\s*||s;
    #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/^((?:\@\@|[^@]){1,32000})/$str .= $1, ''/se);
        $rcs =~ s/\@\s*//s;
        $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 $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/^((?:\@\@|[^@]){1,32000})/$str .= $1, ''/se);
                    $rcs =~ s/\@\s*//s;
                    $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/^((?:\@\@|[^@]){1,32000})/$str .= $1, ''/se);
                    $rcs =~ s/\@\s*//s;
                    $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
                elsif ($textseen == 0 and $rcs =~ s/^([a-z]+)(?:\s+(\@))?//s) {
                    my ($keyword, $with_str) = ($1, $2);
                    my $str = '';
                    if ($with_str) { 
                        1 while ($rcs =~ s/^((?:\@\@|[^@]){1,32000})/$str .= $1, ''/se);
                        $rcs =~ s/\@\s*//s;
                    }
                    #   currently intentionally just ignored, because does not occur at all
                }
                else {
                    last;
                }
            }
        }
        else {
            last;
        }
    }

    return;
}

#   INTERNAL: return ordered list of revisions
#   (either in branch-first or next-first traversal order)
sub _revlist ($$) {
    my ($self, $branchfirst) = @_;
    my @revs = ();
    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->num2obj($rev)->get('next');
        my $branches = $self->num2obj($rev)->get('branches');
        if ($branchfirst) {
            foreach my $branch (@{$branches}) {
                &nextrev($self, $revs, $branch, $branchfirst); 
            }
            &nextrev($self, $revs, $next, $branchfirst) if (defined($next) and $next ne '');
        }
        else {
            &nextrev($self, $revs, $next, $branchfirst) if (defined($next) and $next ne '');
            foreach my $branch (@{$branches}) {
                &nextrev($self, $revs, $branch, $branchfirst); 
            }
        }
        return;
    }
    return @revs;
}

#   INTERNAL: generate output of a value in RCS syntax and layout
sub _genvalue ($$$) {
    my ($self, $val, $tag) = @_;
    my $rcs = '';
    if (ref($val) eq 'ARRAY' and @{$val} > 0) {
        foreach my $v (@{$val}) {
            $v = $self->num2rev($v) if ($self->isrevnum($v));
            $rcs .= "\n\t$v";
        }
    }
    elsif (ref($val) eq 'HASH' and keys(%{$val}) > 0) {
        if (defined($val->{-order})) {
            foreach my $k (@{$val->{-order}}) {
                my $v = $val->{$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->num2rev($v) if ($self->isrevnum($v));
                $k = $self->num2rev($k) if ($self->isrevnum($k));
                $rcs .= sprintf("\n\t%s:%s", $k, $v);
            }
        }
    }
    elsif (not ref($val) and $val ne '') {
        if ($tag eq '@') {
            $rcs .= "\t" . &_string_quote($val);
        }
        else {
            $val = $self->num2rev($val) if ($self->isrevnum($val));
            $rcs .= "\t$val";
        }
    }
    return $rcs;
}

#   save object into RCS file
#   (see rcsfile(5) for reference)
sub save ($$) {
    my ($self, $file) = @_;

    #   format object as RCS file content
    my $rcs = $self->format();

    #   write RCS file content to RCS file
    my $io = new IO::File ">$file"
        or croak "RCS file \"$file\": cannot open for writing";
    $io->print($rcs);
    $io->close;
}

#   format object as RCS file content
sub format ($) {
    my ($self) = @_;
    my $rcs = '';

    #   define known keywords
    my @kw_header    = (qw(head branch access symbols locks- strict comment@ expand@));
    my @kw_delta     = (qw(date author state branches next));
    my @kw_desc      = (qw(desc));
    my @kw_deltatext = (qw(log text));

    #   generate header section
    foreach my $header (
        @kw_header, (grep { not grep(/^\Q$_\E$/, @kw_header) } @{$self->{-order}})
    ) {
        my $tag = '';
        $tag = $1 if ($header =~ s/([@\-])$//s);
        my $val = $self->{$header}->{-value};
        if (defined($val)) {
            $rcs .= $header . $self->_genvalue($val, $tag). ";";
            $rcs .= ($tag eq '-' ? " " : "\n");
        }
    }
    $rcs .= "\n";

    #   generate delta section(s)
    my @revlist = $self->_revlist(0);
    foreach my $rev (@revlist) {
        my $obj = $self->num2obj($rev);
        $rcs .= "\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";
        my $branches = $obj->get('branches');
        if (@{$branches} > 0) {
            foreach my $v (@{$branches}) {
                $rcs .= "\n\t". $self->num2rev($v);
            }
        }
        $rcs .= ";\n";
        my $next = $obj->get('next');
        $rcs .= "next\t" . (defined($next) and $next ne '' ? $self->num2rev($next) : "") . ";\n";
    }

    #   generate description section
    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 $obj = $self->num2obj($rev);
        $rcs .= "\n";
        $rcs .= "\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;
}

#   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 map  { $self->{-revision}->{$_} }
               grep { $_ !~ m|^-| }
               keys %{$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 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

B<RCS> -- Revision Control System (RCS) File Handling

=head1 DESCRIPTION

This is a Perl API for reading and writing RCS files (I<filename>C<,v>).
It understands the syntax as documented in rcsfile(5) of GNU RCS version
5.7. It tries hard to save RCS files in a determined internal keyword
and revision order.

=head1 METHODS

=over 4

=item C<my $rcs = >B<new>C< RCS>[C< $filename>]C<;>

=item C<$rcs-E<gt>>B<destroy>C<;>

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.

=item C<$rcs-E<gt>>B<load>C<($filename);>

=item C<$rcs-E<gt>>B<save>C<($filename);>

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

=item C<my $rcstext = $rcs-E<gt>>B<format>C<($filename);>

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<my $value = $rcs-E<gt>>B<get>C<($name);>

=item C<$rcs-E<gt>>B<set>C<($name, $value);>

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:

 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

=head1 SEE ALSO

rcsfile(5).

=head1 HISTORY

The Perl B<RCS> module was implemented in April 2004 for use in B<OSSP
cvsfusion> in order to support the fusion of two CVS repositories on the
RCS file level.

=head1 AUTHOR

Ralf S. Engelschall E<lt>rse@engelschall.comE<gt>

=cut