Index: ossp-pkg/cvsfusion/RCS.pm
RCS File: /v/ossp/cvs/ossp-pkg/cvsfusion/RCS.pm,v
rcsdiff -q -kk '-r1.1' '-r1.2' -u '/v/ossp/cvs/ossp-pkg/cvsfusion/RCS.pm,v' 2>/dev/null
--- RCS.pm	2004/04/22 06:56:28	1.1
+++ RCS.pm	2004/04/23 09:23:38	1.2
@@ -32,6 +32,8 @@
 
 require 5;
 require Exporter;
+use Carp;
+use IO::File;
 
 @ISA       = qw(Exporter);
 @EXPORT_OK = qw(new destroy DESTROY dump);
@@ -42,8 +44,12 @@
     my $self = {};
     bless ($self, $class);
 
-    $self->{'prog-rcs'}  = "";
-    $self->{'prog-diff'} = "";
+    $self->{'tool'} = {
+        'rcs'  => 'rcs',
+        'co'   => 'co',
+        'diff' => 'diff',
+    };
+    $self->{'rcs'} = {};
 
     return $self;
 }
@@ -75,6 +81,238 @@
     return $dump;
 }
 
+sub tool ($;$) {
+    my $self = shift;
+    my ($tool, $path) = @_;
+    my $old = $self->{'tool'}->{$tool};
+    if (not defined($old)) {
+        croak "tool \"$tool\" not known";
+    }
+    if (defined($path)) {
+        $self->{'tool'}->{$tool} = $path;
+    }
+    return $old;
+}
+
+sub load ($$) {
+    my $self = shift;
+    my ($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;
+
+    #   clear RCS structure
+    $self->{'rcs'} = {
+        'header'    => { -order => [] },
+        'delta'     => { -order => [] },
+    };
+
+    #   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/(?:@@|[^@])*/;
+    my $re_date    = qr/\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->{'rcs'}->{'header'}->{'head'} = $1;
+            push(@{$self->{'rcs'}->{'header'}->{-order}}, 'head');
+        }
+        elsif ($rcs =~ s/^branch\s+($re_rev)\s*;//s) {
+            $self->{'rcs'}->{'header'}->{'branch'} = $1;
+            push(@{$self->{'rcs'}->{'header'}->{-order}}, 'branch');
+        }
+        elsif ($rcs =~ s/^access((?:\s+$re_id)*)\s*;//s) {
+            $self->{'rcs'}->{'header'}->{'access'} = [ split(/\s+/, $1) ];
+            push(@{$self->{'rcs'}->{'header'}->{-order}}, 'access');
+        }
+        elsif ($rcs =~ s/^symbols((?:\s+$re_sym:$re_rev)*)\s*;//s) {
+            my $symbols = {};
+            map { $symbols->{$1} = $2 if (m/^(.+):(.+)$/s); } split(/\s+/, $1);
+            $self->{'rcs'}->{'header'}->{'symbols'} = $symbols;
+            push(@{$self->{'rcs'}->{'header'}->{-order}}, 'symbols');
+        }
+        elsif ($rcs =~ s/^locks((?:\s+$re_id:$re_rev)*)\s*;//s) {
+            my $locks = {};
+            map { $locks->{$1} = $2 if (m/^(.+):(.+)$/); } split(/\s+/, $1);
+            $self->{'rcs'}->{'header'}->{'locks'} = $locks;
+            push(@{$self->{'rcs'}->{'header'}->{-order}}, 'locks');
+        }
+        elsif ($rcs =~ s/^strict\s*;//s) {
+            $self->{'rcs'}->{'header'}->{'strict'} = "";
+            push(@{$self->{'rcs'}->{'header'}->{-order}}, 'strict');
+        }
+        elsif ($rcs =~ s/^comment\s+\@($re_str)\@\s*;//s) {
+            $self->{'rcs'}->{'header'}->{'comment'} = $1;
+            push(@{$self->{'rcs'}->{'header'}->{-order}}, 'comment');
+        }
+        elsif ($rcs =~ s/^expand\s+\@($re_str)\@\s*;//s) {
+            $self->{'rcs'}->{'header'}->{'expand'} = $1;
+            push(@{$self->{'rcs'}->{'header'}->{-order}}, 'expand');
+        }
+        elsif ($rcs =~ s/^([a-z]+)(\s*[^;]*);//s) {
+            $self->{'rcs'}->{'header'}->{$1} = $2;
+            push(@{$self->{'rcs'}->{'header'}->{-order}}, $1);
+        }
+        else {
+            last;
+        }
+    }
+
+    #   parse delta section(s)
+    while (1) {
+        $rcs =~ s|^\s*||s;
+        if ($rcs =~ s/^($re_rev)//s) {
+            my $rev = $1;
+            $self->{'rcs'}->{'delta'}->{$rev} = {};
+            push(@{$self->{'rcs'}->{'delta'}->{-order}}, $rev);
+            while (1) {
+                $rcs =~ s|^\s*||s;
+                if ($rcs =~ s/^date\s+($re_date)\s*;//s) {
+                    $self->{'rcs'}->{'delta'}->{$rev}->{'date'} = $1;
+                }
+                elsif ($rcs =~ s/^author\s+($re_id)\s*;//s) {
+                    $self->{'rcs'}->{'delta'}->{$rev}->{'author'} = $1;
+                }
+                elsif ($rcs =~ s/^state(?:\s*($re_id))?\s*;//s) {
+                    $self->{'rcs'}->{'delta'}->{$rev}->{'state'} = $1;
+                }
+                elsif ($rcs =~ s/^branches(?:\s+((?:\s*$re_rev)*))?\s*;//s) {
+                    $self->{'rcs'}->{'delta'}->{$rev}->{'branches'} = [ split(/\s+/, $1) ];
+                }
+                elsif ($rcs =~ s/^next(?:\s*($re_rev))?\s*;//s) {
+                    $self->{'rcs'}->{'delta'}->{$rev}->{'next'} = $1;
+                }
+                elsif ($rcs =~ m/^desc\s+/s) {
+                    last;
+                }
+                elsif ($rcs =~ s/^([a-z]+)(\s*[^;]*);//s) {
+                    $self->{'rcs'}->{'delta'}->{$rev}->{$1} = $2;
+                }
+                else {
+                    last;
+                }
+            }
+        }
+        else {
+            last;
+        }
+    }
+
+    #   parse description section
+    $rcs =~ s|^\s*||s;
+    if ($rcs =~ s/^desc\s+\@($re_str)\@\s*//s) {
+        $self->{'rcs'}->{'header'}->{'desc'} = $1;
+        push(@{$self->{'rcs'}->{'header'}->{-order}}, 'desc');
+    }
+
+    #  parse deltatext section(s)
+    while (1) {
+        $rcs =~ s|^\s*||s;
+        if ($rcs =~ s/^($re_rev)//s) {
+            my $rev = $1;
+            if (not defined($self->{'rcs'}->{'delta'}->{$rev})) {
+                croak "deltatext section for unknown revision \"$rev\" found";
+            }
+            my $textseen = 0;
+            while (1) {
+                $rcs =~ s|^\s*||s;
+                if ($rcs =~ s/^log\s+\@($re_str)\@\s*//s) {
+                    $self->{'rcs'}->{'delta'}->{$rev}->{'log'} = $1;
+                }
+                elsif ($rcs =~ s/^text\s+\@($re_str)\@\s*//s) {
+                    $self->{'rcs'}->{'delta'}->{$rev}->{'text'} = $1;
+                    $textseen = 1;
+                }
+                elsif ($textseen == 0 and $rcs =~ s/^([a-z]+)(\s*[^;]*);//s) {
+                    $self->{'rcs'}->{'delta'}->{$rev}->{$1} = $2;
+                }
+                else {
+                    last;
+                }
+            }
+        }
+        else {
+            last;
+        }
+    }
+    return;
+}
+
+sub save ($$) {
+    my $self = shift;
+    my ($file) = @_;
+    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) {
+        my $tag = '';
+        $tag = $1 if ($header =~ s/([@\-])$//s);
+        my $val = $self->{'rcs'}->{'header'}->{$header};
+        if (defined($val)) {
+            $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) {
+                    foreach my $v (keys(%{$val})) {
+                        $rcs .= sprintf("\n\t%s:%s", $v, $val->{$v});
+                    }
+                }
+            }
+            else {
+                if ($val ne '') {
+                    if ($tag eq '@') {
+                        $val =~ s|\@|\@\@|sg;
+                        $rcs .= "\t\@$val\@";
+                    }
+                    else {
+                        $rcs .= "\t$val";
+                    }
+                }
+            }
+            $rcs .= ";";
+            $rcs .= ($tag eq '-' ? " " : "\n");
+        }
+    }
+    $rcs .= "\n";
+
+    #   generate delta section(s)
+    foreach my $rev (@{$self->{'rcs'}->{'delta'}->{-order}}) {
+        my $delta = $self->{'rcs'}->{'delta'}->{$rev};
+        $rcs .= $rev."\n";
+    }
+
+    #   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;
+}
+
 __END__
 
 =pod
