effective perl programming

by Joseph N. Hall
<joseph@5sigma.com>

Joseph N. Hall is the author of Effective Perl Programming (Addison-Wesley, 1998). He teaches Perl classes, consults, and plays a lot of golf in his spare time.

Manual SQL (It Rhymes)

You Too Can Write an SQL Client

Lately I've found myself spending an increasing amount of time working with Perl and SQL databases, and sometimes with more than one type of server at a time. One minor aggravation in dealing with different kinds of servers at the same time is that their command-line clients work differently.

For example, MySQL's command-line client, mysql, has the GNU readline library built into it, which means that you can use the up and down arrows (or Control-N, Control-P) to access the command-line history, and various emacs-like commands to edit the current line. Oracle's SQL*PLUS client, on the other hand, has a lot of nifty features, but no readline library. Ugh.

Well, I guess if my SQL client(s) don't suit me, I should consider writing my own. And that's exactly what I've done for this article. In years past I probably wouldn't have considered writing my own SQL client, and certainly not as an afternoon "quickie," but as you'll see below, nowadays with Perl it's just a matter of slapping together some modules.

Starting Up

First, make sure you have the DBI, Term::ReadLine, and Term::ReadLine::Gnu modules installed, as well as the DBD module(s) for your favorite server(s).

Our shiny new server-independent SQL client will be called perlsql. Let's start it off like this:

#!/usr/local/bin/perl -w
use strict;
use DBI;
use Term::ReadLine;
use File::MkTemp;

The use DBI directive gives me the DBI module, and use Term::ReadLine gives me an interface to GNU readline-like functionality. File::MkTemp will also come in handy in a bit.

From the UNIX command line, we'll invoke perlsql something like this:

persql 'DBI:Oracle:host=localhost;sid=main' scott/tiger

The first argument is a DBI DSN string. It will, of course, vary (considerably) depending on what server you're connecting to, how it's set up, and what environment you are executing in. The second argument is an Oracle-style username/password identifier. Here's how we process the command line:

my $dsn = shift;
die "usage: perlsql dsn [user/password]" unless $dsn;
my ($user, $passwd) = split(/\/, (shift || ''));

The shift operator works on @ARGV by default if you don't specify an argument. The username and password default to empty string if none are specified. Now we're ready to connect to the database:

$dbh = DBI->connect($dsn, $user, $passwd,
&#nbsp;{ PrintError => 0, RaiseError => 1, AutoCommit => 1 }
) or die "can't connect:\n$@";

This connects us to the database and sets some connect attributes. We turn the PrintError attribute off so that error messages aren't automatically printed. Turning RaiseError on causes DBI to generate an exception when an error is encountered. Turning AutoCommit on automatically commits every statement executed by DBI. Next, let's initialize Term::ReadLine:

my $term = new Term::ReadLine 'PerlSQ';
my $OUT = $term->OUT || *STDOUT{IO};

We're now ready to write some command-processing code.

The Readline Loop

I'll go ahead and show you the entire command-processing loop, and then explain it a piece at a time.

while (defined($_ = $term->readline("$line> ")) ) {
my $cmd = $_;
$cmd =~ s/^\s+|\s+$//g;    # lop off whitespace
next unless $cmd;          # skip blank lines
my $first = (split(/\s+/, $cmd))[0];
if ($is_sql_cmd{lc $first}) {
  do_sql($cmd);
} else {
  if (lc($cmd) eq 'quit') {
   $term->remove_history($term->where_history);
   last;
  } elsif ($cmd =~ /^!/) {
   system substr $cmd, 1;
  } else {
   eval qq(
    package perlsql; no strict; \$save = select(STDOUT);
    \$res = do {$cmd}; select \$save; \$res
   );
   print $@ if $@;
   print "\n";
  }
}
$line++;
}

The command-processing line is, overall, a while loop that reads a line at a time from our ReadLine terminal. If the user types the end-of-file character, $term->readline returns undef and drops us out of the loop. Inside the loop we first strip leading/trailing white space from the command line and make sure it's not blank. If it's not, we process the line in one of several possible ways.

First, we check to see if the line is an SQL command. The hash %is_sql_cmd contains a list of SQL commands. This is obviously server-dependent, but simple enough to come up with. I define it like this:

my %is_sql_cmd = map { $_ => 1 } qw(
alter analyze associate audit call comment commit
create delete dissociate drop explain grant insert
lock noaudit rename revoke rollback savepoint select
set truncate update
);

If it is an SQL command, I pass it to my do_sql subroutine, which I'll explain below. The next possibility is that the user has typed quit. In that case, I delete the current line (containing quit) from the readline history, and exit the loop. Another possibility is a line beginning with an exclamation mark. Those lines get sent to a shell with Perl's system operator.

If the line doesn't fit one of those descriptions, it's treated as a Perl command. If you supply the eval operator a string, Perl takes the string and executes it as Perl code in the current context. Note that I'm using the generalized qq form of double quote — it just looks better to me than ordinary double quotes if I'm quoting several lines.

I don't want the Perl code executed in my current package (otherwise, commands typed in by the user might inadvertently mess up the running perlsql program!), so I change to a different package in the eval — perlsql in this case. I turn off strict and make sure the default filehandle is set to STDOUT, then execute the command line in a do block. Then I restore the default filehandle and return the result of executing the command. (Note that this code doesn't actually do anything with the result, $res, but that's a feature that could be added.) If the eval produced an error, the message will be in the $@ variable, so I check that and print it if necessary.

