Subs.pm #1

#*******************************************************************************
#* Pure perl implementations of the stuff that really we want to do in C. 
#* These functions only exist to make sure that people without a C compiler
#* can still use this module albeit at a greatly reduced speed.
#*******************************************************************************

package P4::JournalRec;

#*******************************************************************************
# Return the fields of the record as a cooked array. All '@'
# encoding is removed.
#*******************************************************************************
sub  Fields()
{
    my $self = shift;

    if ( defined ( $self->{'fields'} ) )
    {
        return @{$self->{'fields'}};
    }

    # Otherwise, work it out.

    my $rec = $self->{'record'};

    my @infields = split(/ /, $rec);
    my @outfields;
    # Now need to rejoin some of the fields which contained embedded spaces
    while (@infields) {
	my $buf = shift( @infields );
	if ( $buf =~ /^[0-9a-fA-F]+$/ )
	{
	    # Numeric field.
	    push(@outfields, $buf);
	}
        elsif ( $buf =~ /^\@\@$/ ) {
            # It's an empty string
            push(@outfields, "");
        }
        elsif ( $buf =~ /^\@([^\@]|\@\@)+\@$/ ) {
            # The field is properly terminated
            $buf =~ s/^\@((?:[^\@]|\@\@)+)\@$/$1/;
            $buf =~ s/\@\@/\@/g;
            push(@outfields, $buf);
        }
        elsif ( $buf =~ /^\@([^@]|\@\@)*$/ ) 
	{
            # Has been split too early and is not terminated.
	    my $t;
	    while( 1 )
	    {
		croak("Premature end of data!") if ( ! scalar( @infields ) );
		$t = shift( @infields );
		$buf .= " $t";
		last if ( $t =~ /^([^\@]|\@\@)*\@$/ );
	    }
            $buf =~ s/^\@//;
            $buf =~ s/\@$//;
            $buf =~ s/\@\@/\@/g;
            push(@outfields, $buf);
        }
        else {
            push(@outfields, $buf);
        }
    }
    $self->{'fields'} = [ @outfields ];
    @outfields;
}

#*******************************************************************************
# Set the record based on an array
#*******************************************************************************
sub Set( \@ )
{
	my $self = shift;
	my $rec = "";

	$self->{'fields'} = undef;
	foreach my $field( @_ )
	{
	    if ( $field =~ /^\-?[0-9]+$/ )
	    {
		# Nothing
	    }
	    elsif ( $field =~ /^([0-9A-F][0-9A-F])+$/ )
	    {
		# Nothing
	    }
	    else
	    {
		$field =~ s/\@/\@\@/g;
		$field =~ s/^((?:.|\n)*)$/\@$1\@/;
	    }
	    $rec .= "$field ";
	}
	$self->{'record'} = $rec;
}

package P4::Journal;

#******************************************************************************
# Function to determine whether or not the journal record we have is
# complete, or whether it ends in the middle of a multi-line field. 
#******************************************************************************
sub CompleteRecord( $$ )
{ 
    my $self = shift;
    my $rec = shift;

    my $instr = 0;
    my @fields = split( " ", $rec );
    foreach my $field ( @fields )
    {
	if ( $instr == 0 )
	{
	    $instr = 1 if ( $field =~ /^\@([^\@]|\@\@)*$/ );
	}
	else
	{
	    $instr = 0 if ( $field =~ /^([^\@]|\@\@)*\@$/ );
	}
    }
    return ! $instr;
}

1;