Preamble

This code is a re-write of what was originally a web application. I decided that I was happier running it from the command line as I've never really taken to this new-fangled GUI stuff.

Use of the previous incarnations of this code have saved me vast amounts of coding time by producing SQL and Perl building-blocks. Whilst these blocks generally require some modification before use, I still find this a huge time-saver. I still have another day to go on this, but am sharing the code now whilst there is still a possibility that other people can use it and that it hasn't got too big and confusing.

Share and Enjoy!

Notes

• Invoke with a -h option to see available command line parameters.
• If no command line parameters are given, the programme may be operated through a question and answer session.
• I am not sharing this as a finished application - it should be considered as a starting point to be customised and expanded to meet your needs.
• This was written for my own very specific coding environment and practices. Things you should be aware of are:
  • Variables of the form $v->{foo} are CGI variables similar to $cgi->param('foo') of the standard CGI module. (I use my own version for reasons I won't go into here.)
  • The first column in any table is considered to be the primary key.
  • I use columns created and createdby in a consistent way - this code omits them from any update queries.
• This programme generates stored procedures for MySQL 5.x and subroutines to call them.
• The dotable() subroutine is probably where you would want to do any customisation - this is where all the actual code gets written based on the table schema pulled from the database using a describe statement.
• It is not very well documented. There is a certain amount of inline commenting but please bear in mind that I wrote this purely for myself so comments are more aides-memoires rather than full-blown explanations. You have been warned.

Bugs

Most likely. Finding and fixing these is left as an exercise for the reader ;-) Seriously, I will make corrections here if/as I find them.

Bugs Fixed Since Publication

• Bugs fixed per report from jwkrahn (see acknowledgments) 2008-09-16
• In dotable() 'Skip field if it is an auto_increment one' section, the lines $s_insert_i.="$$r[0],"; and $s_update_v.=" IN i_$$r[0] $$r1,\n"; have been added. The insert and update standard procedures were borked without these in tables with an auto_increment column. Fixed 2008-09-20
• dotable() - section where stored procedure is assembled had a space missing between delimiter and ;. Fixed 2008-09-20.

Acknowledgments

Kudos to jwkrahn for pointing out some mistakes - now fixed.

The Code!

#!/usr/bin/perl

#
# sql-o-matic.pl - a little programme to create
# select, insert, update queries and stored procedures
# for tables in a MySQL database.
#
# Non-Unix users should track down the line:
# system('clear') in the subroutine cls() 
# and substitute the appropriate clear screen 
# command for their operating system.
#
#
use strict;
use DBI;

my ($perlout,$sqlout);

my %opts;
my %default_opts;
$default_opts{'host'}{'value'}='localhost';
$default_opts{'host'}{'description'}='MySQL connection host';
$default_opts{'port'}{'value'}='3306';
$default_opts{'port'}{'description'}='MySQL connection port';
$default_opts{'socket'}{'value'}='/var/run/mysqld/mysqld.sock';
$default_opts{'socket'}{'description'}='MySQL connection socket';
$default_opts{'user'}{'value'}='root';
$default_opts{'user'}{'description'}='User connecting to the MySQL dat
+abase';
$default_opts{'password'}{'value'}='******';
$default_opts{'password'}{'description'}='Password for user connecting
+ to database';
$default_opts{'database'}{'value'}='mydb';
$default_opts{'database'}{'description'}='MySQL database to work on.';
$default_opts{'outfile'}{'value'}='sql-o-matic.out';
$default_opts{'outfile'}{'description'}='Output text file.';
$default_opts{'alltables'}{'value'}=0;
$default_opts{'alltables'}{'description'}='Process all tables - non ze
+ro value selects.';
$default_opts{'tabooregex'}{'value'}='';
$default_opts{'tabooregex'}{'description'}='Regular expression to matc
+h tables to skip - should be enclosed in single quotes.';

# Set options to defaults.
for my $default_opt (keys %default_opts)
{
  $opts{$default_opt}{value}=$default_opts{$default_opt}{value};
  $opts{$default_opt}{description}=$default_opts{$default_opt}{descrip
+tion};
}

# Process command line options.
get_cl_opts();

