#!/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');

##</code><code>##

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 reserved.
It may be freely used and distributed under the same terms as Perl itself.

=head1 The Rest of the POD

Sorry, nothing here yet, move along and enjoy!
=cut