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');
}
-
Are you posting in the right place? Check out Where do I post X? to know for sure.
-
Posts may use any of the Perl Monks Approved HTML tags. Currently these include the following:
<code> <a> <b> <big>
<blockquote> <br /> <dd>
<dl> <dt> <em> <font>
<h1> <h2> <h3> <h4>
<h5> <h6> <hr /> <i>
<li> <nbsp> <ol> <p>
<small> <strike> <strong>
<sub> <sup> <table>
<td> <th> <tr> <tt>
<u> <ul>
-
Snippets of code should be wrapped in
<code> tags not
<pre> tags. In fact, <pre>
tags should generally be avoided. If they must
be used, extreme care should be
taken to ensure that their contents do not
have long lines (<70 chars), in order to prevent
horizontal scrolling (and possible janitor
intervention).
-
Want more info? How to link
or How to display code and escape characters
are good places to start.