#!/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.23 2004/06/08 06:51:00 eric Exp $ ';

require 5.002;

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

eval {
    &ddb::ddb(\@ARGV);
}; if ($@) {if (my $ex = &catch('W3C::Util::Exception')) {
    die $ex->toString();
} else {
    die $@;
}}

package ddb;

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

    &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);
    my ($opHandle, $needC) = &getOpHandle(\%args, \@errors, $ioHandles[1]);
    $ioHandles[0] = &getIOHandle(\%args, \@errors, $opHandle, 'i',$W3C::DBStreamHandle::READ_ONLY );
    if ($needC) {
	$ioHandles[3] = &getIOHandle(\%args, \@errors, $opHandle, 'c',$W3C::DBStreamHandle::READ_ONLY );
    }
    if (!(defined $ioHandles[0] && defined $ioHandles[1] && defined $opHandle)) {
	die join("\n", @errors)."\n".&usage();
    }

    # 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 .= "                           db file: \"fd=<db file> delim=<delim> [strict]\"\n";
    $ret .= "                         gdbm file: \"fg=<gdbm file> delim=<delim> [strict]\"\n";
    $ret .= "                         ndbm file: \"fn=<ndbm file> delim=<delim> [strict]\"\n";
    $ret .= "                         sdbm file: \"fs=<sdbm file> delim=<delim> [strict]\"\n";
    $ret .= "             standard input/output: \"delim<delim> [strict]\"\n";
    $ret .= "                               DBI: \"dbi=<DBI access spec> [user=<user>] [password=<password>]\"\n";
    $ret .= "   operation := \"op=<copy|join|split>\"\n";
    $ret .= "   delim := \"delim=<delimiter string>\" or \"parse=<perl code>\"\n";
    $ret .= "   access spec := \"<driver>:<database>:<host>:<port>:<query>\"\n";
    $ret .= "      ex. mysql:test:db.example.org:3306:select a,b from test limit 5\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";
    $ret .= "   ex. moving packed data around: $0 ifg=foo.gdbm iparse='unpack(\"L*\", \$_)' oparse='\$_[0].\": \".pack(\"L*\", \@_[1..\@_-1])'\n";
    return $ret;
}

sub parseArgs {
    my ($argv, $args, $errs) = @_;
    my @handleArgs = ('f', 'delim', 'parse', 'strict', 'fd', 'fg', 'fn', 'fs', 'dbi', 'user', 'password');
    my $errorCount = 0;
  NEXTARG:
    foreach my $arg (@$argv) {
	foreach my $check (@handleArgs) {
	    if ($arg =~ m/\A (i | o | c) $check=(.*) \Z/x) {
		my ($ioc, $val) = ($1, $2);
		if ($check eq 'parse') {
		    $args->{$ioc}{'delim'} = eval "sub {$val}";
		} else {
		    $args->{$ioc}{$check} = $val;
		}
		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}{'fd'}) {
	return undef if ((&checkIOParms($args, $prefix, 'fd', ['delim'], ['strict'], $errs))[0] > 0);
	return &checkHandle(new W3C::Database::DBHandle($args->{$prefix}{'fd'}, $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}{'fn'}) {
	return undef if ((&checkIOParms($args, $prefix, 'fn', ['delim'], ['strict'], $errs))[0] > 0);
	return &checkHandle(new W3C::Database::NDBMHandle($args->{$prefix}{'fn'}, $args->{$prefix}{'delim'}, $args->{$prefix}{'strict'}, $sink, $rw), $errs);
    } elsif (exists $args->{$prefix}{'fs'}) {
	return undef if ((&checkIOParms($args, $prefix, 'fs', ['delim'], ['strict'], $errs))[0] > 0);
	return &checkHandle(new W3C::Database::SDBMHandle($args->{$prefix}{'fs'}, $args->{$prefix}{'delim'}, $args->{$prefix}{'strict'}, $sink, $rw), $errs);
    } elsif (exists $args->{$prefix}{'dbi'}) {
	return undef if ((&checkIOParms($args, $prefix, 'dbi', [], ['user', 'password'], $errs))[0] > 0);
	return &checkHandle(new W3C::Database::DBIHandle($args->{$prefix}{'dbi'}, $args->{$prefix}{'user'}, $args->{$prefix}{'password'}, $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), 0);
    } elsif ($op eq 'join') {
	return (new W3C::Database::JoinHandle($downstreamHandle), 0);
    } elsif ($op eq 'split') {
	return (new W3C::Database::SplitHandle($downstreamHandle), 0);
    } elsif ($op eq 'diff') {
	return (new W3C::Database::DiffHandle(1, $downstreamHandle), 1);
    } elsif ($op eq 'diffc') {
	return (new W3C::Database::DiffHandle(0, $downstreamHandle), 1);
    } elsif ($op eq 'patch') {
	return (new W3C::Database::PatchHandle(0, $downstreamHandle), 1);
    } else {
	push(@$errs, 'unknown op: "'.$op.'"');
    }

    return (undef, 0);
}

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;
    }
}