This module lets you create, load, and populate on-the-fly DBIC schemas from SQL strings or files. It is a thin and evil wrapper around the most excellent SQL::Translator (castaway++, the sqlfairies++). Although you can use it to create permanent module files, it defaults to creating the DBIC classes in memory so when used with temporary tables, you can prototype a complex schema without any permanent file or database footprint other than a single script file that contains none of the usual DBIC class packages and relationship definitions. After all, if you define Foreign Keys in your SQL, why should you have to redefine relationships in DBIC? In that sense, it functions like DBIx::Class::Loader - but instead of automatically loading the schema from an existing database, it lets you automatically load it from SQL and create both the database and a DBIC strategy to access it on the fly.
I'm in an early stage so right now there's no pod, just a (fairly clear) short working example and the module itself which is only a bit longer than the example. I'd appreciate thoughts and suggestions on the usual questions: is it worth CPANing? namespace ok? interface ok? and whatever else you care to comment on.
./dbic-prototyper.pl
#!/usr/bin/perl
use warnings;
use strict;
use lib qw(./lib);
use DBIx::Class::Prototyper;
# create & populate in-memory tables
# create & load in-memory DBIC classes & relationships
#
my $loader = DBIx::Class::Prototyper->new( \*DATA );
my $schema = $loader->connect_and_execute( 'dbi:SQLite:' );
# test a DBIC three-table join
# on success, create module files for the DBIC classes & relationships
#
if( 'Beat It' eq $schema->resultset
( 'Artist' )->find( {name=>'Michael Jackson'}
)->get_Cd->search_related
( 'get_Track' )->next->title
){
print "ok\n";
$loader->save_schema_as_module( 'My::Music' => 'MyMusic.pm' );
}
__DATA__
CREATE TEMPORARY TABLE Artist (
id INTEGER PRIMARY KEY,
name TEXT NOT NULL
);
CREATE TEMPORARY TABLE Cd (
id INTEGER PRIMARY KEY,
artist_id INTEGER NOT NULL REFERENCES Artist(id),
title TEXT NOT NULL
);
CREATE TEMPORARY TABLE Track (
id INTEGER PRIMARY KEY,
cd_id INTEGER NOT NULL REFERENCES Cd(id),
title TEXT NOT NULL
);
INSERT INTO artist VALUES (1,'Michael Jackson');
INSERT INTO cd VALUES (1,1,'Thriller');
INSERT INTO track VALUES (1,1,'Beat It');
./lib/DBIx/Class/Prototyper.pm
package DBIx::Class::Prototyper;
use warnings;
use strict;
use SQL::Translator;
use vars qw($VERSION);
$VERSION = '0.01';
sub new {
my($class,$sql,$sqlt_args) = @_;
my $self = {};
bless $self, $class;
$self->{package} = $self->_load_package($sql,($sqlt_args||{}));
return $self;
}
sub connect_and_execute {
my($self,@connect_args)=@_;
my $schema = $self->{package}->connect( @connect_args );
$schema->storage->dbh->do($_) for( split /;\n/, $self->{sql} );
return $schema;
}
sub save_schema_as_module {
my($self,$class_name,$file_name)=@_;
my $str = $self->{dbic_str};
$str =~ s/My::Schema/$class_name/g;
local *OUT;
open( OUT, '>', $file_name ) or die "Error writing '$file_name': $
+!\n";
print OUT $str;
}
sub _load_package {
my($self,$source,$sqlt_args)=@_;
die 'No data or file supplied' unless $source;
$sqlt_args->{from} ||= 'MySQL';
$sqlt_args->{to} = 'DBIx::Class::File';
my $tr = SQL::Translator->new( %$sqlt_args );
$self->{dbic_str} = $tr->translate( $source );
$self->{sql} = ${$tr->data};
eval $self->{dbic_str};
die $@ if $@;
return 'My::Schema';
}
1;
=pod
=head1 NAME
DBIx::Class::Prototyper;
=head1 AUTHOR, COPYRIGHT, AND LICENSE
This module is copyright 2007, by Jeff Zucker (jZed), all rights reser
+ved.
It may be freely used and distributed under the same terms as Perl its
+elf.
=head1 The Rest of the POD
Sorry, nothing here yet, move along and enjoy!
=cut
