#!/usr/bin/perl -w

use strict;
use DBI;

my $fields_in = ($ARGV[0]||'') eq "F"
	and shift;
my $fields_out = ($ARGV[0]||'') eq "f"
	and shift;
my $join = ($ARGV[0]||'') eq "j"
	and shift;

my $numeric = '';
@ARGV == 3
	and $numeric = pop @ARGV;

@ARGV == 2
	or die "syntax: [F] [f] [j] $0 dsn sql [numeric] < input > output\n";

my ($dsn, $user, $pass, $attr) = split / /, shift, 4;
my $sql = shift;

my $dbh = DBI->connect($dsn, $user, $pass, $attr && eval $attr)
	or die "cannot connect to $dsn: ".DBI->errstr."\n";

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

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

if ($fields_in) {
	my $guff = <STDIN>;
}

if (defined ($line = <STDIN>)) {
	chomp $line;
	@input_row = split /\t/, $line, -1;
	for (@input_row) {
		if ($_ eq "\0") {
			undef $_;
		} else {
			s/([^\\]|^)((?:\\\\)*)\\0/$1$2\0/g;
			s/([^\\]|^)((?:\\\\)*)\\n/$1$2\n/g;
			s/([^\\]|^)((?:\\\\)*)\\t/$1$2\t/g;
			s/\\\\/\\/g;
		}
		$numeric =~ /(.)/g;
		($1||'') =~ /\d/ and $_ = 0+$_;
	}
	$sth->execute(@input_row)
		or die "cannot execute: ".$sth->errstr."\n";

	if ($fields_out) {
		print join "\t", @{$sth->{NAME}};
		print "\n";
	}

	while (defined ($output_row = $sth->fetchrow_arrayref)) {
		for (@$output_row) {
			if (defined $_) {
				s/\\/\\\\/g;
				s/\t/\\t/g;
				s/\n/\\n/g;
				s/\0/\\0/g;
			} else {
				$_ = "\0";
			}
		}
		print join "\t", @$output_row;
		print "\n";
	}
	print "\n" unless $join;

	$sth->err
		and die "cannot fetch: ".$sth->errstr."\n";

	while (defined ($line = <STDIN>)) {
		chomp $line;
		@input_row = split /\t/, $line, -1;
		for (@input_row) {
			if ($_ eq "\0") {
				undef $_;
			} else {
				s/([^\\]|^)((?:\\\\)*)\\0/$1$2\0/g;
				s/([^\\]|^)((?:\\\\)*)\\n/$1$2\n/g;
				s/([^\\]|^)((?:\\\\)*)\\t/$1$2\t/g;
				s/\\\\/\\/g;
			}
		}
		$sth->execute(@input_row)
			or die "cannot execute: ".$sth->errstr."\n";
	
		while (defined ($output_row = $sth->fetchrow_arrayref)) {
			for (@$output_row) {
				if (defined $_) {
					s/\\/\\\\/g;
					s/\t/\\t/g;
					s/\n/\\n/g;
					s/\0/\\0/g;
				} else {
					$_ = "\0";
				}
			}
			print join "\t", @$output_row;
			print "\n";
		}
		print "\n" unless $join;
	
		$sth->err
			and die "cannot fetch: ".$sth->errstr."\n";
	}
}

$sth->finish;

$dbh->disconnect;