Adding a new component for handling positioned lists.

[dbsrgits/DBIx-Class-Historic.git] / lib / DBIx / Class / Schema.pm

diff --git a/lib/DBIx/Class/Schema.pm b/lib/DBIx/Class/Schema.pm
index 65c235c..21ae980 100644 (file)
--- a/lib/DBIx/Class/Schema.pm
+++ b/lib/DBIx/Class/Schema.pm
@@ -205,7 +205,9 @@ sub load_classes {
         my $comp_class = "${prefix}::${comp}";
         eval "use $comp_class"; # If it fails, assume the user fixed it
         if ($@) {
-          die $@ unless $@ =~ /Can't locate/;
+         $comp_class =~ s/::/\//g;
+          die $@ unless $@ =~ /Can't locate.+$comp_class\.pm\sin\s\@INC/;
+         warn $@ if $@;
         }
         push(@to_register, [ $comp, $comp_class ]);
       }
@@ -289,14 +291,19 @@ sub compose_namespace {
   my %target;
   my %map;
   my $schema = $self->clone;
-  foreach my $moniker ($schema->sources) {
-    my $source = $schema->source($moniker);
-    my $target_class = "${target}::${moniker}";
-    $self->inject_base(
-      $target_class => $source->result_class, ($base ? $base : ())
-    );
-    $source->result_class($target_class);
+  {
+    no warnings qw/redefine/;
+    local *Class::C3::reinitialize = sub { };
+    foreach my $moniker ($schema->sources) {
+      my $source = $schema->source($moniker);
+      my $target_class = "${target}::${moniker}";
+      $self->inject_base(
+        $target_class => $source->result_class, ($base ? $base : ())
+      );
+      $source->result_class($target_class);
+    }
   }
+  Class::C3->reinitialize();
   {
     no strict 'refs';
     foreach my $meth (qw/class source resultset/) {
@@ -335,6 +342,7 @@ the schema.
 
 sub connection {
   my ($self, @info) = @_;
+  return $self if !@info && $self->storage;
   my $storage_class = $self->storage_type;
   $storage_class = 'DBIx::Class::Storage'.$storage_class
     if $storage_class =~ m/^::/;
@@ -513,11 +521,13 @@ sub populate {
   my ($self, $name, $data) = @_;
   my $rs = $self->resultset($name);
   my @names = @{shift(@$data)};
+  my @created;
   foreach my $item (@$data) {
     my %create;
     @create{@names} = @$item;
-    $rs->create(\%create);
+    push(@created, $rs->create(\%create));
   }
+  return @created;
 }
 
 =head2 throw_exception
@@ -538,9 +548,9 @@ Attempts to deploy the schema to the current storage
 =cut
 
 sub deploy {
-  my ($self) = shift;
+  my ($self, $sqltargs) = @_;
   $self->throw_exception("Can't deploy without storage") unless $self->storage;
-  $self->storage->deploy($self);
+  $self->storage->deploy($self, undef, $sqltargs);
 }
 
 1;