#!/usr/local/bin/perl
# $Id: rlog.pm,v 1.2 1999/03/07 10:45:55 stephensk Exp $

package ion::_cvs;

########################################################

$debug = 0;
$testing = 0;

########################################################

$RLOG = $ENV{RLOG} if ( ! defined $RLOG );
$RLOG = 'rlog' if ( ! defined $RLOG );

sub END {
    unlink($tmp) if ( defined $tmp );
}

sub rlog {
    my($vfile, $opts) = @_;
    my($obj) = {};
    #my($debug) = 3;

    $opts = {} if ( ! defined $opts );
    $opts->{RLOG} = $RLOG if ( ! defined $opts->{RLOG} );
    
    $obj->{vfile} = $vfile;
    $obj->{revisions} = [];
    $obj->{revision} = {};
    $obj->{symbolic_names} = [];
    $obj->{sym_name_to_rev} = {};
    $obj->{rev_to_sym_names} = {};
    $obj->{filter} = $opts->{filter};

############################################
# Run rlog into temp file

    my($in) = "rlog" . abs($$) . ".tmp";
    $tmp = $in;
    
    my($cmd) = qq($opts->{RLOG} $obj->{filter} $obj->{vfile} > $in);
    print STDERR "$cmd\n" if ( $debug > 0 );
    if ( system($cmd) ) {
	unlink($in);
	return undef;
    }

############################################
# Slurp in the whole file

    open($in, "<$in") || die "$cmd: $!";
    my(@lines);
    my($line);
    my($lineno) = 0;
    while ( defined ($line = <$in>) ) {
	chomp $line;
	print "$vfile: $line\n" if ( $debug > 2 );
	push(@lines, $line); 
    }
    close($in);
    unlink($tmp); undef $tmp;
    exit if ( $debug > 3 );

############################################
# Begin scan

    $lineno = 0;
    if ( defined($line = shift @lines) ) { $lineno ++; }
	    
############################################
# Scan header

    while ( defined $line && ($line !~ /^(-+|=+)$/) ) {
	if ( $line =~ /^([^:]+):\s*(.*)$/ ) {
	    my($key, $value) = ($1, $2);
	    if ( $key eq 'symbolic names' ) {

############################################
# Scan symbolic names

		print STDERR "Found symbolic names: $lineno:$line\n" if ( $debug > 1 );
		if ( defined($line = shift @lines) ) { $lineno ++; } 
		while ( defined $line && ($line =~ /^\s/) ) {
		    print STDERR "Try sym_name: $lineno:$line\n" if ( $debug > 2 );
		    if ( $line =~ /^\s+([^\s:]+)\s*:\s*([\.0-9]+)/ ) {
			print STDERR "Matched sym_name '$1' '$2': $lineno:$line\n" if ( $debug > 1 );
			push(@{$obj->{symbolic_names}}, $1);
			
			$obj->{sym_name_to_rev}->{$1} = $2;
			
			my($a);
			$a = $obj->{rev_to_sym_names}->{$2};
			$a = $obj->{rev_to_sym_names}->{$2} = [] if ( ! defined $a );
			push(@{$a}, $1);
		    }
		    if ( defined($line = shift @lines) ) { $lineno ++; } 
		}
	    } else {
		$key =~ tr/a-zA-Z0-9_/_/c;
		$value =~ s/\s+$//;
		print STDERR "Found key='$key' value='$value': $lineno:$line\n" if ( $debug > 2 );
		$value = [ split(/\s+/, $value) ];
		$obj->{$key} = $value;
		if ( defined($line = shift @lines) ) { $lineno ++; } 
	    }
	} else {
	    if ( defined($line = shift @lines) ) { $lineno ++; } 
	}
    }
    if ( defined($line = shift @lines) ) { $lineno ++; } 

    while ( defined $line && $line !~ /^=+$/ ) {
	my($v) = {};
		
############################################
# Scan 'revision:'

	print STDERR "Try revision: $lineno:$line\n" if ( $debug > 2);		
	if ( $line =~ s/^revision[ :]// ) {
	    $line =~ s/\s+;?\s*$//;

	    $v->{revision} = $line;

	    push(@{$obj->{revisions}}, $line);
	    $obj->{revision}->{$line} = $v;

	    $v->{symbolic_names} = $obj->{rev_to_sym_names}->{$line} || [];

	    if ( defined($line = shift @lines) ) { $lineno ++; } 
	    print STDERR "Matched revision '$v->{revision}': $lineno:$line\n" if ( $debug > 1 );
	}

	print STDERR "After revision '$v->{revision}': $lineno:$line\n" if ( $debug > 1 );
	while ( $line =~ /^\s*$/ ) {
	    print STDERR "Eat blank line: $lineno:$line\n" if ( $debug > 1 );
	    if ( defined($line = shift @lines) ) { $lineno ++; } 
	}

############################################
# Scan '<key>: <value>;'

        KEY1: while ( defined $line && $line ne '' ) {
	    $line =~ s/^\s+//;
	    if ( $line =~ s/^([a-zA-Z_]+)\s*:\s*([^;]+)(;|$)// ) {
		print STDERR "Matched key '$1' '$2': $lineno:$line\n" if ( $debug > 1 );
		$v->{$1} = $2;
	    } else {
		last KEY1;
	    }
	}

	if ( defined($line = shift @lines) ) { $lineno ++; } 

############################################
# Scan 'branches: '

	if ( $line =~ s/^branches:\s*// ) {
	    $line =~ s/\s+$//;
	    $v->{branches} = [ split(/\s/, $line) ];
	  
	    print STDERR "Matched branches: '$1': $lineno:$line\n" if ( $debug > 1 );
	    if ( defined($line = shift @lines) ) { $lineno ++; } 
	}

############################################
# Scan comment
        $v->{comment} = '';
	while ( defined $line && ($line !~ /^(-+|=+)$/) ) {
	    $line =~ s/^\s+//;
	    $line =~ s/\s+$//;
	    if ( $line ne '' && $line !~ m@^\s*\*\*\* empty log message \*\*\*\s*$@ ) {
		$v->{comment} .= $line . "\n";
		print STDERR "Comment: $line\n" if ( $debug > 1  );
	    }
	    if ( defined($line = shift @lines) ) { $lineno ++; } 
	}

	if ( defined($line = shift @lines) ) { $lineno ++; } 
    }

    $obj;
}

1;
