head	1.9;
access;
symbols;
locks; strict;
comment	@# @;


1.9
date	2004.04.24.18.25.19;	author rse;	state Exp;
branches;
next	1.8;

1.8
date	2004.04.23.21.38.48;	author rse;	state Exp;
branches;
next	1.7;

1.7
date	2004.04.23.17.58.17;	author rse;	state Exp;
branches;
next	1.6;

1.6
date	2004.04.23.15.03.27;	author rse;	state Exp;
branches;
next	1.5;

1.5
date	2004.04.23.14.57.09;	author rse;	state Exp;
branches;
next	1.4;

1.4
date	2004.04.23.13.09.50;	author rse;	state Exp;
branches;
next	1.3;

1.3
date	2004.04.23.12.21.44;	author rse;	state Exp;
branches;
next	1.2;

1.2
date	2004.04.23.09.23.38;	author rse;	state Exp;
branches;
next	1.1;

1.1
date	2004.04.22.06.56.28;	author rse;	state Exp;
branches;
next	;


desc
@@


1.9
log
@fix RCS::lookup() function and start filling the missing content of the main program
@
text
@##
##  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

@


1.8
log
@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.
@
text
@d237 1
d697 3
a699 1
        return values(%{$self->{-revision}});
@


1.7
log
@add an abstraction layer between structured revisions and sequential numbers which results in structured revisions to exist only once in the whole internal structure and this way allows us to change a structured revision throughout the whole RCS file content (including all revision references, etc) easily
@
text
@d31 62
a92 1
package RCS;
a93 1
require 5;
a95 1
use IO::File;
d97 2
a98 2
@@ISA       = qw(Exporter);
@@EXPORT_OK = qw(new destroy DESTROY dump tool load save parse format revapply trunk2branch);
d102 1
a102 1
    my ($proto, $file) = @@_;
a108 11
    #   initialize object
    $self->{'tool'} = {
        'rcs'  => 'rcs',
        'co'   => 'co',
        'diff' => 'diff',
    };
    $self->{'rcs'} = {};

    #   optionally load file into object
    $rcs->load($file) if (defined($file));

d129 1
a129 1
    $name ||= "rcs";
