Added deploy to Storage, DBICTEST_SQLT_DEPLOY env var for tests

diff --git a/MANIFEST b/MANIFEST
index a730db0..4a03e0c 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -88,6 +88,7 @@ lib/SQL/Translator/Parser/DBIx/Class.pm
 lib/SQL/Translator/Producer/DBIx/Class/File.pm
 Makefile.PL
 MANIFEST                       This list of files
+META.yml
 README
 t/02pod.t
 t/03podcoverage.t.disabled
@@ -121,6 +122,8 @@ t/basicrels/18self_referencial.t
 t/basicrels/19uuid.t
 t/basicrels/20unique.t
 t/basicrels/21serialize.t
+t/basicrels/22cache.t
+t/basicrels/22cascade_copy.t
 t/cdbi-sweet-t/08pager.t
 t/cdbi-t/01-columns.t
 t/cdbi-t/02-Film.t
@@ -161,6 +164,7 @@ t/helperrels/18self_referencial.t
 t/helperrels/19uuid.t
 t/helperrels/20unique.t
 t/helperrels/21serialize.t
+t/helperrels/22cascade_copy.t
 t/lib/DBICTest.pm
 t/lib/DBICTest/BasicRels.pm
 t/lib/DBICTest/Extra.pm
@@ -208,6 +212,8 @@ t/run/18self_referencial.tl
 t/run/19uuid.tl
 t/run/20unique.tl
 t/run/21serialize.tl
+t/run/22cache.tl
+t/run/22cascade_copy.tl
 t/testlib/Actor.pm
 t/testlib/ActorAlias.pm
 t/testlib/Binary.pm
@@ -226,4 +232,3 @@ t/testlib/MyStarLinkMCPK.pm
 t/testlib/Order.pm
 t/testlib/OtherFilm.pm
 t/testlib/PgBase.pm
-META.yml

diff --git a/lib/DBIx/Class/Schema.pm b/lib/DBIx/Class/Schema.pm
index 3b7418e..b2c9775 100644 (file)
--- a/lib/DBIx/Class/Schema.pm
+++ b/lib/DBIx/Class/Schema.pm
@@ -428,6 +428,18 @@ sub throw_exception {
   croak @_;
 }
 
+=head2 deploy
+
+Attempts to deploy the schema to the current storage
+
+=cut
+
+sub deploy {
+  my ($self) = shift;
+  $self->throw_exception("Can't deploy without storage") unless $self->storage;
+  $self->storage->deploy($self);
+}
+
 1;
 
 =head1 AUTHORS

diff --git a/lib/DBIx/Class/Storage/DBI.pm b/lib/DBIx/Class/Storage/DBI.pm
index 95673ce..93e8fd2 100644 (file)
--- a/lib/DBIx/Class/Storage/DBI.pm
+++ b/lib/DBIx/Class/Storage/DBI.pm
@@ -215,7 +215,7 @@ sub new {
   $new->transaction_depth(0);
   if (defined($ENV{DBIX_CLASS_STORAGE_DBI_DEBUG}) &&
      ($ENV{DBIX_CLASS_STORAGE_DBI_DEBUG} =~ /=(.+)$/)) {
-    $new->debugfh(IO::File->new($1, 'w')||croak "Cannot open trace file $1");
+    $new->debugfh(IO::File->new($1, 'w')) || $new->throw_exception("Cannot open trace file $1");
   } else {
     $new->debugfh(IO::File->new('>&STDERR'));
   }
@@ -223,6 +223,11 @@ sub new {
   return $new;
 }
 
+sub throw_exception {
+  my ($self, $msg) = @_;
+  croask($msg);
+}
+
 =head1 NAME 
 
 DBIx::Class::Storage::DBI - DBI storage handler
@@ -339,7 +344,7 @@ sub _connect {
   }
 
   my $dbh = DBI->connect(@info);
-  croak "DBI Connection failed: $DBI::errstr"
+  $self->throw_exception("DBI Connection failed: $DBI::errstr")
       unless $dbh;
   $dbh;
 }
@@ -396,20 +401,20 @@ sub _execute {
       $self->debugfh->print("$sql: @debug_bind\n");
   }
   my $sth = $self->sth($sql,$op);
-  croak "no sth generated via sql: $sql" unless $sth;
+  $self->throw_exception("no sth generated via sql: $sql") unless $sth;
   @bind = map { ref $_ ? ''.$_ : $_ } @bind; # stringify args
   my $rv;
   if ($sth) {  
     $rv = $sth->execute(@bind);
   } else { 
-    croak "'$sql' did not generate a statement.";
+    $self->throw_exception("'$sql' did not generate a statement.");
   }
   return (wantarray ? ($rv, $sth, @bind) : $rv);
 }
 
 sub insert {
   my ($self, $ident, $to_insert) = @_;
-  croak( "Couldn't insert ".join(', ', map "$_ => $to_insert->{$_}", keys %$to_insert)." into ${ident}" )
+  $self->throw_exception( "Couldn't insert ".join(', ', map "$_ => $to_insert->{$_}", keys %$to_insert)." into ${ident}" )
     unless ($self->_execute('insert' => [], $ident, $to_insert));
   return $to_insert;
 }
@@ -484,7 +489,7 @@ sub columns_info_for {
             $column_info{is_nullable} = $info->{NULLABLE};
             $result{$info->{COLUMN_NAME}} = \%column_info;
         }
