moved tests to compose_namespace instead of compose_connection, marked compose_connec...
[dbsrgits/DBIx-Class.git] / lib / DBIx / Class / Schema.pm
index 1945f65..77bd865 100644 (file)
@@ -5,6 +5,7 @@ use warnings;
 
 use Carp::Clan qw/^DBIx::Class/;
 use Scalar::Util qw/weaken/;
+require Module::Find;
 
 use base qw/DBIx::Class/;
 
@@ -170,6 +171,12 @@ For example:
 
 sub sources { return keys %{shift->source_registrations}; }
 
+=head2 storage
+
+  my $storage = $schema->storage;
+
+Returns the L<DBIx::Class::Storage> object for this Schema.
+
 =head2 resultset
 
 =over 4
@@ -248,10 +255,6 @@ sub load_classes {
       }
     }
   } else {
-    eval "require Module::Find;";
-    $class->throw_exception(
-      "No arguments to load_classes and couldn't load Module::Find ($@)"
-    ) if $@;
     my @comp = map { substr $_, length "${class}::"  }
                  Module::Find::findallmod($class);
     $comps_for{$class} = \@comp;
@@ -264,6 +267,13 @@ sub load_classes {
     foreach my $prefix (keys %comps_for) {
       foreach my $comp (@{$comps_for{$prefix}||[]}) {
         my $comp_class = "${prefix}::${comp}";
+        { # try to untaint module name. mods where this fails
+          # are left alone so we don't have to change the old behavior
+          no locale; # localized \w doesn't untaint expression
+          if ( $comp_class =~ m/^( (?:\w+::)* \w+ )$/x ) {
+            $comp_class = $1;
+          }
+        }
         $class->ensure_class_loaded($comp_class);
         $comp_class->source_name($comp) unless $comp_class->source_name;
 
@@ -279,7 +289,165 @@ sub load_classes {
   }
 }
 
-=head2 compose_connection
+=head2 load_namespaces
+
+=over 4
+
+=item Arguments: %options?
+
+=back
+
+This is an alternative to L</load_classes> above which assumes an alternative
+layout for automatic class loading.  It assumes that all result
+classes are underneath a sub-namespace of the schema called C<Result>, any
+corresponding ResultSet classes are underneath a sub-namespace of the schema
+called C<ResultSet>.
+
+Both of the sub-namespaces are configurable if you don't like the defaults,
+via the options C<result_namespace> and C<resultset_namespace>.
+
+If (and only if) you specify the option C<default_resultset_class>, any found
+Result classes for which we do not find a corresponding
+ResultSet class will have their C<resultset_class> set to
+C<default_resultset_class>.
+
+C<load_namespaces> takes care of calling C<resultset_class> for you where
+neccessary if you didn't do it for yourself.
+
+All of the namespace and classname options to this method are relative to
+the schema classname by default.  To specify a fully-qualified name, prefix
+it with a literal C<+>.
+
+Examples:
+
+  # load My::Schema::Result::CD, My::Schema::Result::Artist,
+  #    My::Schema::ResultSet::CD, etc...
+  My::Schema->load_namespaces;
+
+  # Override everything to use ugly names.
+  # In this example, if there is a My::Schema::Res::Foo, but no matching
+  #   My::Schema::RSets::Foo, then Foo will have its
+  #   resultset_class set to My::Schema::RSetBase
+  My::Schema->load_namespaces(
+    result_namespace => 'Res',
+    resultset_namespace => 'RSets',
+    default_resultset_class => 'RSetBase',
+  );
+
+  # Put things in other namespaces
+  My::Schema->load_namespaces(
+    result_namespace => '+Some::Place::Results',
+    resultset_namespace => '+Another::Place::RSets',
+  );
+
+If you'd like to use multiple namespaces of each type, simply use an arrayref
+of namespaces for that option.  In the case that the same result
+(or resultset) class exists in multiple namespaces, the latter entries in
+your list of namespaces will override earlier ones.
+
+  My::Schema->load_namespaces(
+    # My::Schema::Results_C::Foo takes precedence over My::Schema::Results_B::Foo :
+    result_namespace => [ 'Results_A', 'Results_B', 'Results_C' ],
+    resultset_namespace => [ '+Some::Place::RSets', 'RSets' ],
+  );
+
+=cut
+
+# Pre-pends our classname to the given relative classname or
+#   class namespace, unless there is a '+' prefix, which will
+#   be stripped.
+sub _expand_relative_name {
+  my ($class, $name) = @_;
+  return if !$name;
+  $name = $class . '::' . $name if ! ($name =~ s/^\+//);
+  return $name;
+}
+
+# returns a hash of $shortname => $fullname for every package
+#  found in the given namespaces ($shortname is with the $fullname's
+#  namespace stripped off)
+sub _map_namespaces {
+  my ($class, @namespaces) = @_;
+
+  my @results_hash;
+  foreach my $namespace (@namespaces) {
+    push(
+      @results_hash,
+      map { (substr($_, length "${namespace}::"), $_) }
+      Module::Find::findallmod($namespace)
+    );
+  }
+
+  @results_hash;
+}
+
+sub load_namespaces {
+  my ($class, %args) = @_;
+
+  my $result_namespace = delete $args{result_namespace} || 'Result';
+  my $resultset_namespace = delete $args{resultset_namespace} || 'ResultSet';
+  my $default_resultset_class = delete $args{default_resultset_class};
+
+  $class->throw_exception('load_namespaces: unknown option(s): '
+    . join(q{,}, map { qq{'$_'} } keys %args))
+      if scalar keys %args;
+
+  $default_resultset_class
+    = $class->_expand_relative_name($default_resultset_class);
+
+  for my $arg ($result_namespace, $resultset_namespace) {
+    $arg = [ $arg ] if !ref($arg) && $arg;
+
+    $class->throw_exception('load_namespaces: namespace arguments must be '
+      . 'a simple string or an arrayref')
+        if ref($arg) ne 'ARRAY';
+
+    $_ = $class->_expand_relative_name($_) for (@$arg);
+  }
+
+  my %results = $class->_map_namespaces(@$result_namespace);
+  my %resultsets = $class->_map_namespaces(@$resultset_namespace);
+
+  my @to_register;
+  {
+    no warnings 'redefine';
+    local *Class::C3::reinitialize = sub { };
+    use warnings 'redefine';
+
+    foreach my $result (keys %results) {
+      my $result_class = $results{$result};
+      $class->ensure_class_loaded($result_class);
+      $result_class->source_name($result) unless $result_class->source_name;
+
+      my $rs_class = delete $resultsets{$result};
+      my $rs_set = $result_class->resultset_class;
+      if($rs_set && $rs_set ne 'DBIx::Class::ResultSet') {
+        if($rs_class && $rs_class ne $rs_set) {
+          warn "We found ResultSet class '$rs_class' for '$result', but it seems "
+             . "that you had already set '$result' to use '$rs_set' instead";
+        }
+      }
+      elsif($rs_class ||= $default_resultset_class) {
+        $class->ensure_class_loaded($rs_class);
+        $result_class->resultset_class($rs_class);
+      }
+
+      push(@to_register, [ $result_class->source_name, $result_class ]);
+    }
+  }
+
+  foreach (sort keys %resultsets) {
+    warn "load_namespaces found ResultSet class $_ with no "
+      . 'corresponding Result class';
+  }
+
+  Class::C3->reinitialize;
+  $class->register_class(@$_) for (@to_register);
+
+  return;
+}
+
+=head2 compose_connection (DEPRECATED)
 
 =over 4
 
@@ -289,6 +457,12 @@ sub load_classes {
 
 =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
@@ -303,43 +477,50 @@ 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 $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
@@ -426,6 +607,26 @@ sub setup_connection_class {
   $target->connection(@info);
 }
 
+=head2 storage_type
+
+=over 4
+
+=item Arguments: $storage_type
+
+=item Return Value: $storage_type
+
+=back
+
+Set the storage class that will be instantiated when L</connect> is called.
+If the classname starts with C<::>, the prefix C<DBIx::Class::Storage> is
+assumed by L</connect>.  Defaults to C<::DBI>,
+which is L<DBIx::Class::Storage::DBI>.
+
+You want to use this to hardcoded subclasses of L<DBIx::Class::Storage::DBI>
+in cases where the appropriate subclass is not autodetected, such as when
+dealing with MSSQL via L<DBD::Sybase>, in which case you'd set it to
+C<::DBI::Sybase::MSSQL>.
+
 =head2 connection
 
 =over 4
@@ -589,13 +790,22 @@ sub clone {
 
 =over 4
 
-=item Arguments: $moniker, \@data;
+=item Arguments: $source_name, \@data;
 
 =back
 
-Populates the source registered with the given moniker with the supplied data.
-@data should be a list of listrefs -- the first containing column names, the
-second matching values.
+Pass this method a resultsource name, and an arrayref of
+arrayrefs. The arrayrefs should contain a list of column names,
+followed by one or many sets of matching data for the given columns. 
+
+In void context, C<insert_bulk> in L<DBIx::Class::Storage::DBI> is used
+to insert the data, as this is a fast method. However, insert_bulk currently
+assumes that your datasets all contain the same type of values, using scalar
+references in a column in one row, and not in another will probably not work.
+
+Otherwise, each set of data is inserted into the database using
+L<DBIx::Class::ResultSet/create>, and a arrayref of the resulting row
+objects is returned.
 
 i.e.,
 
@@ -612,13 +822,16 @@ 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;
-    push(@created, $rs->create(\%create));
+  if(defined wantarray) {
+    my @created;
+    foreach my $item (@$data) {
+      my %create;
+      @create{@names} = @$item;
+      push(@created, $rs->create(\%create));
+    }
+    return @created;
   }
-  return @created;
+  $self->storage->insert_bulk($self->source($name)->from, \@names, $data);
 }
 
 =head2 exception_action