#!/usr/bin/perl

# TODO
# implement Xfg=+file to append and otherwise reset %self->{DB} on open
#    for write
# implement W3C::Database::DBIInterface::put
$ddb::REVISION = '$Id: ddb,v 1.17 1999/11/06 23:25:31 eric Exp $ ';

require 5.002;

BEGIN {unshift@INC,('../../..');}
use strict;
use W3C::Database::DBStreamHandle;
use W3C::Database::DBIInterface;
use W3C::Database::GdbmInterface;
use W3C::Database::FlatfileInterface;

&ddb::ddb(\@ARGV);

package ddb;

sub ddb {
    my ($argv) = shift;
    my (@errors, %args, @ioHandles, $opHandle);

    &parseArgs($argv, \%args, \@errors) && die join("\n", @errors)."\n".&usage();
    ((print STDOUT &usage) && return) if (exists $args{'help'});
    # grab handles for input and output
    $ioHandles[1] = &getIOHandle(\%args, \@errors, undef, 'o',$W3C::DBStreamHandle::WRITE_ONLY);
    $opHandle = &getOpHandle(\%args, \@errors, $ioHandles[1]);
    $ioHandles[0] = &getIOHandle(\%args, \@errors, $opHandle, 'i',$W3C::DBStreamHandle::READ_ONLY );
    $ioHandles[3] = &getIOHandle(\%args, \@errors, $opHandle, 'c',$W3C::DBStreamHandle::READ_ONLY );
    die join("\n", @errors)."\n".&usage() if (!(defined $ioHandles[0] && defined $ioHandles[1] && defined $opHandle));

    # extra info for the merging (diff and patch) operators
    $opHandle->setDiffHandle($ioHandles[3]) if (defined $ioHandles[3]);

    if ($args{'inspect'}) {
	require ('perl5db.pl'); # ooo - sneaky
	$DB::signal = 1;
	print "You may now muck about with the internal data in \$ioHandles[0].\n";
	print "For example: if the input is a gdbm file, grab the keys with\n";
	print "             \@keys = keys %{\$ioHandles[0]{'DB'}}.\n";
	print "\nWhen you're done, hit 'c' to finish the operation or 'q' to abort\n";
	&DB::DB();
    }
    my $t1;
    if ($args{'time'}) {
	print STDERR "stuffing: ";
	$t1 = time;
    }
    $ioHandles[0]->forEach();
    $ioHandles[0]->close($W3C::DBStreamHandle::DONE_OK);
    if ($args{'time'}) {
	my $t2 = time;
	print STDERR $t2-$t1, " seconds\n";
    }
    undef $opHandle->{PATCH_HANDLE}; # avoid this message:
    # Attempt to free unreferenced scalar during global destruction.
}

sub usage {
    my $ret = '';
    $ret .= "Usage: $0 iSpec oSpec [operation] [time] [inspect]\n";
    $ret .= "   or use as diff: $0 iSpec cSpec oSpec op=<diff[c]|patch> [time] [inspect]\n";
    $ret .= "   where Spec is prefixed by i|o|c:\n";
    $ret .= "                         flat file: \"f=<file> delim<delim> [strict]\"\n";
    $ret .= "                         gdbm file: \"fg=<gdbm file> delim<delim> [strict]\"\n";
    $ret .= "             standard input/output: \"dbi=<DBI access spec> [strict]\"\n";
    $ret .= "                               DBI: \"delim<delim>\"\n";
    $ret .= "   and operation := \"op=<copy|join|split\"\n";
    $ret .= "   \"time\" prints to STDERR the number of seconds the operation took\n";
    $ret .= "   \"inspect\" starts an interactive debugger shell to view/change data\n";
    $ret .= "   ex. gdbm to flat file: $0 ifg=a.gdbm idelim=' ' of=a.dat odelim=': '\n";
    $ret .= "   ex. gdbm to standard out: $0 ifg=a.gdbm idelim=' ' odelim=': '\n";
    $ret .= "   ex. diffing two gdbm files: $0 ifg=a.gdbm idelim=' ' cfg=b.gdbm cdelim=' ' op=diffc odelim=': '\n";
    return $ret;
}