d143 76
a218 6
#   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";
d220 2
a221 2
    if (defined($path)) {
        $self->{'tool'}->{$tool} = $path;
d223 43
a265 1
    return $old;
d302 1
a302 1
sub _rev_rev2num ($$) {
d304 3
a306 3
    foreach my $num (keys(%{$self->{'rcs'}->{'rev'}})) {
        next if ($num eq '-count');
        return $num if ($self->{'rcs'}->{'rev'}->{$num} eq $rev);
d308 2
a309 2
    my $num = sprintf("REV-NUM(%d)", $self->{'rcs'}->{'rev'}->{-count}++);
    $self->{'rcs'}->{'rev'}->{$num} = $rev;
d314 19
a332 1
sub _rev_num2rev ($$) {
d334 1
a334 1
    return $self->{'rcs'}->{'rev'}->{$num};
d338 1
a338 1
sub _rev_isnum ($$) {
d340 1
a340 1
    return (($num =~ m|^REV-NUM\(\d+\)$| and defined($self->{'rcs'}->{'rev'}->{$num})) ? 1 : 0);
d348 5
a352 6
    #   clear RCS structure
    $self->{'rcs'} = {
        'header'    => { -order => [] },
        'delta'     => { -order => [] },
        'rev'       => { -count => 0  },
    };
d368 2
a369 2
            $self->{'rcs'}->{'header'}->{'head'} = $self->_rev_rev2num($1);
            push(@@{$self->{'rcs'}->{'header'}->{-order}}, 'head');
d372 2
a373 2
            $self->{'rcs'}->{'header'}->{'branch'} = $self->_rev_rev2num($1);
            push(@@{$self->{'rcs'}->{'header'}->{-order}}, 'branch');
d376 2
a377 3
            $self->{'rcs'}->{'header'}->{'access'} = 
                (defined($1) ? [ split(/\s+/, $1) ] : []);
            push(@@{$self->{'rcs'}->{'header'}->{-order}}, 'access');
d383 1
a383 1
                $symbols->{$1} = $self->_rev_rev2num($2);
d387 2
a388 2
            $self->{'rcs'}->{'header'}->{'symbols'} = $symbols;
            push(@@{$self->{'rcs'}->{'header'}->{-order}}, 'symbols');
d394 1
a394 1
                    $locks->{$1} = $self->_rev_rev2num($2);
d398 2
a399 2
            $self->{'rcs'}->{'header'}->{'locks'} = $locks;
            push(@@{$self->{'rcs'}->{'header'}->{-order}}, 'locks');
d402 2
a403 2
            $self->{'rcs'}->{'header'}->{'strict'} = "";
            push(@@{$self->{'rcs'}->{'header'}->{-order}}, 'strict');
d408 1
a408 1
            1 while ($rcs =~ s/^((?:\@@\@@|[^@@])+)/$str .= $1, ''/se);
d410 2
a411 2
            $self->{'rcs'}->{'header'}->{'comment'} = &_string_unquote($str);
            push(@@{$self->{'rcs'}->{'header'}->{-order}}, 'comment');
d416 1
a416 1
            1 while ($rcs =~ s/^((?:\@@\@@|[^@@])+)/$str .= $1, ''/se);
d418 2
a419 2
            $self->{'rcs'}->{'header'}->{'expand'} = &_string_unquote($str);
            push(@@{$self->{'rcs'}->{'header'}->{-order}}, 'expand');
d422 1
a422 2
            $self->{'rcs'}->{'header'}->{$1} = $2;
            push(@@{$self->{'rcs'}->{'header'}->{-order}}, $1);
d433 2
a434 3
            my $rev = $self->_rev_rev2num($1);
            $self->{'rcs'}->{'delta'}->{$rev} = {};
            push(@@{$self->{'rcs'}->{'delta'}->{-order}}, $rev);
d438 1
a438 1
                    $self->{'rcs'}->{'delta'}->{$rev}->{'date'} = $1;
d441 1
a441 1
                    $self->{'rcs'}->{'delta'}->{$rev}->{'author'} = $1;
d444 1
a444 1
                    $self->{'rcs'}->{'delta'}->{$rev}->{'state'} = $1;
d447 2
a448 2
                    $self->{'rcs'}->{'delta'}->{$rev}->{'branches'} =
                        (defined($1) and $1 ne '' ? [ map { $self->_rev_rev2num($_) } split(/\s+/, $1) ] : []);
d451 1
a451 2
                    $self->{'rcs'}->{'delta'}->{$rev}->{'next'} =
                        (defined($1) and $1 ne '' ? $self->_rev_rev2num($1) : '');
d457 1
a457 1
                    $self->{'rcs'}->{'delta'}->{$rev}->{$1} = $2;
d474 1
a474 1
        1 while ($rcs =~ s/^((?:\@@\@@|[^@@])+)/$str .= $1, ''/se);
d476 2
a477 2
        $self->{'rcs'}->{'header'}->{'desc'} = &_string_unquote($str);
        push(@@{$self->{'rcs'}->{'header'}->{-order}}, 'desc');
d484 2
a485 4
            my $rev = $self->_rev_rev2num($1);
            if (not defined($self->{'rcs'}->{'delta'}->{$rev})) {
                croak "deltatext section for unknown revision \"".$self->_rev_num2rev($rev)."\" found";
            }
d492 1
a492 1
                    1 while ($rcs =~ s/^((?:\@@\@@|[^@@])+)/$str .= $1, ''/se);
d494 1
a494 1
                    $self->{'rcs'}->{'delta'}->{$rev}->{'log'} = &_string_unquote($str);
d499 1
a499 1
                    1 while ($rcs =~ s/^((?:\@@\@@|[^@@])+)/$str .= $1, ''/se);
d501 1
a501 1
                    $self->{'rcs'}->{'delta'}->{$rev}->{'text'} = &_string_unquote($str);
d509 1
a509 1
                        1 while ($rcs =~ s/^((?:\@@\@@|[^@@])+)/$str .= $1, ''/se);
d512 1
a512 1
                    $self->{'rcs'}->{'delta'}->{$rev}->{$keyword} = $str;
d532 3
a534 1
    &nextrev($self, \@@revs, $self->{'rcs'}->{'header'}->{'head'}, $branchfirst);
d538 2
a539 2
        my $next     = $self->{'rcs'}->{'delta'}->{$rev}->{'next'};
        my $branches = $self->{'rcs'}->{'delta'}->{$rev}->{'branches'};
d563 1
a563 1
            $v = $self->_rev_num2rev($v) if ($self->_rev_isnum($v));
d571 2
a572 2
                $v = $self->_rev_num2rev($v) if ($self->_rev_isnum($v));
                $k = $self->_rev_num2rev($k) if ($self->_rev_isnum($k));
d579 2
a580 2
                $v = $self->_rev_num2rev($v) if ($self->_rev_isnum($v));
                $k = $self->_rev_num2rev($k) if ($self->_rev_isnum($k));
d590 1
a590 1
            $val = $self->_rev_num2rev($val) if ($self->_rev_isnum($val));
d625 1
a625 3
        @@kw_header,
        ( grep { not grep(/^\Q$_\E$/, @@kw_header) }
          @@{$self->{'rcs'}->{'header'}->{-order}}  )
d629 1
a629 1
        my $val = $self->{'rcs'}->{'header'}->{$header};
d640 1
a640 1
        my $delta = $self->{'rcs'}->{'delta'}->{$rev};
d642 4
a645 4
        $rcs .= $self->_rev_num2rev($rev)."\n";
        $rcs .= "date\t" . $delta->{'date'} . ";\t";
        $rcs .= "author " . $delta->{'author'} . ";\t";
        $rcs .= "state " . $delta->{'state'} . ";\n";
d647 4
a650 3
        if (@@{$delta->{'branches'}} > 0) {
            foreach my $v (@@{$delta->{'branches'}}) {
                $rcs .= "\n\t". $self->_rev_num2rev($v);
d654 2
a655 1
        $rcs .= "next\t" . (defined($delta->{'next'}) ? $self->_rev_num2rev($delta->{'next'}) : "") . ";\n";
d659 1
a659 1
    my $desc = $self->{'rcs'}->{'header'}->{'desc'};
d665 1
a665 1
        my $delta = $self->{'rcs'}->{'delta'}->{$rev};
d668 5
a672 3
        $rcs .= $self->_rev_num2rev($rev)."\n";
        $rcs .= "log\n" . &_string_quote($delta->{'log'}) . "\n";
        $rcs .= "text\n" . &_string_quote($delta->{'text'}) . "\n";
d678 69
a746 6
#   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});
d748 1
a748 1
    return;
d755 6
d780 28
a807 2
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.
d809 16
a824 1
=item C<$rcs-E<gt>>B<destroy>C<;>
d826 1
a826 1
=item C<undef $rcs;>
d828 1
a828 1
This destroys the RCS object.
d830 5
a834 1
=item [C<my $old_path = >]C<$rcs-E<gt>>B<tool>C<(">I<tool>C<", $path);>
d836 1
a836 1
=item C<my $path = $rcs-E<gt>>B<tool>C<(">I<tool>C<");>
d838 1
a838 2
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.
d840 2
a841 1
=item C<$rcs-E<gt>>B<parse>C<($filename, $rcstext);>
d843 1
a843 2
This parses the RCS file content in C<$rcstext> and
and stores the result in RCS object C<$rcs>.
d845 1
a845 1
=item C<my $rcstext = $rcs-E<gt>>B<format>C<($filename);>
d847 1
a847 1
This formats and returns the RCS file content in C<$rcs>.
d849 1
a849 1
=item C<$rcs-E<gt>>B<load>C<($filename);>
d851 1
a851 1
This loads the RCS file under C<$filename> into RCS object C<$rcs>.
d853 2
a854 1
=item C<$rcs-E<gt>>B<save>C<($filename);>
d856 8
a863 1
This saves the RCS file content from RCS object C<$rcs> under C<$filename>.
@


1.6
log
@fix exporting of API
@
text
@d39 1
a39 1
@@EXPORT_OK = qw(new destroy DESTROY dump tool load save parse format);
d141 24
d174 1
d180 2
a181 2
    my $re_special = qr/[$,.:;@@]/;
    my $re_idchar  = qr/[^$,.:;@@]/;
d191 1
a191 1
            $self->{'rcs'}->{'header'}->{'head'} = $1;
d195 1
a195 1
            $self->{'rcs'}->{'header'}->{'branch'} = $1;
d199 2
a200 1
            $self->{'rcs'}->{'header'}->{'access'} = [ split(/\s+/, $1) ];
d205 3
a207 2
            map { if (m/^(.+):(.+)$/s) {
                $symbols->{$1} = $2;
d209 2
a210 1
            } } split(/\s+/, $1);
d216 6
a221 4
            map { if (m/^(.+):(.+)$/s) {
                $locks->{$1} = $2;
                push(@@{$locks->{-order}}, $1);
            } } split(/\s+/, $1);
d258 1
a258 1
            my $rev = $1;
d273 2
a274 1
                    $self->{'rcs'}->{'delta'}->{$rev}->{'branches'} = [ split(/\s+/, $1) ];
d277 2
a278 1
                    $self->{'rcs'}->{'delta'}->{$rev}->{'next'} = $1;
d311 1
a311 1
            my $rev = $1;
d313 1
a313 1
                croak "deltatext section for unknown revision \"$rev\" found";
d361 3
a363 3
    &nextrev(\@@revs, $self->{'rcs'}->{'header'}->{'head'}, $branchfirst);
    sub nextrev ($$$) {
        my ($revs, $rev, $branchfirst) = @@_;
d369 1
a369 1
                &nextrev($revs, $branch, $branchfirst); 
d371 1
a371 1
            &nextrev($revs, $next, $branchfirst) if (defined($next) and $next ne '');
d374 1
a374 1
            &nextrev($revs, $next, $branchfirst) if (defined($next) and $next ne '');
d376 1
a376 1
                &nextrev($revs, $branch, $branchfirst); 
d385 2
a386 2
sub _genvalue ($$) {
    my ($val, $tag) = @@_;
d390 1
d396 5
a400 2
            foreach my $v (@@{$val->{-order}}) {
                $rcs .= sprintf("\n\t%s:%s", $v, $val->{$v});
d404 5
a408 2
            foreach my $v (keys(%{$val})) {
                $rcs .= sprintf("\n\t%s:%s", $v, $val->{$v});
d417 1
d460 1
a460 1
            $rcs .= $header . &_genvalue($val, $tag). ";";
d467 1
a467 1
    my @@revlist = &_revlist($self, 0);
d471 1
a471 1
        $rcs .= $rev."\n";
d478 1
a478 1
                $rcs .= "\n\t$v";
d482 1
a482 1
        $rcs .= "next\t" . $delta->{'next'} . ";\n";
d490 1
a490 1
    @@revlist = &_revlist($self, 1);
d495 1
a495 1
        $rcs .= $rev."\n";
d502 12
@


1.5
log
@bugfix parsing and formatting so it now passed representative ,v files from FreeBSD, OSSP, OpenPKG and OpenSSL CVS repositories
@
text
@d39 1
a39 1
@@EXPORT_OK = qw(new destroy DESTROY dump);
@


1.4
log
@complete code cleanups and documentation
@
text
@d159 2
a160 2
    my $re_str     = qr/(?:@@@@|[^@@])*/;
    my $re_date    = qr/\d{4}\.\d{2}\.\d{2}\.\d{2}\.\d{2}\.\d{2}/;
d199 6
a204 2
        elsif ($rcs =~ s/^comment\s+\@@($re_str)\@@\s*;//s) {
            $self->{'rcs'}->{'header'}->{'comment'} = &_string_unquote($1);
d207 6
a212 2
        elsif ($rcs =~ s/^expand\s+\@@($re_str)\@@\s*;//s) {
            $self->{'rcs'}->{'header'}->{'expand'} = &_string_unquote($1);
d215 1
a215 1
        elsif ($rcs =~ s/^([a-z]+)(\s*[^;]*);//s) {
d251 1
a251 1
                elsif ($rcs =~ s/^([a-z]+)(\s*[^;]*);//s) {
d266 6
a271 2
    if ($rcs =~ s/^desc\s+\@@($re_str)\@@\s*//s) {
        $self->{'rcs'}->{'header'}->{'desc'} = $1;
d286 13
a298 5
                if ($rcs =~ s/^log\s+\@@($re_str)\@@\s*//s) {
                    $self->{'rcs'}->{'delta'}->{$rev}->{'log'} = &_string_unquote($1);
                }
                elsif ($rcs =~ s/^text\s+\@@($re_str)\@@\s*//s) {
                    $self->{'rcs'}->{'delta'}->{$rev}->{'text'} = &_string_unquote($1);
d301 9
a309 2
                elsif ($textseen == 0 and $rcs =~ s/^([a-z]+)(\s*[^;]*);//s) {
                    $self->{'rcs'}->{'delta'}->{$rev}->{$1} = $2;
@


1.3
log
@first cut of mostly complete loading and saving functionality
@
text
@d41 5
a45 2
sub new ($) {
    my $proto = shift;
d50 1
d58 4
d65 1
d67 1
a67 1
    my $self = shift;
d71 1
d73 1
a73 1
    my $self = shift;
d78 1
d80 2
a81 2
    my $self = shift;
    my $name = shift || "xxx";
d95 1
d97 1
a97 2
    my $self = shift;
    my ($tool, $path) = @@_;
d108 1
a108 1
#  quote/unquote a RCS string
d115 2
d124 1
d126 1
a126 2
    my $self = shift;
    my ($file) = @@_;
d135 11
d293 1
d297 62
d360 15
a374 2
    my $self = shift;
    my ($file) = @@_;
d393 1
a393 33
            $rcs .= $header;
            if (ref($val) eq 'ARRAY') {
                if (@@{$val} > 0) {
                    foreach my $v (@@{$val}) {
                        $rcs .= "\n\t$v";
                    }
                }
            }
            elsif (ref($val) eq 'HASH') {
                if (keys(%{$val}) > 0) {
                    if (defined($val->{-order})) {
                        foreach my $v (@@{$val->{-order}}) {
                            $rcs .= sprintf("\n\t%s:%s", $v, $val->{$v});
                        }
                    }
                    else {
                        foreach my $v (keys(%{$val})) {
                            $rcs .= sprintf("\n\t%s:%s", $v, $val->{$v});
                        }
                    }
                }
            }
            else {
                if ($val ne '') {
                    if ($tag eq '@@') {
                        $rcs .= "\t" . &_string_quote($val);
                    }
                    else {
                        $rcs .= "\t$val";
                    }
                }
            }
            $rcs .= ";";
d400 1
a400 30
    sub revlist ($$) {
        my ($self, $branchfirst) = @@_;
        my @@revs = ();
        &nextrev(\@@revs, $self->{'rcs'}->{'header'}->{'head'}, $branchfirst);
        sub nextrev ($$$) {
            my ($revs, $rev, $branchfirst) = @@_;
            push(@@{$revs}, $rev);
            my $next     = $self->{'rcs'}->{'delta'}->{$rev}->{'next'};
            my $branches = $self->{'rcs'}->{'delta'}->{$rev}->{'branches'};
            if ($branchfirst) {
                foreach my $branch (@@{$branches}) {
                    &nextrev($revs, $branch, $branchfirst);
                }
                if (defined($next) and $next ne '') {
                    &nextrev($revs, $next, $branchfirst);
                }
            }
            else {
                if (defined($next) and $next ne '') {
                    &nextrev($revs, $next, $branchfirst);
                }
                foreach my $branch (@@{$branches}) {
                    &nextrev($revs, $branch, $branchfirst);
                }
            }
            return;
        }
        return @@revs;
    }
    my @@revlist = &revlist($self, 0);
d423 1
a423 1
    @@revlist = &revlist($self, 1);
d433 1
a433 7
    #   write new RCS file for disk
    my $io = new IO::File ">$file"
        or croak "RCS file \"$file\": cannot open for writing";
    $io->print($rcs);
    $io->close;

    return;
d446 59
a504 1
...FIXME...
@


1.2
log
@flush work of yesterday afternoon
@
text
@d97 14
d154 5
a158 2
            my $symbols = {};
            map { $symbols->{$1} = $2 if (m/^(.+):(.+)$/s); } split(/\s+/, $1);
d163 5
a167 2
            my $locks = {};
            map { $locks->{$1} = $2 if (m/^(.+):(.+)$/); } split(/\s+/, $1);
d176 1
a176 1
            $self->{'rcs'}->{'header'}->{'comment'} = $1;
d180 1
a180 1
            $self->{'rcs'}->{'header'}->{'expand'} = $1;
d251 1
a251 1
                    $self->{'rcs'}->{'delta'}->{$rev}->{'log'} = $1;
d254 1
a254 1
                    $self->{'rcs'}->{'delta'}->{$rev}->{'text'} = $1;
d284 5
a288 1
    foreach my $header (@@kw_header) {
d303 9
a311 2
                    foreach my $v (keys(%{$val})) {
                        $rcs .= sprintf("\n\t%s:%s", $v, $val->{$v});
d318 1
a318 2
                        $val =~ s|\@@|\@@\@@|sg;
                        $rcs .= "\t\@@$val\@@";
d332 54
a385 1
    foreach my $rev (@@{$self->{'rcs'}->{'delta'}->{-order}}) {
d387 2
d390 2
@


1.1
log
@start OSSP cvsfusion
@
text
@d35 2
d47 6
a52 2
    $self->{'prog-rcs'}  = "";
    $self->{'prog-diff'} = "";
d82 232
@