#Copyright Massachusetts Institute of technology, 1998.
#Written by Eric Prud'hommeaux for the World Wide Web Consortium

# $Id: DBStreamHandle.pm,v 1.23 2004/06/12 05:54:29 eric Exp $

use strict;
require Exporter;
require AutoLoader;

$W3C::XML::::REVISION = '$Id: DBStreamHandle.pm,v 1.23 2004/06/12 05:54:29 eric Exp $ ';

package W3C::Database::DBStreamHandle;
use vars qw($VERSION $DSLI @ISA @EXPORT @EXPORT_OK @TODO);
@ISA = qw(Exporter AutoLoader);
@EXPORT = qw();
@EXPORT_OK = qw();
$VERSION = 0.98;
$DSLI = 'adpO';
@TODO = ();

# close dispositions
*W3C::DBStreamHandle::DONE_OK = \0;

# access modes
*W3C::DBStreamHandle::READ_ONLY = \1;
*W3C::DBStreamHandle::WRITE_ONLY = \2;
*W3C::DBStreamHandle::READ_WRITE = \3;
*W3C::DBStreamHandle::CREATE = \4;

# diff and patch operators: P=position sensitive, I=position insensitive
my ($PADD, $PDEL, $IADD, $IDEL) = ('>', '<', '}', '{');

sub new {
    my $proto = shift;
    my $class = ref($proto) || $proto;
    my ($sink, $access) = (shift, shift);
    my $self  = {};
    bless ($self, $class);
    $self->{DB} = undef;
    ($self->{SINK}, $self->{ACCESS}) = ($sink, $access);
    return $self;
}

sub put {
    my ($self, @values) = @_;
    die "W3C::Database::DBStreamHandle::put is not overloaded";
}

sub forEach {
    my ($self) = @_;
    die "W3C::Database::DBStreamHandle::forEach is not overloaded";
}

sub setDiffHandle {
    my ($self, $handle) = @_;
    die "W3C::Database::DBStreamHandle::setDiffHandle is not overloaded";
}

sub close {
    my ($self, $disposition) = @_;
    return $self->{SINK} ? $self->{SINK}->close($disposition) : $disposition;
}

package W3C::Database::DelimStreamHandle;
@W3C::Database::DelimStreamHandle::ISA = ('W3C::Database::DBStreamHandle');
sub new {
    my $proto = shift;
    my $class = ref($proto) || $proto;
    my ($delim, $strict) = (shift, shift);
    my $self  = $class->SUPER::new(@_);
    bless ($self, $class);
    ($self->{DELIM}, $self->{STRICT}) = ($delim, $strict);
    return $self;
}

sub encode {
    my ($self, @values) = @_;
    my $delim = $self->{DELIM};
    my $ret;
    if (ref $delim eq 'CODE') {
	@_ = @values;
	$ret = &$delim;
    } else {
	if ($self->{STRICT}) {
	    map {s/\Q$delim\E/\Q$delim\E\Q$delim\E/g;} @values;
	}
	$ret = join($self->{DELIM}, @values);
    }
    return $ret;
}

sub decode {
    my ($self, $str) = @_;
    #print "str: '$str'\n";
    my $delim = $self->{DELIM};
    my @values;
    if (ref $delim eq 'CODE') {
	$_ = $str;
	@values = &$delim;
    } else {
	my $unique;
	if ($self->{STRICT}) {
	    do {
		$unique = rand();
	    } while ($str =~ m/$unique/);
	    $str =~ s/\Q$delim\E\Q$delim\E/$unique/g;
	}
	@values = split(/\Q$delim\E/, $str);
	if ($self->{STRICT}) {
	    map {s/$unique/$delim/g} @values;
	}
    }
    #print join(':', @values);
    return (@values);
}

package W3C::Database::CopyHandle;
@W3C::Database::CopyHandle::ISA = ('W3C::Database::DBStreamHandle');
sub new {
    my $proto = shift;
    my $class = ref($proto) || $proto;
    my $self  = $class->SUPER::new(@_);
    bless ($self, $class);
    return $self;
}

sub put {
    my ($self, @values) = @_;
    $self->{SINK}->put(@values);
}

sub setDiffHandle {
    my ($self, $handle);
    die "This op does not take three parameters - you may want op=diff or op=patch.";
}

package W3C::Database::JoinHandle;
@W3C::Database::JoinHandle::ISA = ('W3C::Database::DBStreamHandle');
sub new {
    my $proto = shift;
    my $class = ref($proto) || $proto;
    my $self  = $class->SUPER::new(@_);
    bless ($self, $class);
    $self->{DATA} = {};
    return $self;
}

