From: Matt S Trout <mst@shadowcat.co.uk>
Date: Mon, 9 Jan 2006 00:06:08 +0000 (+0000)
Subject: Moving towards instance-based schemas
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=bfb2bd4fbfd099e2bde591feb786a99e8ec9574c;p=dbsrgits%2FDBIx-Class-Historic.git

Moving towards instance-based schemas
---

diff --git a/lib/DBIx/Class/DB.pm b/lib/DBIx/Class/DB.pm
index c0152c6..6aaab51 100644
--- a/lib/DBIx/Class/DB.pm
+++ b/lib/DBIx/Class/DB.pm
@@ -15,7 +15,7 @@ sub storage { shift->storage_instance(@_); }
 sub resultset_instance {
   my $class = shift;
   my $table = $class->table_instance->new($class->table_instance);
-  $table->storage($class->storage_instance);
+  $table->schema($class);
   $table->result_class($class);
   return $table->resultset;
 }
@@ -23,7 +23,7 @@ sub resultset_instance {
 sub result_source {
   my $class = shift;
   my $table = $class->table_instance->new($class->table_instance);
-  $table->storage($class->storage_instance);
+  $table->schema($class);
   $table->result_class($class);
   return $table;
 }
diff --git a/lib/DBIx/Class/Schema.pm b/lib/DBIx/Class/Schema.pm
index 1029651..502ec55 100644
--- a/lib/DBIx/Class/Schema.pm
+++ b/lib/DBIx/Class/Schema.pm
@@ -85,6 +85,19 @@ sub registered_classes {
   return values %{shift->class_registrations};
 }
 
+=head2 class
+
+  my $class = $schema->class('Foo');
+
+Shortcut to retrieve a single class by its registered name
+
+=cut
+
+sub class {
+  my ($self, $class) = @_;
+  return $self->class_registrations->{$class};
+}
+
 =head2  load_classes [<classes>, (<class>, <class>), {<namespace> => [<classes>]}]
 
 Uses L<Module::Find> to find all classes under the database class' namespace,
@@ -136,6 +149,9 @@ sub load_classes {
     foreach my $comp (@{$comps_for{$prefix}||[]}) {
       my $comp_class = "${prefix}::${comp}";
       eval "use $comp_class"; # If it fails, assume the user fixed it
+      if ($@) {
+        die $@ unless $@ =~ /Can't locate/;
+      }
       $class->register_class($comp => $comp_class);
     }
   }
@@ -169,7 +185,16 @@ sub compose_connection {
   my ($class, $target, @info) = @_;
   my $conn_class = "${target}::_db";
   $class->setup_connection_class($conn_class, @info);
-  $class->compose_namespace($target, $conn_class);
+  my $schema = $class->compose_namespace($target, $conn_class);
+  $schema->storage($conn_class->storage);
+  foreach my $class ($schema->registered_classes) {
+    my $source = $class->result_source;
+    $source = $source->new($source);
+    $source->schema($schema);
+    $source->result_class($class);
+    $class->mk_classdata(result_source => $source);
+  }
+  return $schema;
 }
 
 sub compose_namespace {
@@ -177,21 +202,22 @@ sub compose_namespace {
   my %reg = %{ $class->class_registrations };
   my %target;
   my %map;
+  my $schema = bless({ }, $class);
   while (my ($comp, $comp_class) = each %reg) {
     my $target_class = "${target}::${comp}";
     $class->inject_base($target_class, $comp_class, $base);
     @map{$comp, $comp_class} = ($target_class, $target_class);
   }
+  $schema->class_registrations(\%map);
   {
     no strict 'refs';
+    *{"${target}::schema"} =
+      sub { $schema };
     *{"${target}::class"} =
-      sub {
-        my ($class, $to_map) = @_;
-        return $map{$to_map};
-      };
-    *{"${target}::classes"} = sub { return \%map; };
+      sub { shift->schema->class(@_) };
   }
   $base->class_resolver($target);
+  return $schema;
 }
 
 =head2 setup_connection_class <$target> <@info>
diff --git a/lib/DBIx/Class/Table.pm b/lib/DBIx/Class/Table.pm
index 717e522..c7646f2 100644
--- a/lib/DBIx/Class/Table.pm
+++ b/lib/DBIx/Class/Table.pm
@@ -11,7 +11,7 @@ use base qw/DBIx::Class/;
 __PACKAGE__->load_components(qw/AccessorGroup/);
 
 __PACKAGE__->mk_group_accessors('simple' =>
-  qw/_columns _primaries name resultset_class result_class storage/);
+  qw/_columns _primaries name resultset_class result_class schema/);
 
 =head1 NAME 
 
@@ -140,8 +140,15 @@ Returns the FROM entry for the table (i.e. the table name)
 
 =cut
 
-sub from { return shift->name(@_); }
+sub from { shift->name; }
 
+=head2 storage
+
+Returns the storage handle for the current schema
+
+=cut
+
+sub storage { shift->schema->storage; }
 
 1;
 
diff --git a/lib/DBIx/Class/Test/SQLite.pm b/lib/DBIx/Class/Test/SQLite.pm
index a324737..ac4fd51 100644
--- a/lib/DBIx/Class/Test/SQLite.pm
+++ b/lib/DBIx/Class/Test/SQLite.pm
@@ -45,6 +45,7 @@ my @DSN = ("dbi:SQLite:dbname=$DB", '', '', { AutoCommit => 1, RaiseError => 1 }
 __PACKAGE__->connection(@DSN);
 __PACKAGE__->set_sql(_table_pragma => 'PRAGMA table_info(__TABLE__)');
 __PACKAGE__->set_sql(_create_me    => 'CREATE TABLE __TABLE__ (%s)');
+__PACKAGE__->storage->dbh->do("PRAGMA synchronous = OFF");
 
 =head1 METHODS
 
@@ -67,11 +68,6 @@ sub _create_test_table {
 	my $class = shift;
         my @vals  = $class->sql__table_pragma->select_row;
         $class->sql__create_me($class->create_sql)->execute unless @vals;
-#	my @vals  = $class->_sql_to_sth(
-#                      'PRAGMA table_info(__TABLE__)')->select_row;
-#	$class->_sql_to_sth(
-#          'CREATE TABLE '.$class->table.' ('.$class->create_sql.')'
-#            )->execute unless @vals;
 }
 
 =head2 create_sql (abstract)
diff --git a/t/lib/DBICTest.pm b/t/lib/DBICTest.pm
index 6748bae..bcca718 100755
--- a/t/lib/DBICTest.pm
+++ b/t/lib/DBICTest.pm
@@ -10,7 +10,7 @@ mkdir("t/var") unless -d "t/var";
 
 my $dsn = "dbi:SQLite:${db_file}";
 
-DBICTest::Schema->compose_connection('DBICTest' => $dsn);
+my $schema = DBICTest::Schema->compose_connection('DBICTest' => $dsn);
 
 my $dbh = DBI->connect($dsn);
 
@@ -126,4 +126,6 @@ EOSQL
 
 $dbh->do($_) for split(/\n\n/, $sql);
 
+$schema->storage->dbh->do("PRAGMA synchronous = OFF");
+
 1;
diff --git a/t/lib/DBICTest/Schema.pm b/t/lib/DBICTest/Schema.pm
index 941a8d4..092c317 100644
--- a/t/lib/DBICTest/Schema.pm
+++ b/t/lib/DBICTest/Schema.pm
@@ -24,7 +24,7 @@ __PACKAGE__->load_classes(qw/
     'Producer',
     'CD_to_Producer',
   ),
-  qw/SelfRefAlias CDWithArtist/
+  qw/SelfRefAlias/
 );
 
 1;