# If the command line options for
# password and database are the defaults,
# we'd better ask the user to confirm
# that these are correct.
my $reedit=0;
if ($opts{password}{value} eq $default_opts{password}{value} || 
    $opts{database}{value} eq $default_opts{database}{value})
{
  $reedit=1;
  print "\nYou appear to have left the password and/or database name\n
+";
  print "as default values.\n\n";
  print "If you did not mean to do this, enter 'e' to review and edit\
+n";
  print "the options,'q' to quit or just press return to continue with
+\n";
  print "these values.\n\n";

  my $resp=getline('Your response');
  $reedit=0 unless $resp;
  if ($resp=~/q/i)
  {
    print "Quitting.\n";
    exit;
  }
}

if ($reedit)
{
  edit_opts(); 
}

# Now let's try making a database connection.
print "Attempting connection with the following DSN:\n";
my $dsn="dbi:mysql:mysql_socket=$opts{socket}{value};database=$opts{da
+tabase}{value};host=$opts{host}{value}";
print "$dsn\nuser=$opts{user}{value} password=$opts{password}{value}\n
+\n";

my $dbh=DBI->connect($dsn,$opts{user}{value},$opts{password}{value}) o
+r die DBI::errstr;

print "Success!\n\n";

# Get a list of the tables and display it.
my $ar=$dbh->selectall_arrayref("show tables;");
print "Tables for $opts{database}{value}\n\n";

for my $r (@$ar)
{
  print "$$r[0]\n";
}

print "\n";

# Find out if we want all tables processed if
# neither alltables or tabooregex have been set.
my $potabs=0;
unless ($opts{alltables}{value} || defined $opts{tabooregex}{value})
{
  while ($potabs!~/^y$|^n$|^q$/i)
  {
    $potabs=getline('Process all tables? y/n/q');
  }

# Bail out if that's what the user wants.
  if ($potabs=~/q/i)
  {
    print "\nQuitting.\n";
    $dbh->disconnect();
    exit;
  }
}

# Put the tables into a hash - this will 
# make them a bit more manageable.
#
# Here we will also apply the taboo regex.
my %tables;
for my $r (@$ar)
{
  unless ($$r[0]=~/$opts{tabooregex}{value}/)
  {
    $tables{$$r[0]}{selected}=1;
  }
  else
  {
    $tables{$$r[0]}{selected}=0;
  }
}

# Let the user select tables, if required.
if ($potabs=~/n/i)
{
  my $doneselecting=0;

  while ($doneselecting==0)
  {
    table_selector();

    cls();
    print "Tables Selected";
    print "\n---------------\n\n";
    
    for my $thistable (sort keys %tables)
    {
      my $currentoptval=($tables{$thistable}{selected}?'selected':'-')
+;
      print "$thistable\t\t\t$currentoptval\n";
    }

    print "\n";

    my $accept=0;
    while ($accept!~/^y$|^n$|^q$/i)
    {
      $accept=getline("Accept selection (y=yes, n=re-edit, q=quit)? y/
+n/q");
    }

    # Handle responses.
    if ($accept=~/q/i)
    {
      print "\nQuitting.\n";
      $dbh->disconnect();
      exit;
    }
    elsif ($accept=~/y/i)
    {
      $doneselecting=1;
    }
  }
}
elsif ($opts{alltables}{value})
{
  print "\n\nProcessing all tables...\n\n";
}
elsif (defined $opts{tabooregex}{value})
{
  print "\n\nProcessing tables not matching the taboo regex: /$opts{ta
+booregex}{value}/\n\n";
}
else
{
  $dbh->disconnect();
  print "\nDon't know how I got here, quitting. :-(\n";
  exit;
}

# At last!  The bit that does all the work...
crunch_tables();

open (OUT,">$opts{outfile}{value}") || die ($!);
print OUT<<EOT;
#
# Perl bits
#
$perlout

#
# SQL bits
#
$sqlout
EOT

print "\n\nOutput written to $opts{outfile}{value}\n\n";

# Disconnect and terminate gracefully.
$dbh->disconnect();
exit();

# That's all folks!


##### Subroutines and nothing else from hereon. #####

