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