sub put {
    my ($self, @values) = @_;
    # add to array for values[0]
    push(@{$self->{DATA}{$values[0]}}, @values[1..$#values]);
}

sub close {
    my ($self, $disposition) = @_;
    if ($disposition == $W3C::DBStreamHandle::DONE_OK) {
	map {
	    $self->{SINK}->put($_, @{$self->{DATA}{$_}});
	} keys %{$self->{DATA}};
    }
    return $self->{SINK}->close($disposition);
}

sub setDiffHandle {
    my ($self, $handle);
    die "This op does not take three parameters - you may want op=diff or op=patch.";
}

package W3C::Database::SplitHandle;
@W3C::Database::SplitHandle::ISA = ('W3C::Database::DBStreamHandle');
sub new {
    my $proto = shift;
    my $class = ref($proto) || $proto;
    my $self  = $class->SUPER::new(@_);
    bless ($self, $class);
    return $self;
}

sub put {
    my ($self, @values) = @_;
    # split out values[0..n] to n-1 pairs of values[0], values[i] where i=1 to n-1
    map {
	$self->{SINK}->put($values[0], $_);
    } @values[1..$#values];
}

sub setDiffHandle {
    my ($self, $handle);
    die "This op does not take three parameters - you may want op=diff or op=patch.";
}

package W3C::Database::DiffHandle;
@W3C::Database::DiffHandle::ISA = ('W3C::Database::DBStreamHandle');
*W3C::Database::DiffHandle::READING = \1;
*W3C::Database::DiffHandle::DIFFING = \2;
sub new {
    my $proto = shift;
    my $class = ref($proto) || $proto;
    my ($positionSensitive) = (shift);
    my $self  = $class->SUPER::new(@_);
    bless ($self, $class);
    $self->{POSITION_SENSITIVE} = $positionSensitive;
    $self->{DATA1} = {};
    $self->{DIFF_HANDLE} = undef;
    $self->{MODE} = $W3C::Database::DiffHandle::READING;
    return $self;
}

sub setDiffHandle {
    my ($self, $diffHandle) = @_;
    $self->{DIFF_HANDLE} = $diffHandle;
}

sub put {
    my ($self, @values) = @_;
    # add to array for values[0]
    if ($self->{MODE} == $W3C::Database::DiffHandle::READING) {
	push(@{$self->{DATA1}{$values[0]}}, @values[1..$#values]);
    } else {
	my $key = shift @values;
	$self->deleteMatchesOnData1($key, \@values);
	if ($#values >= $[ && (grep {$_ ne ''} @values)) {
	    push(@{$self->{DATA2}{$key}}, @values);
	}
    }
}

sub deleteMatchesOnData1 {
    my ($self, $key, $values) = @_;
    return if (!exists $self->{DATA1}{$key});
    my $d1 = $self->{DATA1}{$key}; # convenient alias
  SCAN_VALUES:
    for (my $i = 0; $i <= $#$values;) {
	if ($self->{POSITION_SENSITIVE}) {
	    if ($values->[$i] eq $d1->[$i]) {
		$values->[$i] = '';
		$d1->[$i] = '';
#		splice (@$values, $i, 1); # @$values = (@$values[0..$i-1], @$values[$i+1..$#$values]);
#		splice (@$d1, $i, 1);     #     @$d1 = (    @$d1[0..$i-1],     @$d1[$i+1..$#$d1]    );
#	    } else {
#		$i++;
	    }
	    $i++;
	} else {
	    for (my $j = 0; $j <= $#$d1;) {
		if ($values->[$i] eq $d1->[$j]) {
		    splice (@$values, $i, 1); # @$values = (@$values[0..$i-1], @$values[$i+1..$#$values]);
		    splice (@$d1, $j, 1);     #     @$d1 = (    @$d1[0..$j-1],     @$d1[$j+1..$#$d1]    );
		    next SCAN_VALUES;
		}
		$j++;
	    }
	    $i++;
	}
    }
    delete $self->{DATA1}{$key} if ($#$d1 < $[ || !(grep {$_ ne ''} @$d1));
}

sub close {
    my ($self, $disposition) = @_;
    if ($disposition == $W3C::DBStreamHandle::DONE_OK) {
	if ($self->{MODE} == $W3C::Database::DiffHandle::READING) {
	    $self->{MODE} = $W3C::Database::DiffHandle::DIFFING;
	    $self->{DIFF_HANDLE}->forEach();
	    return $self->{DIFF_HANDLE}->close($W3C::DBStreamHandle::DONE_OK);
	} else {
	    # dump the remaining {DATA}
	    # print '-' x 40, "A\n";
	    my $delOperator = $self->{POSITION_SENSITIVE} ? $PDEL : $IDEL;
	    my $addOperator = $self->{POSITION_SENSITIVE} ? $PADD : $IADD;
	    map {
		$self->{SINK}->put($delOperator, $_, @{$self->{DATA1}{$_}});
		if (exists $self->{DATA2}{$_}) {
		    $self->{SINK}->put($addOperator, $_, @{$self->{DATA2}{$_}});
		    delete $self->{DATA2}{$_};
		}
	    } keys %{$self->{DATA1}};
	    # print '-' x 40, "B\n";
	    map {
		$self->{SINK}->put($addOperator, $_, @{$self->{DATA2}{$_}});
	    } keys %{$self->{DATA2}};

	    # avoid "Attempt to free unreferenced scalar during global destruction." error on GDBM handles.
	    $self->{DIFF_HANDLE} = undef;
	    return $self->{SINK}->close($disposition);
	}
    }
}

package W3C::Database::PatchHandle;
@W3C::Database::PatchHandle::ISA = ('W3C::Database::DBStreamHandle');
*W3C::Database::PatchHandle::READING = \1;
*W3C::Database::PatchHandle::PATCHING = \2;
sub new {
    my $proto = shift;
    my $class = ref($proto) || $proto;
    my ($positionSensitive) = (shift);
    my $self  = $class->SUPER::new(@_);
    bless ($self, $class);
    $self->{POSITION_SENSITIVE} = $positionSensitive;
    $self->{DATA1} = {};
    $self->{PATCH_HANDLE} = undef;
    $self->{MODE} = $W3C::Database::PatchHandle::READING;
    return $self;
}

sub setDiffHandle {
    my ($self, $patchHandle) = @_;
    $self->{PATCH_HANDLE} = $patchHandle;
}

sub put {
    my ($self, @values) = @_;
    # add to array for values[0]
    if ($self->{MODE} == $W3C::Database::PatchHandle::READING) {
	push(@{$self->{DATA1}{$values[0]}}, @values[1..$#values]);
    } else {
	# first two fields are the operator and the key
	my ($operator, $key) = splice (@values, 0, 2);
	push(@{$self->{DIFFS}{$key}{$operator}}, @values);
    }
}

sub close {
    my ($self, $disposition) = @_;
    if ($disposition == $W3C::DBStreamHandle::DONE_OK) {
	if ($self->{MODE} == $W3C::Database::PatchHandle::READING) {
	    $self->{MODE} = $W3C::Database::PatchHandle::PATCHING;
	    $self->{PATCH_HANDLE}->forEach();
	    # call W3C::Database::DBStreamHandle::close(ref(W3C::Database::TextHandle), 0) which will call self again, now in PATCHING mode
	    return $self->{PATCH_HANDLE}->close($W3C::DBStreamHandle::DONE_OK);
	} else {
	    # apply patches to {DATA1}
	    map {
		if (exists $self->{DIFFS}{$_}) {
		    my (@pDels, @pAdds, @iDels, @iAdds);
		    @pDels = @{$self->{DIFFS}{$_}{$PDEL}} if (exists $self->{DIFFS}{$_}{$PDEL});
		    @pAdds = @{$self->{DIFFS}{$_}{$PADD}} if (exists $self->{DIFFS}{$_}{$PADD});
		    @iDels = @{$self->{DIFFS}{$_}{$IDEL}} if (exists $self->{DIFFS}{$_}{$IDEL});
		    @iAdds = @{$self->{DIFFS}{$_}{$IADD}} if (exists $self->{DIFFS}{$_}{$IADD});
		    my @data = @{$self->{DATA1}{$_}};
		    # print "$_ @data -@pDels +@pAdds\n";

		    # position-sensitive deletes
		    my $dels = 0; # index of @data changes when we splice out of it
		    foreach my $i (0..$#pDels) {
			splice (@data, $i - $dels++, 1) if ($pDels[$i] ne '');
		    }

		    # position-sensitive adds
		    my @data1;
		    foreach my $i (0..$#pAdds) { # a '' in @pAdds means use original data
			push (@data1, ($pAdds[$i] ne '') ? $pAdds[$i] : shift(@data));
		    }
		    splice (@data, 0, 0, @data1);

		    # position-insensitive deletes
		    foreach my $i (0..$#iDels) {
			foreach my $d (0..$#data) { # delete first occurance of this iDel in @data
			    if ($iDels[$i] eq $data[$d]) {
				splice (@data, $d, 1);
				last;
			    }
			}
		    }

		    # stick position-insensitive adds at end
		    push (@data, @iAdds);

		    @{$self->{DATA1}{$_}} = @data;
		}
		$self->{SINK}->put($_, @{$self->{DATA1}{$_}}) if ($#{$self->{DATA1}{$_}} >= $[);
	    } keys %{$self->{DATA1}};

#	    # avoid "Attempt to free unreferenced scalar during global destruction." error on GDBM handles.
#	    $self->{PATCH_HANDLE} = undef;
	    return $self->{SINK}->close($disposition);
	}
    }
}

package W3C::Database::DBStreamHandle;

1;

__END__

=head1 NAME

W3C::Database::DBStreamHandle - simple unified interface to several databases

=head1 SYNOPSIS

see ddb.pl

=head1 DESCRIPTION

This module is part of the W3C::Database CPAN module.

=head1 AUTHOR

Eric Prud\'hommeaux <eric@w3.org>

=head1 SEE ALSO

perl(1).

=cut
