for the usual reason - ability to gain abstraction by un-coupling all of the elements needed for database access. And I hate it for what I suspect are common reasons (at least for SQL freaks like me) - all of those ugly package declarations everywhere, thinking in terms of has_a and has_many syntax instead of SQL joins, having to redefine columns and primary keys (they're already in the SQL DDL, why do I need to re-specify them), using funky $class->create($data_hashref) and $class->retrieve($query_hashref) instead of SQL inserts and selects. Well, being a have-my-cake-and-eat-it-too kinda guy, I decided to try to code an example of a join that does not have any hard-coded package declarations, that does not use has_a and has_many, that does not require redefining columns and primary keys and that puts more emphasis on the SQL statements. I am not unpleased with the results shown below. I take back the bit about hating Class::DBI, I can use it without using the parts I find annoying.
My questions for the monks are these: what have I lost by using Class::DBI this way? Am I stuck in my SQL ways and just unable to see the light? Are there other, better, ways to accomplish what this script does?
The script below is pure Class::DBI, but foregoes the use of some of the more common methods such as has_a, has_many, create, retrieve. It makes use of two generic subroutines which also don't utilize those methods - get_config(), a quick hack to grab both SQL and data from the script's DATA section and setup_class(), a tiny factory that obviates the need for hard-coded package declarations. These subroutines are generic, they should work with almost any other schema although the get_config() would obviously need to be tweaked for file or database storage of the SQL statments and data.
The data set is a Professor table and a Subject table with the prof's id as the common key. The script joins the two tables and prints out a list of subjects taught by each professor. The script uses DBD::AnyData but it should work with any DBD that supports explicit join syntax. I tested with DBD::SQLite and DBD::Pg and it works fine with both.
-- start of cdbi.pl --
#!perl -w
use strict;
require 'setup-class.pl';
my @connect_args = ( 'dbi:AnyData:','me','mypass',{} );
my( $sql, $data ) = get_config(qw(Prof Subject));
for my $table(qw(Prof Subject)) {
setup_class ( $table, $sql->{$table}, @connect_args );
eval { $table->sql_drop->execute };
$table->sql_create->execute;
$table->sql_insert->execute( @$_ ) for ( @{$data->{$table}} );
}
for my $row(Prof->search_query) {
printf "Professor %s teaches %s.\n",$row->{pname},$row->{cname};
}
$_->sql_drop->execute for qw(Prof Subject);
__DATA__
create = CREATE TABLE Prof (pid INT PRIMARY KEY, pname VARCHAR(10))
insert = INSERT INTO Prof (pid,pname) VALUES(?,?)
query = SELECT pname,cname FROM Prof NATURAL JOIN Subject
drop = DROP TABLE Prof
1,Jones
2,Smith
create = CREATE TABLE Subject(cid INT PRIMARY KEY,pid INT,cname VARCHA
+R(10))
insert = INSERT INTO Subject(cid,pid,cname) VALUES(?,?,?)
drop = DROP TABLE Subject
1,1,Chemistry
2,1,Biology
3,2,English
-- end of cdbi.pl --
-- start of setup-class.pl --
use warnings;
use strict;
use Class::DBI;
sub get_config {
my @config = split /\n\n/,join'',<DATA>;
my(%sql,%data);
for my $table(@_) {
my $sql_str = shift @config;
my $data_str = shift @config;
for my $stmt(split /\n/,$sql_str) {
my($key,$value) = split /\s*=\s*/,$stmt,2;
$sql{$table}->{$key}=$value;
}
for my $row(split /\n/,$data_str) {
push @{ $data{$table} }, [split /,/,$row];
}
}
return \%sql, \%data;
}
sub setup_class {
my($class,$cfg,@connect_args) = @_;
my $table = delete $cfg->{table} || $class;
my @columns;
my $colstr = delete $cfg->{columns};
if ($colstr) {
@columns = split /,/,$colstr;
}
elsif (my $create_str=$cfg->{create}) {
$create_str =~ s/^[^\(]+\((.*)\)\s*$/$1/;
@columns = map {s/^\s*(\S+)\s.*/$1/; $_} split/,/,$create_str;
}
else {
die "No columns specified for table '$table'!\n";
}
eval "Package $class";
no strict 'refs';
@{"$class\::ISA"} = ('Class::DBI');
$class->connection( @connect_args );
$class->table ( $table );
$class->columns ( All=>@columns );
$class->set_sql( $_ => $cfg->{$_}, undef, 0 ) for keys %$cfg;
}
1;
-- end of setup-class.pl --
