#!/usr/bin/perl
#
#
# Execute arbitrary sql statment(s) and send result to stdout.
# If global '$columns' flag is set, display selected fields in
# columns if needed width for display size <= $columns, otherwise
# display fields one per line. Also displays
# column types and, for character and decimal fields, sizes.
#
# For each Sql statement, the statement is executed, with any
# arguments in the ARGS list replacing placeholders ('?' characters)
# in the sql statement. The number of rows returned may be limited by
# setting LIMIT to something besides undef.
#
# Any line beginning with '#' or '--' is treated as a comment and
# ignored.
#
# arguments in the ARGS list are space separated and may be
# enclosed in double quotes. Other options are "DB: database_name",
# "USER: user_name", and "PASSWD: pass_word" which are set once
# per file not once per statement like ARGS and LIMIT.
#
# Then to create a shortcut (",s") in Vim that runs this script
# on the current sql file and displays
# results in a new window, put this in your .vimrc file
# (assuming on Windows and this script is named dbtalk.pl):
#map ,s :%ya<C-M>:new<C-M>P:%!perl c:/perl/bin/dbtalk.pl<C-M><C-W>_
# And make sure this script is in C:/perl/bin
#
# Shortcuts to move between Vim windows:
#map <C-J> <C-W>j<C-W>_
#map <C-K> <C-W>k<C-W>_
#
use strict;
use warnings;

use DBI;
use List::Util qw(max sum);

my @sql;

# Defaults
my $dbname = '';
my $user = '';
my $passwd = '';

# user and password from file/stdin
my $file_user;
my $file_passwd;

my $columns = 125;
my %sql;
while (<>) {
  next unless /\S/;
  next if /^\s*(#|--)/;
  my $got_end = s/;\s*\Z/\n/;
  if (/^(?:DB(?:NAME)?|DATABASE):\s*(\w+)/i) {
    $dbname = $1;
  } elsif (/^USER:\s*(\w*)/i) {
    $file_user = $1;
  } elsif (/^PASSW(?:OR)?D:\s*(.*)/i) {
    $file_passwd = $1;
  } elsif (/^ARGS:\s*(.+)/i) {
    $_ = $1;
    my @args;
    # Allow for space-delimited bare words or quoted strings
    push @args, $1 while /((?<=")(?:\\.|[^"])*(?=")|[^\s"]+)/g;
    $sql{ARGS} = \@args;
  } elsif (/^LIMIT:\s*(\d*)/i) {
    $sql{LIMIT} = length($1) ? $1 : undef;
  } else { $sql{STMT} .= $_ }
  if ($got_end) {
    # Store previous and reset next sql statement
    push @sql, { %sql } if %sql;
    %sql = ();
  }
}
push @sql, { %sql } if %sql;

# Default dsnless connection string (get template from a file dsn).
my $dsn = '';

chomp ( $dsn = join ";", split "\n", $dsn);

$user = $file_user if defined $file_user;
$passwd = $file_passwd if defined $file_passwd;

# Assume the dbname is a dsn
$dsn = $dbname;
unless (defined $file_user and defined $file_passwd) {
  $user = $file_user;
  $passwd = $file_passwd;
  require LoginDialog;
  die "Login required\n"
    unless LoginDialog->get_login(\($user, $passwd));
}

my $dbh = DBI->connect("dbi:ODBC:$dsn", $user, $passwd, {
  PrintError => 0,
  RaiseError => 1,
  LongReadLen => 8192,
  LongTruncOk => 1,
  # ChopBlanks => 1,
  AutoCommit => 1,
});

# Get all data types and map numbers to names
# This really ought to be cached and keyed by
# database using Storable or somesuch
my %type_names;
{
  my $type_info = $dbh->type_info_all;
  my ($data_type_idx, $type_name_idx) =
    @{shift @$type_info}{qw(DATA_TYPE TYPE_NAME)};
  for (@$type_info) {
    # Skip duplicate numbers in type list
    next if exists $type_names{$_->[$data_type_idx]};
    $type_names{$_->[$data_type_idx]} = $_->[$type_name_idx];
  }
}

