Added multi-create object support to Schema->populate and created a test for this...
[dbsrgits/DBIx-Class.git] / lib / DBIx / Class / Schema.pm
index 5b53140..db2a8f6 100644 (file)
@@ -3,6 +3,7 @@ package DBIx::Class::Schema;
 use strict;
 use warnings;
 
+use DBIx::Class::Exception;
 use Carp::Clan qw/^DBIx::Class/;
 use Scalar::Util qw/weaken/;
 use File::Spec;
@@ -15,6 +16,7 @@ __PACKAGE__->mk_classdata('source_registrations' => {});
 __PACKAGE__->mk_classdata('storage_type' => '::DBI');
 __PACKAGE__->mk_classdata('storage');
 __PACKAGE__->mk_classdata('exception_action');
+__PACKAGE__->mk_classdata('stacktrace' => $ENV{DBIC_TRACE} || 0);
 
 =head1 NAME
 
@@ -94,10 +96,15 @@ moniker.
 
 sub register_source {
   my ($self, $moniker, $source) = @_;
+
+  %$source = %{ $source->new( { %$source, source_name => $moniker }) };
+
   my %reg = %{$self->source_registrations};
   $reg{$moniker} = $source;
   $self->source_registrations(\%reg);
+
   $source->schema($self);
+
   weaken($source->{schema}) if ref($self);
   if ($source->result_class) {
     my %map = %{$self->class_mappings};
@@ -106,6 +113,19 @@ sub register_source {
   }
 }
 
+sub _unregister_source {
+    my ($self, $moniker) = @_;
+    my %reg = %{$self->source_registrations}; 
+
+    my $source = delete $reg{$moniker};
+    $self->source_registrations(\%reg);
+    if ($source->result_class) {
+        my %map = %{$self->class_mappings};
+        delete $map{$source->result_class};
+        $self->class_mappings(\%map);
+    }
+}
+
 =head2 class
 
 =over 4
@@ -276,9 +296,10 @@ sub load_classes {
           }
         }
         $class->ensure_class_loaded($comp_class);
-        $comp_class->source_name($comp) unless $comp_class->source_name;
 
-        push(@to_register, [ $comp_class->source_name, $comp_class ]);
+        $comp = $comp_class->source_name || $comp;
+#  $DB::single = 1;
+        push(@to_register, [ $comp, $comp_class ]);
       }
     }
   }
@@ -448,7 +469,7 @@ sub load_namespaces {
   return;
 }
 
-=head2 compose_connection
+=head2 compose_connection (DEPRECATED)
 
 =over 4
 