Index: ossp-pkg/cvsfusion/cvsfusion.pl
RCS File: /v/ossp/cvs/ossp-pkg/cvsfusion/cvsfusion.pl,v
rcsdiff -q -kk '-r1.1' '-r1.2' -u '/v/ossp/cvs/ossp-pkg/cvsfusion/cvsfusion.pl,v' 2>/dev/null
--- cvsfusion.pl	2004/04/22 06:56:28	1.1
+++ cvsfusion.pl	2004/04/23 09:23:38	1.2
@@ -1,6 +1,4 @@
-#!/bin/sh -- # -*- perl -*- -p
-eval 'exec perl -wS $0 ${1+"$@"}'
-    if $running_under_some_shell;
+#!/usr/opkg/bin/perl
 ##
 ##  OSSP cvsfusion - CVS Repository Fusion
 ##  Copyright (c) 2004 Ralf S. Engelschall <rse@engelschall.com>
@@ -120,6 +118,16 @@
     print STDERR $prog->{'name'}.":ERROR: $msg\n";
 }
 
+##  TEST
+
+my $rcs = new RCS;
+$rcs->tool("rcs",  "/usr/bin/rcs");
+$rcs->tool("co",   "/usr/bin/co");
+$rcs->tool("diff", "/usr/opkg/bin/diff");
+$rcs->load("bash.spec,v");
+$rcs->save("bash.spec,v.new");
+undef $rcs;
+
 __END__
 
 =pod