reverted back to previous compose_namespace method with minor change
[dbsrgits/DBIx-Class.git] / lib / DBIx / Class / Schema.pm
index db2a8f6..3e9d93e 100644 (file)
@@ -7,6 +7,7 @@ use DBIx::Class::Exception;
 use Carp::Clan qw/^DBIx::Class/;
 use Scalar::Util qw/weaken/;
 use File::Spec;
+use Sub::Name ();
 require Module::Find;
 
 use base qw/DBIx::Class/;
@@ -17,6 +18,7 @@ __PACKAGE__->mk_classdata('storage_type' => '::DBI');
 __PACKAGE__->mk_classdata('storage');
 __PACKAGE__->mk_classdata('exception_action');
 __PACKAGE__->mk_classdata('stacktrace' => $ENV{DBIC_TRACE} || 0);
+__PACKAGE__->mk_classdata('default_resultset_attributes' => {});
 
 =head1 NAME
 
@@ -95,7 +97,32 @@ moniker.
 =cut
 
 sub register_source {
-  my ($self, $moniker, $source) = @_;
+  my $self = shift;
+
+  $self->_register_source(@_);
+}
+
+=head2 register_extra_source
+
+=over 4
+
+=item Arguments: $moniker, $result_source
+
+=back
+
+As L</register_source> but should be used if the result class already 
+has a source and you want to register an extra one.
+
+=cut
+
+sub register_extra_source {
+  my $self = shift;
+
+  $self->_register_source(@_, { extra => 1 });
+}
+
+sub _register_source {
+  my ($self, $moniker, $source, $params) = @_;
 
   %$source = %{ $source->new( { %$source, source_name => $moniker }) };
 
@@ -104,10 +131,14 @@ sub register_source {
   $self->source_registrations(\%reg);
 
   $source->schema($self);
-
   weaken($source->{schema}) if ref($self);
+  return if ($params->{extra});
+
   if ($source->result_class) {
     my %map = %{$self->class_mappings};
+    if (exists $map{$source->result_class}) {
+      warn $source->result_class . ' already has a source, use register_extra_source for additional sources';
+    }
     $map{$source->result_class} = $moniker;
     $self->class_mappings(\%map);
   }
@@ -483,7 +514,9 @@ DEPRECATED. You probably wanted compose_namespace.
 
 Actually, you probably just wanted to call connect.
 
-=for hidden due to deprecation
+=begin hidden
+
+(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,
@@ -497,6 +530,8 @@ L<DBIx::Class::Schema/connect> and use the resulting schema object to operate
 on L<DBIx::Class::ResultSet> objects with L<DBIx::Class::Schema/resultset> for
 more information.
 
+=end hidden
+
 =cut
 
 {
@@ -530,7 +565,8 @@ more information.
     my $schema = $self->compose_namespace($target, $base);
     {
       no strict 'refs';
-      *{"${target}::schema"} = sub { $schema };
+      my $name = join '::', $target, 'schema';
+      *$name = Sub::Name::subname $name, sub { $schema };
     }
   
     $schema->connection(@info);
@@ -579,12 +615,31 @@ will produce the output
 
 =cut
 
+# this might be oversimplified
+# sub compose_namespace {
+#   my ($self, $target, $base) = @_;
+
+#   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);
+#     $target_class->result_source_instance($source)
+#       if $target_class->can('result_source_instance');
+#     $schema->register_source($moniker, $source);
+#   }
+#   return $schema;
+# }
+
 sub compose_namespace {
   my ($self, $target, $base) = @_;
   my $schema = $self->clone;
   {
     no warnings qw/redefine/;
-    local *Class::C3::reinitialize = sub { };
+#    local *Class::C3::reinitialize = sub { };
     foreach my $moniker ($schema->sources) {
       my $source = $schema->source($moniker);
       my $target_class = "${target}::${moniker}";
@@ -594,11 +649,13 @@ sub compose_namespace {
       $source->result_class($target_class);
       $target_class->result_source_instance($source)
         if $target_class->can('result_source_instance');
+     $schema->register_source($moniker, $source);
     }
   }
-  Class::C3->reinitialize();
+#  Class::C3->reinitialize();
   {
     no strict 'refs';
+    no warnings 'redefine';
     foreach my $meth (qw/class source resultset/) {
       *{"${target}::${meth}"} =
         sub { shift->schema->$meth(@_) };
@@ -607,19 +664,6 @@ sub compose_namespace {
   return $schema;
 }
 
-=head2 setup_connection_class
-
-=over 4
-
-=item Arguments: $target, @info
-
-=back
-
-Sets up a database connection class to inject between the schema and the
-subclasses that the schema creates.
-
-=cut
-
 sub setup_connection_class {
   my ($class, $target, @info) = @_;
   $class->inject_base($target => 'DBIx::Class::DB');
@@ -631,9 +675,9 @@ sub setup_connection_class {
 
 =over 4
 
-=item Arguments: $storage_type
+=item Arguments: $storage_type|{$storage_type, \%args}
 
-=item Return Value: $storage_type
+=item Return Value: $storage_type|{$storage_type, \%args}
 
 =back
 
@@ -647,6 +691,13 @@ 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>.
 
+If your storage type requires instantiation arguments, those are defined as a 
+second argument in the form of a hashref and the entire value needs to be
+wrapped into an arrayref or a hashref.  We support both types of refs here in
+order to play nice with your Config::[class] or your choice.
+
+See L<DBIx::Class::Storage::DBI::Replicated> for an example of this.
+
 =head2 connection
 
 =over 4
@@ -669,19 +720,33 @@ or L<DBIx::Class::Storage> in general.
 sub connection {
   my ($self, @info) = @_;
   return $self if !@info && $self->storage;
-  my $storage_class = $self->storage_type;
+  
+  my ($storage_class, $args) = ref $self->storage_type ? 
+    ($self->_normalize_storage_type($self->storage_type),{}) : ($self->storage_type, {});
+    
   $storage_class = 'DBIx::Class::Storage'.$storage_class
     if $storage_class =~ m/^::/;
   eval "require ${storage_class};";
   $self->throw_exception(
     "No arguments to load_classes and couldn't load ${storage_class} ($@)"
   ) if $@;
-  my $storage = $storage_class->new($self);
+  my $storage = $storage_class->new($self=>$args);
   $storage->connect_info(\@info);
   $self->storage($storage);
   return $self;
 }
 
+sub _normalize_storage_type {
+  my ($self, $storage_type) = @_;
+  if(ref $storage_type eq 'ARRAY') {
+    return @$storage_type;
+  } elsif(ref $storage_type eq 'HASH') {
+    return %$storage_type;
+  } else {
+    $self->throw_exception('Unsupported REFTYPE given: '. ref $storage_type);
+  }
+}
+
 =head2 connect
 
 =over 4
@@ -728,6 +793,22 @@ sub txn_do {
   $self->storage->txn_do(@_);
 }
 
+=head2 txn_scope_guard (EXPERIMENTAL)
+
+Runs C<txn_scope_guard> on the schema's storage. See 
+L<DBIx::Class::Storage/txn_scope_guard>.
+
+=cut
+
+sub txn_scope_guard {
+  my $self = shift;
+
+  $self->storage or $self->throw_exception
+    ('txn_scope_guard called on $schema without storage');
+
+  $self->storage->txn_scope_guard(@_);
+}
+
 =head2 txn_begin
 
 Begins a transaction (does nothing if AutoCommit is off). Equivalent to
@@ -779,6 +860,57 @@ sub txn_rollback {
   $self->storage->txn_rollback;
 }
 
+=head2 svp_begin
+
+Creates a new savepoint (does nothing outside a transaction). 
+Equivalent to calling $schema->storage->svp_begin.  See
+L<DBIx::Class::Storage::DBI/"svp_begin"> for more information.
+
+=cut
+
+sub svp_begin {
+  my ($self, $name) = @_;
+
+  $self->storage or $self->throw_exception
+    ('svp_begin called on $schema without storage');
+
+  $self->storage->svp_begin($name);
+}
+
+=head2 svp_release
+
+Releases a savepoint (does nothing outside a transaction). 
+Equivalent to calling $schema->storage->svp_release.  See
+L<DBIx::Class::Storage::DBI/"svp_release"> for more information.
+
+=cut
+
+sub svp_release {
+  my ($self, $name) = @_;
+
+  $self->storage or $self->throw_exception
+    ('svp_release called on $schema without storage');
+
+  $self->storage->svp_release($name);
+}
+
+=head2 svp_rollback
+
+Rollback to a savepoint (does nothing outside a transaction). 
+Equivalent to calling $schema->storage->svp_rollback.  See
+L<DBIx::Class::Storage::DBI/"svp_rollback"> for more information.
+
+=cut
+
+sub svp_rollback {
+  my ($self, $name) = @_;
+
+  $self->storage or $self->throw_exception
+    ('svp_rollback called on $schema without storage');
+
+  $self->storage->svp_rollback($name);
+}
+
 =head2 clone
 
 =over 4
@@ -797,10 +929,14 @@ sub clone {
   my $clone = { (ref $self ? %$self : ()) };
   bless $clone, (ref $self || $self);
 
+  $clone->class_mappings({ %{$clone->class_mappings} });
+  $clone->source_registrations({ %{$clone->source_registrations} });
   foreach my $moniker ($self->sources) {
     my $source = $self->source($moniker);
     my $new = $source->new($source);
-    $clone->register_source($moniker => $new);
+    # we use extra here as we want to leave the class_mappings as they are
+    # but overwrite the source_registrations entry with the new source
+    $clone->register_extra_source($moniker => $new);
   }
   $clone->storage->set_schema($clone) if $clone->storage;
   return $clone;
@@ -835,6 +971,18 @@ i.e.,
     [ 2, 'Indie Band' ],
     ...
   ]);
+  
+Since wantarray context is basically the same as looping over $rs->create(...) 
+you won't see any performance benefits and in this case the method is more for
+convenience. Void context sends the column information directly to storage
+using <DBI>s bulk insert method. So the performance will be much better for 
+storages that support this method.
+
+Because of this difference in the way void context inserts rows into your 
+database you need to note how this will effect any loaded components that
+override or augment insert.  For example if you are using a component such 
+as L<DBIx::Class::UUIDColumns> to populate your primary keys you MUST use 
+wantarray context if you want the PKs automatically created.
 
 =cut
 
@@ -928,7 +1076,7 @@ sub throw_exception {
     if !$self->exception_action || !$self->exception_action->(@_);
 }
 
-=head2 deploy (EXPERIMENTAL)
+=head2 deploy
 
 =over 4
 
@@ -938,17 +1086,15 @@ 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. 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.
+only the sources listed will get deployed. Furthermore, you can use the
+C<add_fk_index> parser parameter to prevent the parser from creating an index for each
+FK.
 
 =cut
 
@@ -958,6 +1104,30 @@ sub deploy {
   $self->storage->deploy($self, undef, $sqltargs, $dir);
 }
 
+=head2 deployment_statements
+
+=over 4
+
+=item Arguments: $rdbms_type
+
+=back
+
+Returns the SQL statements used by L</deploy> and L<DBIx::Class::Schema/deploy>.
+C<$rdbms_type> provides the DBI database driver name for which the SQL
+statements are produced. If not supplied, the type of the current schema storage
+will be used.
+
+=cut
+
+sub deployment_statements {
+  my ($self, $rdbms_type) = @_;
+
+  $self->throw_exception("Can't generate deployment statements without a storage")
+    if not $self->storage;
+
+  $self->storage->deployment_statements($self, $rdbms_type);
+}
+
 =head2 create_ddl_dir (EXPERIMENTAL)
 
 =over 4
@@ -978,6 +1148,8 @@ override this method in your schema if you would like a different file
 name format. For the ALTER file, the same format is used, replacing
 $version in the name with "$preversion-$version".
 
+See L<DBIx::Class::Schema/deploy> for details of $sqlt_args.
+
 If no arguments are passed, then the following default values are used:
 
 =over 4
@@ -1006,15 +1178,15 @@ sub create_ddl_dir {
   $self->storage->create_ddl_dir($self, @_);
 }
 
-=head2 ddl_filename (EXPERIMENTAL)
+=head2 ddl_filename
 
 =over 4
 
-=item Arguments: $directory, $database-type, $version, $preversion
+=item Arguments: $database-type, $version, $directory, $preversion
 
 =back
 
-  my $filename = $table->ddl_filename($type, $dir, $version, $preversion)
+  my $filename = $table->ddl_filename($type, $version, $dir, $preversion)
 
 This method is called by C<create_ddl_dir> to compose a file name out of
 the supplied directory, database type and version number. The default file
@@ -1026,14 +1198,84 @@ format.
 =cut
 
 sub ddl_filename {
-    my ($self, $type, $dir, $version, $pversion) = @_;
+  my ($self, $type, $version, $dir, $preversion) = @_;
+
+  my $filename = ref($self);
+  $filename =~ s/::/-/g;
+  $filename = File::Spec->catfile($dir, "$filename-$version-$type.sql");
+  $filename =~ s/$version/$preversion-$version/ if($preversion);
+  
+  return $filename;
+}
+
+=head2 sqlt_deploy_hook($sqlt_schema)
+
+An optional sub which you can declare in your own Schema class that will get 
+passed the L<SQL::Translator::Schema> object when you deploy the schema via
+L</create_ddl_dir> or L</deploy>.
+
+For an example of what you can do with this, see 
+L<DBIx::Class::Manual::Cookbook/Adding Indexes And Functions To Your SQL>.
+
+=head2 thaw
+
+Provided as the recommened way of thawing schema objects. You can call 
+C<Storable::thaw> directly if you wish, but the thawed objects will not have a
+reference to any schema, so are rather useless
+
+=cut
+
+sub thaw {
+  my ($self, $obj) = @_;
+  local $DBIx::Class::ResultSourceHandle::thaw_schema = $self;
+  return Storable::thaw($obj);
+}
+
+=head2 freeze
+
+This doesn't actualy do anything more than call L<Storable/freeze>, it is just
+provided here for symetry.
+
+=cut
+
+sub freeze {
+  return Storable::freeze($_[1]);
+}
+
+=head2 dclone
+
+Recommeneded way of dcloning objects. This is needed to properly maintain
+references to the schema object (which itself is B<not> cloned.)
+
+=cut
+
+sub dclone {
+  my ($self, $obj) = @_;
+  local $DBIx::Class::ResultSourceHandle::thaw_schema = $self;
+  return Storable::dclone($obj);
+}
+
+=head2 schema_version
 
-    my $filename = ref($self);
-    $filename =~ s/::/-/g;
-    $filename = File::Spec->catfile($dir, "$filename-$version-$type.sql");
-    $filename =~ s/$version/$pversion-$version/ if($pversion);
+Returns the current schema class' $VERSION
 
-    return $filename;
+=cut
+
+sub schema_version {
+  my ($self) = @_;
+  my $class = ref($self)||$self;
+
+  # does -not- use $schema->VERSION
+  # since that varies in results depending on if version.pm is installed, and if
+  # so the perl or XS versions. If you want this to change, bug the version.pm
+  # author to make vpp and vxs behave the same.
+
+  my $version;
+  {
+    no strict 'refs';
+    $version = ${"${class}::VERSION"};
+  }
+  return $version;
 }
 
 1;