./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');
[download]

./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
[download]