@@ -458,6 +479,12 @@ sub load_namespaces {
 
 =back
 
+DEPRECATED. You probably wanted compose_namespace.
+
+Actually, you probably just wanted to call connect.
+
+=for hidden due to deprecation
+
 Calls L<DBIx::Class::Schema/"compose_namespace"> to the target namespace,
 calls L<DBIx::Class::Schema/connection> with @db_info on the new schema,
 then injects the L<DBix::Class::ResultSetProxy> component and a
@@ -472,43 +499,51 @@ more information.
 
 =cut
 
-sub compose_connection {
-  my ($self, $target, @info) = @_;
-  my $base = 'DBIx::Class::ResultSetProxy';
-  eval "require ${base};";
-  $self->throw_exception
-    ("No arguments to load_classes and couldn't load ${base} ($@)")
-      if $@;
-
-  if ($self eq $target) {
-    # Pathological case, largely caused by the docs on early C::M::DBIC::Plain
-    foreach my $moniker ($self->sources) {
-      my $source = $self->source($moniker);
+{
+  my $warn;
+
+  sub compose_connection {
+    my ($self, $target, @info) = @_;
+
+    warn "compose_connection deprecated as of 0.08000"
+      unless ($INC{"DBIx/Class/CDBICompat.pm"} || $warn++);
+
+    my $base = 'DBIx::Class::ResultSetProxy';
+    eval "require ${base};";
+    $self->throw_exception
+      ("No arguments to load_classes and couldn't load ${base} ($@)")
+        if $@;
+  
+    if ($self eq $target) {
+      # Pathological case, largely caused by the docs on early C::M::DBIC::Plain
+      foreach my $moniker ($self->sources) {
+        my $source = $self->source($moniker);
+        my $class = $source->result_class;
+        $self->inject_base($class, $base);
+        $class->mk_classdata(resultset_instance => $source->resultset);
+        $class->mk_classdata(class_resolver => $self);
+      }
+      $self->connection(@info);
+      return $self;
+    }
+  
+    my $schema = $self->compose_namespace($target, $base);
+    {
+      no strict 'refs';
+      *{"${target}::schema"} = sub { $schema };
+    }
+  
+    $schema->connection(@info);
+    foreach my $moniker ($schema->sources) {
+      my $source = $schema->source($moniker);
       my $class = $source->result_class;
-      $self->inject_base($class, $base);
+      #warn "$moniker $class $source ".$source->storage;
+      $class->mk_classdata(result_source_instance => $source);
       $class->mk_classdata(resultset_instance => $source->resultset);
-      $class->mk_classdata(class_resolver => $self);
+      $class->mk_classdata(class_resolver => $schema);
     }
-    $self->connection(@info);
-    return $self;
+    return $schema;
   }
-
-  my $schema = $self->compose_namespace($target, $base);
-  {
-    no strict 'refs';
-    *{"${target}::schema"} = sub { $schema };
-  }
-
-  $schema->connection(@info);
-  foreach my $moniker ($schema->sources) {
-    my $source = $schema->source($moniker);
-    my $class = $source->result_class;
-    #warn "$moniker $class $source ".$source->storage;
-    $class->mk_classdata(result_source_instance => $source);
-    $class->mk_classdata(resultset_instance => $source->resultset);
-    $class->mk_classdata(class_resolver => $schema);
-  }
-  return $schema;
 }
 
 =head2 compose_namespace
@@ -546,9 +581,6 @@ will produce the output
 
 sub compose_namespace {
   my ($self, $target, $base) = @_;
-  my %reg = %{ $self->source_registrations };
-  my %target;
-  my %map;
   my $schema = $self->clone;
   {
     no warnings qw/redefine/;
@@ -647,7 +679,6 @@ sub connection {
   my $storage = $storage_class->new($self);
   $storage->connect_info(\@info);
   $self->storage($storage);
-  $self->on_connect() if($self->can('on_connect'));
   return $self;
 }
 
@@ -820,7 +851,15 @@ sub populate {
     }
     return @created;
   }
-  $self->storage->insert_bulk($self->source($name)->from, \@names, $data);
+  my @results_to_create;
+  foreach my $datum (@$data) {
+    my %result_to_create;
+    foreach my $index (0..$#names) {
+      $result_to_create{$names[$index]} = $$datum[$index];
+    }
+    push @results_to_create, \%result_to_create;
+  }
+  $rs->populate(\@results_to_create);
 }
 
 =head2 exception_action
@@ -833,7 +872,7 @@ sub populate {
 
 If C<exception_action> is set for this class/object, L</throw_exception>
 will prefer to call this code reference with the exception as an argument,
-rather than its normal <croak> action.
+rather than its normal C<croak> or C<confess> action.
 
 Your subroutine should probably just wrap the error in the exception
 object/class of your choosing and rethrow.  If, against all sage advice,
@@ -855,6 +894,18 @@ Example:
    # suppress all exceptions, like a moron:
    $schema_obj->exception_action(sub { 1 });
 
+=head2 stacktrace
+
+=over 4
+
+=item Arguments: boolean
+
+=back
+
+Whether L</throw_exception> should include stack trace information.
+Defaults to false normally, but defaults to true if C<$ENV{DBIC_TRACE}>
+is true.
+
 =head2 throw_exception
 
 =over 4
@@ -865,13 +916,16 @@ Example:
 
 Throws an exception. Defaults to using L<Carp::Clan> to report errors from
 user's perspective.  See L</exception_action> for details on overriding
-this method's behavior.
+this method's behavior.  If L</stacktrace> is turned on, C<throw_exception>'s
+default behavior will provide a detailed stack trace.
 
 =cut
 
 sub throw_exception {
   my $self = shift;
-  croak @_ if !$self->exception_action || !$self->exception_action->(@_);
+
+  DBIx::Class::Exception->throw($_[0], $self->stacktrace)
+    if !$self->exception_action || !$self->exception_action->(@_);
 }
 
 =head2 deploy (EXPERIMENTAL)
@@ -885,12 +939,17 @@ sub throw_exception {
 Attempts to deploy the schema to the current storage using L<SQL::Translator>.
 
 Note that this feature is currently EXPERIMENTAL and may not work correctly
-across all databases, or fully handle complex relationships.
+across all databases, or fully handle complex relationships. Saying that, it
+has been used successfully by many people, including the core dev team.
 
 See L<SQL::Translator/METHODS> for a list of values for C<$sqlt_args>. The most
 common value for this would be C<< { add_drop_table => 1, } >> to have the SQL
 produced include a DROP TABLE statement for each table created.
 
+Additionally, the DBIx::Class parser accepts a C<sources> parameter as a hash 
+ref or an array ref, containing a list of source to deploy. If present, then 
+only the sources listed will get deployed.
+
 =cut
 
 sub deploy {
@@ -970,7 +1029,7 @@ sub ddl_filename {
     my ($self, $type, $dir, $version, $pversion) = @_;
 
     my $filename = ref($self);
-    $filename =~ s/::/-/;
+    $filename =~ s/::/-/g;
     $filename = File::Spec->catfile($dir, "$filename-$version-$type.sql");
     $filename =~ s/$version/$pversion-$version/ if($pversion);