At the bottom of the loop, I increment the line number counter.

Processing SQL

The do_sql subroutine takes a single SQL command as its argument, double-quote interpolates it, executes it, and then displays the result.

sub do_sql {
my $sql = shift;
$sql = eval "package perlsql; no strict; qq\0$sql\0";
print($@), return if $@;
print "=> $sql\n";
my $sth;
eval {
  $sth = $dbh->prepare($sql);
  my $rv = $sth->execute;
  if ($sql =~ /^\bselect\b/) {
   my ($prec, $names) = @{$sth}{qw(PRECISION NAME_lc)};
   display_result $prec, $names, $sth->fetchall_arrayref;
   print "\n";
  } else {
   print defined($rv) ? ($rv + 0, " rows affected.\n\n") :          "ok\n\n";
  }
};
print $@ if $@;
}

Double-quote interpolating SQL command lines is useful because it lets us use Perl variables inside our commands — something like:

select count(*) from club where state = '$state'

To double-quote interpolate $sql, I eval it in the perlsql package. Note that the argument to eval is a double-quoted string, and that within that I have another double-quoted string. I use a NUL (\0) as the delimiter for the embedded double-quoted string. After that, I echo the interpolated command to the terminal and then prepare and execute the command.

I display the results of select statements with the display_result subroutine:

sub display_result {
my ($prec, $name, $ary) = @_;
my $row_format = join(' ', map "%-${_}s", @$prec) . "\n";
printf $row_format, @$name;
print join(' ', map { '=' x $_ } @$prec), "\n";
printf $row_format, @$_ for @$ary;
}

The arguments to display_result are array references containing the "precision" of the result columns (how many characters are required to print the contents), the names of the result columns, and the results themselves. The results are a two-dimensional "array of arrays." I use the precision to create a suitable printf format (just printing the data as strings) and then print each row of the result. The whole thing winds up looking like this:

112> select distinct postal_code from club where name like 'Augusta%'
=> select distinct postal_code from club where name like 'Augusta%'
postal_code
===============
30904
04351
67010
46701

For non-select statements, I print the number of rows affected by the command (if available).

More Powerful Command-line Editing

One of the annoying things about using SQL command-line clients is that you often need to enter rather long commands. Perhaps you'd like to be able to edit them using a separate editor? No problem! We'll just bind the Control-V key to a subroutine that lets you edit the current line in your favorite editor:

$term->add_defun('visual', sub {
my $fn = mktemp("perlsql$$.XXXXXXXX", "/tmp");
$fn = "/tmp/$fn";
open F, ">$fn" or die "can't open $fn: $!";
print F $term->copy_text;
close F;
system +($ENV{EDITOR} || 'vi'), $fn;
if (-r $fn) {
  local $/;
  open F, $fn;
  my $text = <F>;
  close F;
  $text =~ s/[\r\n]+$//;      # no trailing newline
  $term->begin_undo_group;
  $term->delete_text;
  $term->Attribs->{point} = 0;
  $term->insert_text($text);
  $term->Attribs->{point} = length $term->Attribs->             {line_buffer};
  $term->end_undo_group;
  unlink $fn;
}
$term->forced_update_display;
} );
$term->bind_key(ord("\cv"), 'visual');

The Term::ReadLine::Gnu method add_defun registers a subroutine with the readline library. In this case, I've defined it as an anonymous subroutine (with the sub {} operator). I use the mktemp subroutine from File::MkTemp to create a temporary filename, then create a temporary file with that name, write the contents of the current command line into it (from copy_text), and fire up an editor on that file with system. If the editor leaves a readable file, I read the contents back in as a single blob of text (clearing the $/ special variable makes Perl ignore line endings when reading from the file) and use that to set the current command. I found that it was necessary to manipulate the insertion point with Attribs->{point} manually to avoid some weird problems. A call to forced_update_display after everything's done forces the readline library to update the display.

The bind_key method binds the subroutine that I've registered with the name visual to the Control-V key.

Cleaning Up

An END block handles disconnect from the database and cleanup of any temporary files that might have been left behind:

END {
print "\n";
$dbh->disconnect if $dbh;
unlink </tmp/perlsql$$.*>;
}

Features Gone Begging

I've written a slightly longer version of this program that has a few more frills. It saves the history to a file and restores it on startup, and also reads in a
~/.perlsqlrc file written in Perl on startup. You can see it in its entirety at <http://www.perlfaq.com/examples>.

This short program (the version on my Web site above is only 140 lines long as of this writing) is, I think, an excellent demonstration of how you can quickly create surprisingly powerful and useful things in Perl. It took me only a few hours to write perlsql. Yet, even after that small amount of work, it's a useful database-independent SQL client, and one that knows Perl in addition to everything else!

The idea behind perlsql isn't a new one — there have been previous attempts at writing DBI/ReadLine clients. The notion hit me all on my own but it was of course not original. The first such well-known DBI-based client was Andreas Koenig's pmsql. A later program was dbimon. dbimon is apparently out of date, but I have also seen a few other more recent Perl-based SQL clients.