X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FDBIx%2FClass%2FSchema.pm;h=4b945cc7aeb9c546ce5deecc1cf4c5bb1e56eab3;hb=109765190925eacd136c768c02c8fac580e4aadd;hp=b6ab5f48a8210a6f8089c0ae7a1c31d7af5f1100;hpb=f340505818aff7213d79ca814c73381832e14185;p=dbsrgits%2FDBIx-Class.git diff --git a/lib/DBIx/Class/Schema.pm b/lib/DBIx/Class/Schema.pm index b6ab5f4..4b945cc 100644 --- a/lib/DBIx/Class/Schema.pm +++ b/lib/DBIx/Class/Schema.pm @@ -173,8 +173,8 @@ sub _findallmod { } # returns a hash of $shortname => $fullname for every package -# found in the given namespaces ($shortname is with the $fullname's -# namespace stripped off) +# found in the given namespaces ($shortname is with the $fullname's +# namespace stripped off) sub _map_namespaces { my ($class, @namespaces) = @_; @@ -190,6 +190,22 @@ sub _map_namespaces { @results_hash; } +# returns the result_source_instance for the passed class/object, +# or dies with an informative message (used by load_namespaces) +sub _ns_get_rsrc_instance { + my $class = shift; + my $rs = ref ($_[0]) || $_[0]; + + if ($rs->can ('result_source_instance') ) { + return $rs->result_source_instance; + } + else { + $class->throw_exception ( + "Attempt to load_namespaces() class $rs failed - are you sure this is a real Result Class?" + ); + } +} + sub load_namespaces { my ($class, %args) = @_; @@ -231,27 +247,27 @@ sub load_namespaces { my $result_class = $results{$result}; my $rs_class = delete $resultsets{$result}; - my $rs_set = $result_class->resultset_class; + my $rs_set = $class->_ns_get_rsrc_instance ($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 " + carp "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); + $class->_ns_get_rsrc_instance ($result_class)->resultset_class($rs_class); } - my $source_name = $result_class->source_name || $result; + my $source_name = $class->_ns_get_rsrc_instance ($result_class)->source_name || $result; push(@to_register, [ $source_name, $result_class ]); } } foreach (sort keys %resultsets) { - warn "load_namespaces found ResultSet class $_ with no " + carp "load_namespaces found ResultSet class $_ with no " . 'corresponding Result class'; } @@ -344,7 +360,7 @@ sub load_classes { my $snsub = $comp_class->can('source_name'); if(! $snsub ) { - warn "Failed to load $comp_class. Can't find source_name method. Is $comp_class really a full DBIC result class? Fix it, move it elsewhere, or make your load_classes call more specific."; + carp "Failed to load $comp_class. Can't find source_name method. Is $comp_class really a full DBIC result class? Fix it, move it elsewhere, or make your load_classes call more specific."; next; } $comp = $snsub->($comp_class) || $comp; @@ -483,6 +499,12 @@ Note that C expects an arrayref of arguments, but C does not. C wraps it's arguments in an arrayref before passing them to C. +=head3 Overloading + +C is a convenience method. It is equivalent to calling +$schema->clone->connection(@connectinfo). To write your own overloaded +version, overload L instead. + =cut sub connect { shift->clone->connection(@_) } @@ -611,7 +633,7 @@ sub txn_do { $self->storage->txn_do(@_); } -=head2 txn_scope_guard (EXPERIMENTAL) +=head2 txn_scope_guard Runs C on the schema's storage. See L. @@ -760,6 +782,9 @@ Similar to L except sets the storage object and connection data in-place on the Schema class. You should probably be calling L to get a proper Schema object instead. +=head3 Overloading + +Overload C to change the behaviour of C. =cut @@ -990,15 +1015,17 @@ sub throw_exception { =over 4 -=item Arguments: $sqlt_args, $dir +=item Arguments: \%sqlt_args, $dir =back Attempts to deploy the schema to the current storage using L. -See L 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. +See L 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 C statement for each table +created. For quoting purposes supply C and +C. Additionally, the DBIx::Class parser accepts a C parameter as a hash ref or an array ref, containing a list of source to deploy. If present, then @@ -1018,19 +1045,16 @@ sub deploy { =over 4 -=item Arguments: $rdbms_type, $sqlt_args, $dir +=item Arguments: See L =item Return value: $listofstatements =back -A convenient shortcut to storage->deployment_statements(). Returns the -SQL statements used by L and -L. C<$rdbms_type> provides the -(optional) SQLT (not DBI) database driver name for which the SQL -statements are produced. If not supplied, the type is determined by -interrogating the current connection. The other two arguments are -identical to those of L. +A convenient shortcut to +C<< $self->storage->deployment_statements($self, @args) >>. +Returns the SQL statements used by L and +L. =cut @@ -1047,42 +1071,15 @@ sub deployment_statements { =over 4 -=item Arguments: \@databases, $version, $directory, $preversion, $sqlt_args +=item Arguments: See L =back -Creates an SQL file based on the Schema, for each of the specified -database types, in the given directory. Given a previous version number, -this will also create a file containing the ALTER TABLE statements to -transform the previous schema into the current one. Note that these -statements may contain DROP TABLE or DROP COLUMN statements that can -potentially destroy data. - -The file names are created using the C method below, please -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 for details of $sqlt_args. - -If no arguments are passed, then the following default values are used: - -=over 4 - -=item databases - ['MySQL', 'SQLite', 'PostgreSQL'] +A convenient shortcut to +C<< $self->storage->create_ddl_dir($self, @args) >>. -=item version - $schema->schema_version - -=item directory - './' - -=item preversion - - -=back - -Note that this feature is currently EXPERIMENTAL and may not work correctly -across all databases, or fully handle complex relationships. - -WARNING: Please check all SQL files created, before applying them. +Creates an SQL file based on the Schema, for each of the specified +database types, in the given directory. =cut @@ -1256,24 +1253,33 @@ sub register_extra_source { sub _register_source { my ($self, $moniker, $source, $params) = @_; + my $orig_source = $source; + $source = $source->new({ %$source, source_name => $moniker }); + $source->schema($self); + weaken($source->{schema}) if ref($self); + + my $rs_class = $source->result_class; my %reg = %{$self->source_registrations}; $reg{$moniker} = $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); + return unless defined($rs_class) && $rs_class->can('result_source_instance'); + + my %map = %{$self->class_mappings}; + if ( + exists $map{$rs_class} + and + $map{$rs_class} ne $moniker + and + $rs_class->result_source_instance ne $orig_source + ) { + carp "$rs_class already has a source, use register_extra_source for additional sources"; } + $map{$rs_class} = $moniker; + $self->class_mappings(\%map); } sub _unregister_source { @@ -1330,7 +1336,7 @@ more information. sub compose_connection { my ($self, $target, @info) = @_; - warn "compose_connection deprecated as of 0.08000" + carp "compose_connection deprecated as of 0.08000" unless ($INC{"DBIx/Class/CDBICompat.pm"} || $warn++); my $base = 'DBIx::Class::ResultSetProxy';