sub parseArgs {
    my ($argv, $args, $errs) = @_;
    my @handleArgs = ('f', 'delim', 'strict', 'fg', 'dbi');
    my $errorCount = 0;
  NEXTARG:
    foreach my $arg (@$argv) {
	foreach my $check (@handleArgs) {
	    if ($arg =~ m/\A (i | o | c) ($check)=(.*) \Z/x) {
		$args->{$1}{$2} = $3;
		next NEXTARG;
	    }
	}
	if ($arg =~ m/\A op=(.*) \Z/x) {
	    $args->{'op'} = $1;
	} elsif ($arg eq 'time') {
	    $args->{'time'} = 1;
	} elsif ($arg eq 'inspect') {
	    $args->{'inspect'} = 1;
	} elsif ($arg =~ m/\A ( -{0,2}help | -{0,1}\? ) \Z/x) { # help -help --help ? -?
	    $args->{'help'} = $1;
	} else {
	    push(@$errs, 'unknown arg: "'.$arg.'"');
	    $errorCount++;
	}
    }
    return $errorCount;
}

sub getIOHandle {
    my ($args, $errs, $sink, $prefix, $rw) = @_;

    if (exists $args->{$prefix}{'f'}) {
	return undef if ((&checkIOParms($args, $prefix, 'f', ['delim'], ['strict'], $errs))[0] > 0);
	return &checkHandle(new W3C::Database::TextHandle($args->{$prefix}{'f'}, $args->{$prefix}{'delim'}, $args->{$prefix}{'strict'}, $sink, $rw), $errs);
    } elsif (exists $args->{$prefix}{'fg'}) {
	return undef if ((&checkIOParms($args, $prefix, 'fg', ['delim'], ['strict'], $errs))[0] > 0);
	return &checkHandle(new W3C::Database::GDBMHandle($args->{$prefix}{'fg'}, $args->{$prefix}{'delim'}, $args->{$prefix}{'strict'}, $sink, $rw), $errs);
    } elsif (exists $args->{$prefix}{'dbi'}) {
	return undef if ((&checkIOParms($args, $prefix, 'dbi', [], [], $errs))[0] > 0);
	return &checkHandle(new W3C::Database::DBIHandle($args->{$prefix}{'dbi'}, $sink, $rw), $errs);
    } else {
	return undef if ((&checkIOParms($args, $prefix, \ 'STDIO', ['delim'], ['strict'], $errs))[0] > 0);
	return &checkHandle(new W3C::Database::StdHandle($args->{$prefix}{'delim'}, $args->{$prefix}{'strict'}, $sink, $rw), $errs);
    }

    return undef;
}

sub getOpHandle {
    my ($args, $errs, $downstreamHandle) = @_;

    my $op = $args->{'op'};
    if (!defined $op || $op eq 'copy') {
	return new W3C::Database::CopyHandle($downstreamHandle);
    } elsif ($op eq 'join') {
	return new W3C::Database::JoinHandle($downstreamHandle);
    } elsif ($op eq 'split') {
	return new W3C::Database::SplitHandle($downstreamHandle);
    } elsif ($op eq 'diff') {
	return new W3C::Database::DiffHandle(1, $downstreamHandle);
    } elsif ($op eq 'diffc') {
	return new W3C::Database::DiffHandle(0, $downstreamHandle);
    } elsif ($op eq 'patch') {
	return new W3C::Database::PatchHandle(0, $downstreamHandle);
    } else {
	push(@$errs, 'unknown op: "'.$op.'"');
    }

    return undef;
}

sub checkIOParms {
    my ($parms, $prefix, $lookFor, $need, $want, $errs) = @_;

    # make our own (destroyable) copies
    my (%needs, %wants);
    map {$needs{$_} = undef;} @$need;
    map {$wants{$_} = undef;} @$want;

    # make sure all given args are known
    my $errorCount = 0;
    foreach my $parm (keys %{$parms->{$prefix}}) {
	if (exists $needs{$parm}) {
	    $needs{$parm} = $parms->{$prefix}{$parm};
	} elsif (exists $wants{$parm}) {
	    $wants{$parm} = $parms->{$prefix}{$parm};
	} elsif (!(ref $lookFor) && $parm ne $lookFor) {
	    push(@$errs, "'$prefix$lookFor' can't have '$prefix$parm'");
	    $errorCount ++;
	}
    }

    # see what unclaimed needed args remain
    my $parmStr = ref $lookFor ? $$lookFor : "'$prefix$lookFor'";
    map {(!defined $needs{$_} && push(@$errs, "$parmStr needs '$prefix$_'") && $errorCount++);} keys %needs;

    return $errorCount, \%needs, \%wants;
}

sub checkHandle {
    my ($retCode, $errs) = @_;
    if (ref $retCode) {
	return $retCode;
    } else {
	push(@$errs, "file error: $retCode");
	return undef;
    }
}