for my $sql (@sql) {
  # Print header data (sql statement and any arguments)
  ( my $stmt = $sql->{STMT} ) =~ s/^\s+//mg;
  my $args = $sql->{ARGS} || [];
  print "\n", map "SQL: $_", split /(?<=\n)/, $stmt;
  print "ARGS: ", map("[$_]", @{ $sql->{ARGS} } ), "\n" if @$args;
  print "\n";

  my $sth = $dbh->prepare($stmt);
  my $num_rows = $sth->execute(@$args);

  # Don't fetch if not a select statement, but report rows affected
  if ($sth->{NUM_OF_FIELDS} == 0) {
    my $action = "AFFECTED";
    $action = uc($1)."ED"
      if $stmt =~ /^\s*(updat(?=e)|insert|delet(?=e))/mi;
    print "ROWS $action: $num_rows\n";
    next;
  }

  # Determine column names, types, and sizes and whether or not
  # to display in column format or one field per line
  my @names = @{$sth->{NAME_uc}};
  my %types; @types{@names} = @type_names{ @{ $sth->{TYPE} } };
  my $disp_columns;
  my $fmt;
  {
    my %sizes; @sizes{@names} = @{ $sth->{PRECISION} };
    my %scales; @scales{@names} = @{ $sth->{SCALE} };

    my %did_type;
    for my $name (@names) {
      if ($did_type{$name}++) {
        # Flag duplicate select columns
        $types{$name} .= "(DUP)" if $did_type{$name} == 2;
        next;
      }
      # Add size/precision/scale to character and decimal types
      for ($types{$name}) {
        /CHAR|DECIMAL/i && do {
          $_ .= "($sizes{$name}";
          # The "< 255" clause is due to a bug
          # in the Informix ODBC driver
          $_ .= ",$scales{$name}"
            if defined $scales{$name} and $scales{$name} < 255;
          $_ .= ")";
          last;
        };
      }
    }

    # Determine if we have enough room to display output in columns
    my %disp_sizes; @disp_sizes{@names} =
      map max(length, $sizes{$_}, length($types{$_})), @names;
    my $display_size = sum(scalar(@names)-1, values %disp_sizes);
    $disp_columns = ($display_size <= $columns);

    # Print header if we are displaying in columnar format
    if ($disp_columns) {
      # Right justify numerical fields
      # Numeric types would best be determined during
      # the type_info_all processing above, but oh well
      my %justify; @justify{@names} = map {
        ($types{$_} =~ /DEC|INT|FLOAT|NUM/i)? "" : "-"
      } @names;
      $fmt = join(' ',
        map "%$justify{$_}$disp_sizes{$_}s", @names) . "\n";
      printf $fmt, @types{@names};
      printf $fmt, @names;
      printf $fmt, map "=" x $disp_sizes{$_}, @names;
    }
  }

  # Fetch the data
  my $cnt = 0;
  my %row; $sth->bind_columns(\@row{@names});
  while ($sth->fetch) {
    no warnings 'uninitialized';
    last if defined $sql->{LIMIT} and $cnt >= $sql->{LIMIT};
    $cnt++;
    if ($disp_columns) {
      printf $fmt, @row{@names};
    } else {
      print "COUNT: $cnt\n";
      for (@names) {
        my $str = sprintf "%20s %-30s %-20s\n",
          "$_:", "[$row{$_}]", $types{$_};
        $str =~ s/\s+\Z/\n/;
        print $str;
      }
    }
  }
  # Print just names and datatypes if there are no rows returned
  unless ($cnt) {
    print "COUNT: 0\n";
    print "$_: [NO_DATA] $types{$_}\n" for @names;
  }
  print "\nROWS RETURNED: $cnt\n";
}
$dbh->disconnect;