Category: | Database Programming |
Author/Contact Info | |
Description: | This is about the fourth generation of this programme that I have been using over the last few years to generate SQL and Perl code based on a MySQL database schema. The idea behind this is much repetitive coding can be eliminated - the ouput of this programme can be tweaked/corrected and then cut and pasted into an application. |
PreambleThis 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
BugsMost 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
AcknowledgmentsKudos 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'); } |