Recently, I was contracted by Geekcruises (http://www.geekcruises.com) to update their online booking and administration system, which currently uses a simple CGI architecture and a lot of hand-rolled SQL to talk to their PostgreSQL database.
My first design decision was to adopt a more generic, flexible web abstraction, creating CGI::Prototype as a result. (Geekcruises allowed me to upload that to the CPAN, and I’ll be writing more about that in the future.) For the “model” part of the abstraction, I settled in on the wildly popular Class::DBI framework. And that brings us to today’s problem and solution.
The existing Geekcruises database consists of fifty tables, with typical foreign key mappings. For example, a person_cruise record links a person with a cruise. In Class::DBI, setting up these foreign key relationships so that they could be easily accessed looked simple enough: I’d just have to set up a bunch of statements like:
And that was fine — for the first ten or fifteen records. Then it started to get boring. And then tedious. And then error-prone. I started to think, “Hey, wait a minute! PostgreSQL knows these relationships! Why am I reentering that information?” And then I thought, “Oh, someone else must’ve done this already! ”
When I started looking in the CPAN for some reusable solutions, I quickly found Class::DBI::Loader. Joy! This module solves the problem of querying the database for all of the records and their columns, including determining the auto increment sequences. That’s good, because that was starting to be frustrating as well.
But Class::DBI::Loader did nothing about the foreign keys. So, as I kept looking, I stumbled upon Class::DBI::Loader::Relationship, which started to look promising (I could use English instead of Perl), but alas, even the example has a bug in it, and I just couldn’t get it to work like I wanted.
After staring at the DBD::Pg manpage for about a half hour and trying out little snippets in the debugger, I was finally able to coax the database into telling me about its foreign keys. Then I took some of the ideas from Class::DBI::Loader::Relationship to turn those into has_a() and has_many() calls (including the idea of automatically making plurals). And after a bit of hacking, I had my automatic Class::DBI generator.
However, I ran into one other snag: the database had used PostgreSQL’s table inheritance for the payment types. A specific credit card, money order, or check payment inherited from a generic payment record, so that an SQL query could ask for “any payment” versus “any credit card payment” easily. Since these child record types didn’t have an explicit foreign-key relationship with the linking records, I had to add a means of faking it in my code.
The result of all of this is Listing One. Lines 1 and 94 define this as a package GC::DB, which I require or use in my application.
Lines 4 through 90 create a lexical scope so that I can define temporary variables during the setup that won’t apply to any of the later code.
Lines 6 and 7 set up the database connection, user, and password for the database. They can be overridden for testing purposes by setting @GC::DB::CONNECTION before bringing in this file. (More on that in a future column as well.)
Lines 9 and 10 bring in two CPAN modules. I’m using require rather than use because I don’t want any imports to pollute GC::DB class.
Line 12 turns on debug tracing mode. This was helpful when I was developing the code to see what relationships were actually being generated.
Lines 14 through 18 use Class::DBI::Loader to create the fifty Class::DBI classes reflecting the fifty records of the database. The namespace parameter gives GC::DB:: prefixes to these new classes. This call also sets up all of the sequence calls so that key generation works properly.
Lines 19 and 20 extract out the classes and tables just generated. I’m presuming the two lists correlate, but have no assurance of that from the docs. In fact, the docs don’t even mention these two methods.
Line 22 gets me a database handle by calling db_Main on the first class. Any class would have done, as they all share the same database.
Lines 26 to 29 add our current class to the @ISA list for each of the created classes. I want to be able to define methods that all of my created classes understand, and this was the fastest way to do that.
Lines 33 and 34 set up the %class_of hash, so that I can go from a table name to a class name. Again, I’m presuming that the two lists are correlated properly.
Line 36 patches up a plural that didn’t come out quite right for me. The class named GC::DB::PaidTo was getting a linking method called paidtoes, which was humorous, but expectedly hard to remember. So, I just whacked the pluralizer on the head with an additional fact, and it’s all good.
Lines 38 to 60 define a “lexical subroutine” as a coderef stored in a lexical variable. Again, I’m trying hard not to pollute the GC::DB namespace. This subroutine takes a table name, a linking column in that table, and the other table to which the column links, and turns those into the right has_a and has_many calls.
Lines 41 and 42 use the class name hash to get the corresponding class names for the two table names.
Lines 44 through 48 provide a debugging trace of the has_a call that’s about to execute in line 49. This creates our forward link (many to one).
Lines 51 and 52 determine the plural reverse link by first extracting the “basename” of the class, then lowercasing that, then pluralizing that.
Lines 54 through 58 provide a debugging trace of the has_many call that’s about to execute in line 59. This creates the reverse link (one to many).
And now, with a subroutine to do the dirty work, the challenge lies in calling it appropriately.
Lines 64 through 68 define a hash to map a table name into all of its child tables, which apparently cannot be determined automatically from the DBI layer. Oh well.
Lines 70 through 89 loop through all the tables that’ve been seen. Line 71 traces the particular table being examined.
Line 72 uses the DBI abstraction to get the foreign keys for a given table (indicated as the sixth positional parameter). The return value from foreign_key_info is a statement handle that can be used with the normal DBI methods to extract the data. If there are no foreign keys in this table, $sth is undefined, so the rest of the loop must be skipped.
Lines 73 through 87 loop through the results from getting the details of the foreign keys as an array of hashrefs. Each $res is a hashref for a particular foreign key mapping.
Lines 75 and 76 extract the linking column and the referenced table from the result.
Lines 78 and 79 deal with the PostgreSQL inheritance by possibly replacing a single table name with all of its related tables. Most of the time, @tables consists of only $table, but when $table was payment, there’s an entire list.
Lines 81 through 85 execute the $has_a_many subroutine for each combination of source table, foreign table, and column that’s been noted.
Line 92 is where I will be adding other things for each class. For example, if I need to add a method to the GC::DB::PersonCruise record, I’ll merely add…
{ package GC::DB::PersonCruise;
sub my_extra_method { … } }
… to the mix, keeping all of my database model code in this one file.
The lesson I’m reminded here is that when things seem tedious, it’s
time to get the computer to do more of the work. And I’m happy that I
have a language like Perl that can generate and execute code on the
fly, including late-binding the method calls to the objects and
classes created at run-time. Try that in Java! Not gonna happen.
Until next time, enjoy!
LISTING ONE: An automatic Class::DBI generator
1 package GC::DB; 2 use strict; 3 4 BEGIN { 5 our @CONNECTION; 6 @CONNECTION = qw(dbi:Pg:dbname=gcdb Luser Guessnot) unless @CONNECTION; 7 8 require Class::DBI::Loader; 9 require Lingua::EN::Inflect; 10 11 my $DEBUG = 0; 12 13 my $l = Class::DBI::Loader->new(dsn => $CONNECTION[0], 14 user => $CONNECTION[1], 15 password => $CONNECTION[2], 16 namespace => __PACKAGE__, 17 ); 18 my @classes = $l->classes; 19 my @tables = $l->tables; 20 21 my $dbh = $classes[0]->db_Main; 22 23 ## add mixin of us 24 for my $class (@classes) { 25 no strict ‘refs’; 26 push @{$class . “::ISA”}, __PACKAGE__; 27 } 28 29 ## set up the has_a/has_many from the foreign keys 30 31 my %class_of; 32 @class_of{@tables} = @classes; 33 34 Lingua::EN::Inflect::def_noun(’paidto’,'paidtos’); # PL() gets this wrong 35 36 my $has_a_many = sub { # no lexical subs yet! 37 my ($table, $column, $other) = @_; 38 39 my $table_class = $class_of{$table}; 40 my $other_class = $class_of{$other}; 41 42 warn sprintf(”%s->has_a(%s => %s)\n”, 43 $table_class, 44 $column, 45 $other_class, 46 ) if $DEBUG; 47 $table_class->has_a($column => $other_class); 48 49 my ($table_class_base) = $table_class =~ /.*::(.*)/ or die; 50 my $plural = Lingua::EN::Inflect::PL(lc $table_class_base); 51 52 warn sprintf(”%s->has_many(%s => %s)\n”, 53 $other_class, 54 $plural, 55 $table_class, 56 ) if $DEBUG; 57 $other_class->has_many($plural => $table_class); 58 }; 59 60 ## deal with Pg inheritance 61 my %inherits = 62 ( 63 payment => [qw(payment payment_cc payment_check 64 payment_money_order payment_wire)], 65 ); 66 67 for my $table (@tables) { 68 warn “$table:\n” if $DEBUG; 69 if (my $sth = $dbh->foreign_key_info('’,'’,'’,'’,'’,$table)) { 70 for my $res (@{$sth->fetchall_arrayref({})}) { 71 72 my $column = $res->{FK_COLUMN_NAME}; 73 my $other = $res->{UK_TABLE_NAME}; 74 my @tables = @{$inherits{$table} || [$table]}; 75 my @others = @{$inherits{$other} || [$other]}; 76 77 for my $table (@tables) { 78 for my $other (@others) { 79 $has_a_many->($table, $column, $other); 80 } 81 } 82 83 } 84 } 85 } 86 } 87 88 ## other GC::DB::* things go here 89 90 1;
Randal Schwartz is the chief Perl guru at Stonehenge Consulting.
No comments yet.