Beefy Boxes and Bandwidth Generously Provided by pair Networks Joe
Problems? Is your data what you think it is?

DBI SQL Query tool

by runrig (Abbot)
on Oct 27, 2003 at 21:15 UTC ( #302521=sourcecode: print w/ replies, xml ) Need Help??

Category: Utility Scripts
Author/Contact Info /msg runrig

I use this to execute sql from Vim. Written because all the query tools available to me on the PC suck, so it somewhat emulates a query tool on unix that I like, which displays the selected fields across the page in columns if they will fit on the screen, but displays them vertically down the screen if they won't fit. I also display database column types, because I often see column names such as 'item_no', and there are often mostly just numbers in the column, but I'd like to know if its really a character column.

In this script, I assume all connections are through ODBC (easy enough to change that though), and if you are wondering what all the logic is about with the dsn and dbname, it is because in my version, I do alot of convoluted mapping of database names to user/passwords and where to find dsn-less connection strings. Creating a dsn-less connection is easy, you just create a file dsn to the type of database you need, then use the contents of that file as a template for the dsn variable, substituting the desired database name if needed. This uses code from WxPerl Login Dialog, but with my default db/user/password/dsn mappings, I rarely call that module.

This behaves a bit odd on SQL Server databases, for instance, it thinks update statements are really select statements, and a couple of rows are fetched (and returned!) from the database. I'm not sure if anything can be done about this short of scanning the sql statement beforehand, but I get amused every time it happens, so I leave it as is :-)...update: actually, it only seems to be on certain update statements in one particular database...weird


Updated 2004-03-30

# 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
#map ,s :%ya<C-M>:new<C-M>P:%!perl c:/perl/bin/<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";

  # 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;
      # 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;
          $_ .= ")";

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

Comment on DBI SQL Query tool
Download Code

Back to Code Catacombs

Log In?

What's my password?
Create A New User
Node Status?
node history
Node Type: sourcecode [id://302521]
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others drinking their drinks and smoking their pipes about the Monastery: (6)
As of 2014-04-18 05:33 GMT
Find Nodes?
    Voting Booth?

    April first is:

    Results (461 votes), past polls