#
# Process the actual table.
#
sub dotable
{
  my $table=shift;
  my $ar=$dbh->selectall_arrayref("describe $table;");

  # Set up variables to hold all the bits.  Ones
  # beginning $p are for Perl subroutines, ones
  # beginning $s are for MySQL stored procedures.
  #
  # Stored procedure suffixes are: none - main body
  # of SP, _v - input variables, _s - the actual
  # query body.
  my ($p_insert,$s_insert,$s_insert_v,$s_insert_s,$s_insert_i,
    $p_update,$s_update,$s_update_v,$s_update_s,
    $p_popvars,$s_popvars,$s_popvars_v,$s_popvars_s,$s_popvars_i);

  # Assume that first column is primary key.
  my $pkey=$$ar[0][0];
  my $pkeytype=$$ar[0][1];
  $pkeytype=~s/\(.+\)// if $pkeytype=~/^int|^tinyint/;

  # Start generating code!
  $p_insert="
#
# Insert row into $table.
#
sub ins_$table
{\n  ";

  if ($$ar[0][5]=~/auto_increment/)
  {
    $p_insert.="\$v->{$pkey}=\$dbh->selectrow_array(\"call insert_$tab
+le(";
  }
  else
  {
    $p_insert.="my \$row_count=\$dbh->selectrow_array(\"call insert_$t
+able(";
  }

  $p_update="
#
# Update row in $table.
#
sub up_$table
{
  my \$row_count=\$dbh->selectrow_array(\"call update_$table(";


  $p_popvars="
#
# Retrieve values from $table.
#
sub popvars_$table
{
  (";


  $s_insert=<<EOT;
/*
  Insert SP for $table
*/
drop procedure if exists insert_$table;
delimiter //
create procedure insert_$table (
EOT


  $s_update=<<EOT;
/*
  Update SP for $table
*/
drop procedure if exists update_$table;
delimiter //
create procedure update_$table (
EOT

  $s_popvars=<<EOT;
/*
  Popvars (select) SP for $table
*/
drop procedure if exists popvars_$table;
delimiter //
create procedure popvars_$table (IN i_$pkey $pkeytype)
BEGIN
EOT

##############  End of headers, start of columns loop ##############

  my $has_auto_increment=0;
  my $rowcount=0;
  for my $r (@$ar)
  {
    $rowcount++;

    # Trim int column types to just 'int' (remove formatting.)
    $$r[1]=~s/\(.+\)// if $$r[1]=~/^int|^tinyint/;

    # Skip field if it is an auto_increment one.
    if ($$r[5]=~/auto_increment/)
    {
      $has_auto_increment=1;
      $s_insert_s.='NULL,';
      $s_insert_i.="$$r[0],";
      $s_update_v.="  IN i_$$r[0] $$r[1],\n";
    }
    else
    {
      $p_insert.="'\$v->{$$r[0]}',";

      # Ignore created, createdby on updates.
      $p_update.="'\$v->{$$r[0]}'," unless $$r[0]=~/^created$|^created
+by$/;

      $s_insert_v.="  IN i_$$r[0] $$r[1],\n";
      $s_insert_s.="i_$$r[0],";

      # Once again, we're not going to do anything with our 
      # created, createdby fields on an update.
      $s_update_s.="$$r[0]=i_$$r[0]," unless $$r[0]=~/^created$|^creat
+edby$/;;

    }

    unless ($$r[0] eq $pkey)
    {
      $s_popvars_v.="  DECLARE o_$$r[0] $$r[1];\n";
      $s_popvars_i.="o_$$r[0],";
      $s_popvars_s.="$$r[0],";
    }
    
    $s_update_v.="  IN i_$$r[0] $$r[1],\n" unless $$r[0]=~/^created$|^
+createdby$/;;
    $s_insert_i.="$$r[0],";

    if ($rowcount>1)
    {
      $p_popvars.="\$v->{$$r[0]},";
    }
  }

  # Remove that final comma.
  chop($p_insert);
  chop($p_update);
  chop($p_popvars);

  $p_insert.=");\";\n}\n";
  $p_update.=");\";\n}\n";
  $p_popvars.=")=\$dbh->selectrow_array(\"call popvars_$table('\$v->{$
+pkey}');\");\n}\n";

  chop($s_insert_v);
  chop($s_insert_v);
  chop($s_insert_s);
  chop($s_insert_i);

  $s_insert.=<<EOT;
$s_insert_v)
BEGIN
  INSERT INTO $table
  ($s_insert_i)
  VALUES 
  ($s_insert_s);

EOT

  if ($has_auto_increment)
  {
    $s_insert.="  SELECT last_insert_id();\n";
  }
  else
  {
    $s_insert.="  SELECT row_count();\n";
  }

  $s_insert.=<<EOT;
END;
//
delimiter ;

EOT
  
  chop($s_update_v);
  chop($s_update_v);
  chop($s_update_s);

  $s_update.=<<EOT;
$s_update_v)
BEGIN
  UPDATE $table SET
  $s_update_s
  WHERE $pkey=i_$pkey;

  SELECT row_count();
END;
//
delimiter ;

EOT

  chop($s_popvars_i);
  chop($s_popvars_s);

  $s_popvars.=<<EOT;
$s_popvars_v

  SELECT $s_popvars_s
  INTO $s_popvars_i
  FROM $table
  WHERE $pkey=i_$pkey;
  
  SELECT $s_popvars_i;
END;
//
delimiter ;

EOT

  $perlout.="$p_insert\n$p_update\n$p_popvars\n\n";
  $sqlout.="$s_insert\n$s_update\n$s_popvars\n\n";
}

#
# Main table processing loop.
#
sub crunch_tables
{
  cls();
  for my $thistable (sort keys %tables)
  {
    unless ($tables{$thistable}{selected})
    {
      print "Skipping table $thistable.\n";
      next;
    }
    
    print "Processing table $thistable...";
   
    # Call the subroutine that actually does the work.
    dotable($thistable) if $thistable;

    print " done.\n";
  }
  print "\n\nAll done!\n\n";
}

#
# Table selector.
#
sub table_selector
{
  cls();
  print "Select Tables";
  print "\n-------------\n\n";
  for my $thistable(sort keys %tables)
  {
    my $selected=0;
    while ($selected!~/^y$|^n$|^q$/i)
    {
      my $currentoptval=($tables{$thistable}{selected}?'y':'n');
      $selected=getline("Select $thistable? y/n/q",$currentoptval);
    }

    # Handle resonses.
    if ($selected=~/q/i)
    {
      print "\nQuitting.\n";
      $dbh->disconnect();
      exit;
    }
    elsif ($selected=~/y/i)
    {
      $tables{$thistable}{selected}=1;
    }
    else
    {
      $tables{$thistable}{selected}=0;
    }
  }
}

#
# Manual edit of options.
#
sub edit_opts
{
  print "\nReview/Edit Options";
  print "\n-------------------\n\n";

  for my $opt (sort keys %opts)
  {
    $opts{$opt}=getline($opt,$opts{$opt}{value}); 
  }

  print "\n";
}

#
# Read in command line options, check against 
# list of permissible ones (hard-code here.)
#
sub get_cl_opts
{
  for my $cl_part (@ARGV)
  {
    # Display help option.
    crash_n_burn() if $cl_part=~/^-h$|^--help$|^-help$/i; 

    # Check syntax.
    if ($cl_part!~/^--/ || $cl_part!~/=/)
    {
      print "Bad syntax: $cl_part\n\n";
      crash_n_burn();
    }

    # Strip the -- from the option.
    $cl_part=~s/^--//;

    # Split option into a name/value pair.
    my ($n,$v)=split(/=/,$cl_part);

    # Check for illegal options.
    unless (defined $default_opts{$n})
    {
      print "Illegal option: $n";
      crash_n_burn();
    }

    # If we've got this far, we should have
    # a valid name/value pair - we'll put it
    # into our options hash, replacing the 
    # default value.
    $opts{$n}{value}=$v; 
  }
}

#
# Error/help stuff
#
sub crash_n_burn
{
  print<<EOT;
Usage: $0 [options]

Options with Default Values
---------------------------

EOT

  for my $opt (sort keys %default_opts)
  {
    print "--$opt=$default_opts{$opt}{value}\n\t$default_opts{$opt}{de
+scription}\n\n";
  }

  print "--help, -h - show this help text.\n";

  print "\n\n";

  exit;
}

#
# Get a line from STDIN.
#
sub getline
{
  print $_[0];
  print " [$_[1]]" if $_[1];
  print ": ";
  my $line=<STDIN>;
  chomp($line);
  $line=$_[1] unless $line;
  return($line);
}

#
# Clear screen.
#
sub cls
{
  system('clear');
}