-    }else{
+    } else {
         my $sth = $self->dbh->prepare("SELECT * FROM $table WHERE 1=0");
         $sth->execute;
         my @columns = @{$sth->{NAME}};
@@ -502,7 +507,31 @@ sub last_insert_id {
 
 }
 
+sub sqlt_type {
+  my ($self) = @_;
+  my $dsn = $self->connect_info->[0];
+  $dsn =~ /^dbi:(.*?)\d*:/;
+  return $1;
+}
+
+sub deployment_statements {
+  my ($self, $schema, $type) = @_;
+  $type ||= $self->sqlt_type;
+  eval "use SQL::Translator";
+  $self->throw_exception("Can't deploy without SQL::Translator: $@") if $@;
+  eval "use SQL::Translator::Parser::DBIx::Class;";
+  $self->throw_exception($@) if $@; 
+  eval "use SQL::Translator::Producer::${type};";
+  $self->throw_exception($@) if $@;
+  my $tr = SQL::Translator->new();
+  SQL::Translator::Parser::DBIx::Class::parse( $tr, $schema );
+  return "SQL::Translator::Producer::${type}"->can('produce')->($tr);
+}
 
+sub deploy {
+  my ($self, $schema, $type) = @_;
+  $self->dbh->do($_) for split(";\n", $self->deployment_statements($schema, $type));
+}
 
 sub DESTROY { shift->disconnect }
 

diff --git a/maint/gen-schema.pl b/maint/gen-schema.pl
index b16bd15..a4e101d 100755 (executable)
--- a/maint/gen-schema.pl
+++ b/maint/gen-schema.pl
@@ -4,19 +4,8 @@ use strict;
 use warnings;
 use lib qw(lib t/lib);
 
-use UNIVERSAL::require;
+use DBICTest;
 
-my $from = 'SQL::Translator::Parser::DBIx::Class';
-my $to = 'SQL::Translator::Producer::SQLite';
-my $sqlt = 'SQL::Translator';
-my $schema = 'DBICTest::Schema';
+my $schema = DBICTest->initialise;
 
-$from->require;
-$to->require;
-$sqlt->require;
-$schema->require;
-
-my $tr = $sqlt->new;
-
-$from->can("parse")->($tr, $schema);
-print $to->can("produce")->($tr);
+print $schema->storage->deployment_statements($schema);

diff --git a/t/lib/DBICTest.pm b/t/lib/DBICTest.pm
index 0afc604..a2eef1b 100755 (executable)
--- a/t/lib/DBICTest.pm
+++ b/t/lib/DBICTest.pm
@@ -1 +1,20 @@
+package DBICTest;
+
+use strict;
+use warnings;
+use DBICTest::Schema;
+
+sub initialise {
+
+  my $db_file = "t/var/DBIxClass.db";
+  
+  unlink($db_file) if -e $db_file;
+  unlink($db_file . "-journal") if -e $db_file . "-journal";
+  mkdir("t/var") unless -d "t/var";
+  
+  my $dsn = "dbi:SQLite:${db_file}";
+  
+  return DBICTest::Schema->compose_connection('DBICTest' => $dsn);
+}
+  
 1;

diff --git a/t/lib/DBICTest/Setup.pm b/t/lib/DBICTest/Setup.pm
index 6b2e3f2..a7efea5 100755 (executable)
--- a/t/lib/DBICTest/Setup.pm
+++ b/t/lib/DBICTest/Setup.pm
@@ -1,30 +1,26 @@
 use strict;
 use warnings;
-use DBICTest::Schema;
+use DBICTest;
 
-my $db_file = "t/var/DBIxClass.db";
-
-unlink($db_file) if -e $db_file;
-unlink($db_file . "-journal") if -e $db_file . "-journal";
-mkdir("t/var") unless -d "t/var";
-
-my $dsn = "dbi:SQLite:${db_file}";
-
-my $schema = DBICTest::Schema->compose_connection('DBICTest' => $dsn);
+my $schema = DBICTest->initialise;
 
 $schema->storage->on_connect_do([ "PRAGMA synchronous = OFF" ]);
 
 my $dbh = $schema->storage->dbh;
 
-open IN, "t/lib/sqlite.sql";
+if ($ENV{"DBICTEST_SQLT_DEPLOY"}) {
+  $schema->deploy;
+} else {
+  open IN, "t/lib/sqlite.sql";
 
-my $sql;
+  my $sql;
 
-{ local $/ = undef; $sql = <IN>; }
+  { local $/ = undef; $sql = <IN>; }
 
-close IN;
+  close IN;
 
-$dbh->do($_) for split(/\n\n/, $sql);
+  $dbh->do($_) for split(/\n\n/, $sql);
+}
 
 $schema->storage->dbh->do("PRAGMA synchronous = OFF");
 

diff --git a/t/lib/sqlite.sql b/t/lib/sqlite.sql
index f6060fe..8238674 100644 (file)
--- a/t/lib/sqlite.sql
+++ b/t/lib/sqlite.sql
@@ -1,6 +1,6 @@
 -- 
 -- Created by SQL::Translator::Producer::SQLite
--- Created on Tue Feb 14 16:16:19 2006
+-- Created on Fri Feb 24 15:13:57 2006
 -- 
 BEGIN TRANSACTION;
 
@@ -78,14 +78,6 @@ CREATE TABLE artist_undirected_map (
 );
 
 --
--- Table: producer
---
-CREATE TABLE producer (
-  producerid INTEGER PRIMARY KEY NOT NULL,
-  name varchar NOT NULL
-);
-
---
 -- Table: onekey
 --
 CREATE TABLE onekey (
@@ -105,6 +97,14 @@ CREATE TABLE track (
 );
 
 --
+-- Table: producer
+--
+CREATE TABLE producer (
+  producerid INTEGER PRIMARY KEY NOT NULL,
+  name varchar NOT NULL
+);
+
+--
 -- Table: treelike
 --
 CREATE TABLE treelike (