Beefy Boxes and Bandwidth Generously Provided by pair Networks
Keep It Simple, Stupid
 
PerlMonks  

comment on

( [id://3333]=superdoc: print w/replies, xml ) Need Help??

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'); }

In reply to sql-o-matic by smiffy

Title:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post; it's "PerlMonks-approved HTML":



  • 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.
Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Chatterbox?
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others admiring the Monastery: (3)
As of 2024-03-28 17:37 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found