#!/usr/bin/perl -w

# TODO For binding, allow :foo or ?foo in addition to ?
#	would have to take care with quoted strings, etc
# TODO Allow several statements (different args?)
# TODO Allow to use SQL generating scripts or something.

use strict;
use DBI;
use Getopt::Std;
my %opt;
getopts("h1gGdc", \%opt);

@ARGV >= 1 && @ARGV <= 2 && !$opt{h}
	or die <<End;
syntax:	DSN='dsn user pass attr' $0 [-1] [-b] sql [numeric] <input >output
	-1	execute once, without parameters
	-g	blank line after each group of results
	-G	skip blank lines in input
	-d	data only: no headers in output
	-c	continue on error
End

my $DSN = $ENV{DSN}
	or die "\$DSN must be defined\n";
my ($sql, $numeric) = @ARGV;
$numeric ||= '';

my ($dsn, $user, $pass, $attr) = split / /, $DSN, 4;
my ($dbd) = $dsn =~ /^dbi:([^:]+)/;
$dbd ||= '';

$attr = $attr ? eval "{$attr}" : {};
$attr->{PrintError} = 0;

my $dbh = DBI->connect($dsn, $user, $pass, $attr)
	or die "cannot connect to $dsn: ".DBI->errstr."\n";
if ($dbd eq 'InterBase') {
	# XXX no milliseconds support here?
	$dbh->{ib_timestampformat} = '%Y-%m-%d %H:%M:%S';
	$dbh->{ib_dateformat} = '%Y-%m-%d';
	$dbh->{ib_timeformat} = '%H:%M:%S';
}
# TODO Nice date formats for other DBD drivers.  Grrrr.

my $sth = $dbh->prepare($sql)
	or die "cannot prepare: ".$dbh->errstr."\n";

my $line;
my $markup_type;
my @input_row;
my $output_row;

my @esc = ([t=>"\t"], [n=>"\n"], [r=>"\r"], [0=>"\0"], ["\\"=>"\\"]);
my %isub = map {$_->[0], $_->[1]} @esc;
my %osub = map {$_->[1], $_->[0]} @esc;

my $failed = 0;

sub err {
	my ($msg) = @_;
	$msg =~ s/([\\\t\n\r\0])/"\\$osub{$1}"/ge;
	print STDERR "\\!$line\n";
	print STDERR "\\#$msg\n";
	if (!$opt{c}) {
		exit 1;
	}
	++$failed;
}

while ($opt{1} || defined ($line = <STDIN>)) {
	unless ($opt{1}) {
		chomp $line;
		next if $line eq "" && $opt{G};
		if ($line =~ /^\\([:#!])/) {
			$markup_type = $1;
			next;
		}
		(@input_row) = split /\t/, $line, -1;
		pop @input_row if @input_row && $input_row[-1] eq "";
		for (@input_row) {
			if ($_ eq "\\") {
				undef $_;
			} else {
				my $fail;
				s/\\(.)/$isub{$1} || do { err "unknown escape \\$1"; $fail=1; }/ge;
				goto NEXT_ROW if $fail;
			}
			$numeric =~ /(.)/g;
			($1||'') =~ /\d/ and $_ = 0+$_;
		}
	}
	if (!$sth->execute(@input_row)) {
		err "cannot execute: ".$sth->errstr;
		goto NEXT_ROW;
	}

	if ($sth->{NAME}) {
		if (!$opt{d}) {
			print "\\:", join("\t", @{$sth->{NAME}}), "\t\n";
			$opt{d} = 1;
		}

		while (defined ($output_row = $sth->fetchrow_arrayref)) {
			for (@$output_row) {
				if (defined $_) {
					s/([\\\t\n\r\0])/"\\$osub{$1}"/ge;
				} else {
					$_ = "\\";
				}
			}
			print join("\t", @$output_row), "\t\n";
		}
		print "\n" if $opt{g};
		{ local $| = 1; }

		if ($sth->err) {
			err "cannot fetch: ".$sth->errstr;
			goto NEXT_ROW;
		}
	}

NEXT_ROW:
	last if $opt{1};
}

$sth->finish;

$dbh->disconnect;

if ($failed) {
	print STDERR "\\#$failed rows failed\n";
	exit 2;
}