X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FDBIx%2FClass%2FSchema.pm;h=415fd79984ec2b4af0418b06d17498a1d7fd6801;hb=0c11ad0ee5c8407f6b87d6e15c62a1b445076dc0;hp=77a7fe7e511d1eba2d9e71b20309f1949c7879b1;hpb=c3e9f7189094e94137356251c4f0b1f1cbfeb04a;p=dbsrgits%2FDBIx-Class.git diff --git a/lib/DBIx/Class/Schema.pm b/lib/DBIx/Class/Schema.pm index 77a7fe7..415fd79 100644 --- a/lib/DBIx/Class/Schema.pm +++ b/lib/DBIx/Class/Schema.pm @@ -4,13 +4,12 @@ use strict; use warnings; use DBIx::Class::Exception; -use Carp::Clan qw/^DBIx::Class|^Try::Tiny/; +use DBIx::Class::Carp; use Try::Tiny; -use Scalar::Util 'weaken'; -use File::Spec; +use Scalar::Util qw/weaken blessed/; use Sub::Name 'subname'; -use Module::Find(); -use Storable(); +use B 'svref_2object'; +use Devel::GlobalDestruction; use namespace::clean; use base qw/DBIx::Class/; @@ -78,20 +77,32 @@ particular which module inherits off which. __PACKAGE__->load_namespaces(); __PACKAGE__->load_namespaces( - result_namespace => 'Res', - resultset_namespace => 'RSet', - default_resultset_class => '+MyDB::Othernamespace::RSet', - ); + result_namespace => 'Res', + resultset_namespace => 'RSet', + default_resultset_class => '+MyDB::Othernamespace::RSet', + ); + +With no arguments, this method uses L to load all of the +Result and ResultSet classes under the namespace of the schema from +which it is called. For example, C will by default find +and load Result classes named C and ResultSet +classes named C. + +ResultSet classes are associated with Result class of the same name. +For example, C will get the ResultSet class +C if it is present. -With no arguments, this method uses L to load all your -Result classes from a sub-namespace F under your Schema class' -namespace, i.e. with a Schema of I all files in -I are assumed to be Result classes. +Both Result and ResultSet namespaces are configurable via the +C and C options. -It also finds all ResultSet classes in the namespace F and -loads them into the appropriate Result classes using for you. The -matching is done by assuming the package name of the ResultSet class -is the same as that of the Result class. +Another option, C specifies a custom default +ResultSet class for Result classes with no corresponding ResultSet. + +All of the namespace and classname options are by default relative to +the schema classname. To specify a fully-qualified name, prefix it +with a literal C<+>. For example, C<+Other::NameSpace::Result>. + +=head3 Warnings You will be warned if ResultSet classes are discovered for which there are no matching Result classes like this: @@ -104,19 +115,7 @@ L to some other class, you will be warned like this: We found ResultSet class '$rs_class' for '$result', but it seems that you had already set '$result' to use '$rs_set' instead -Both of the sub-namespaces are configurable if you don't like the defaults, -via the options C and C. - -If (and only if) you specify the option C, any found -Result classes for which we do not find a corresponding -ResultSet class will have their C set to -C. - -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: +=head3 Examples # load My::Schema::Result::CD, My::Schema::Result::Artist, # My::Schema::ResultSet::CD, etc... @@ -138,10 +137,10 @@ Examples: 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. +To search multiple namespaces for either Result or ResultSet classes, +use an arrayref of namespaces for that option. In the case that the +same result (or resultset) class exists in multiple namespaces, later +entries in the list of namespaces will override earlier ones. My::Schema->load_namespaces( # My::Schema::Results_C::Foo takes precedence over My::Schema::Results_B::Foo : @@ -168,12 +167,10 @@ sub _findallmod { my $proto = shift; my $ns = shift || ref $proto || $proto; - my @mods = Module::Find::findallmod($ns); + require Module::Find; - # try to untaint module names. 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 - return map { $_ =~ m/^( (?:\w+::)* \w+ )$/x ? $1 : $_ } @mods; + # untaint result + return map { $_ =~ /(.+)/ } Module::Find::findallmod($ns); } # returns a hash of $shortname => $fullname for every package @@ -197,17 +194,16 @@ sub _map_namespaces { # 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?" + my $me = shift; + my $rs_class = ref ($_[0]) || $_[0]; + + return try { + $rs_class->result_source_instance + } catch { + $me->throw_exception ( + "Attempt to load_namespaces() class $rs_class failed - are you sure this is a real Result Class?: $_" ); - } + }; } sub load_namespaces { @@ -239,12 +235,14 @@ sub load_namespaces { my @to_register; { - no warnings 'redefine'; - local *Class::C3::reinitialize = sub { }; - use warnings 'redefine'; + no warnings qw/redefine/; + local *Class::C3::reinitialize = sub { } if DBIx::Class::_ENV_::OLD_MRO; + use warnings qw/redefine/; # ensure classes are loaded and attached in inheritance order - $class->ensure_class_loaded($_) foreach(values %results); + for my $res (values %results) { + $class->ensure_class_loaded($res); + } my %inh_idx; my @subclass_last = sort { @@ -292,7 +290,8 @@ sub load_namespaces { . 'corresponding Result class'; } - Class::C3->reinitialize; + Class::C3->reinitialize if DBIx::Class::_ENV_::OLD_MRO; + $class->register_class(@$_) for (@to_register); return; @@ -375,7 +374,9 @@ sub load_classes { my @to_register; { no warnings qw/redefine/; - local *Class::C3::reinitialize = sub { }; + local *Class::C3::reinitialize = sub { } if DBIx::Class::_ENV_::OLD_MRO; + use warnings qw/redefine/; + foreach my $prefix (keys %comps_for) { foreach my $comp (@{$comps_for{$prefix}||[]}) { my $comp_class = "${prefix}::${comp}"; @@ -392,11 +393,10 @@ sub load_classes { } } } - Class::C3->reinitialize; + Class::C3->reinitialize if DBIx::Class::_ENV_::OLD_MRO; foreach my $to (@to_register) { $class->register_class(@$to); - # if $class->can('result_source_instance'); } } @@ -584,7 +584,13 @@ source name. =cut sub source { - my ($self, $moniker) = @_; + my $self = shift; + + $self->throw_exception("source() expects a source name") + unless @_; + + my $moniker = shift; + my $sreg = $self->source_registrations; return $sreg->{$moniker} if exists $sreg->{$moniker}; @@ -821,7 +827,7 @@ sub connection { } catch { $self->throw_exception( - "No arguments to load_classes and couldn't load ${storage_class} ($_)" + "Unable to load storage class ${storage_class}: $_" ); }; my $storage = $storage_class->new($self=>$args); @@ -895,31 +901,51 @@ will produce the output sub compose_namespace { my ($self, $target, $base) = @_; + my $schema = $self->clone; + + $schema->source_registrations({}); + + # the original class-mappings must remain - otherwise + # reverse_relationship_info will not work + #$schema->class_mappings({}); + { no warnings qw/redefine/; -# local *Class::C3::reinitialize = sub { }; - foreach my $moniker ($schema->sources) { - my $source = $schema->source($moniker); + local *Class::C3::reinitialize = sub { } if DBIx::Class::_ENV_::OLD_MRO; + use warnings qw/redefine/; + + no strict qw/refs/; + foreach my $moniker ($self->sources) { + my $orig_source = $self->source($moniker); + my $target_class = "${target}::${moniker}"; - $self->inject_base( - $target_class => $source->result_class, ($base ? $base : ()) + $self->inject_base($target_class, $orig_source->result_class, ($base || ()) ); + + # register_source examines result_class, and then returns us a clone + my $new_source = $schema->register_source($moniker, bless + { %$orig_source, result_class => $target_class }, + ref $orig_source, ); - $source->result_class($target_class); - $target_class->result_source_instance($source) - if $target_class->can('result_source_instance'); - $schema->register_source($moniker, $source); + + if ($target_class->can('result_source_instance')) { + # give the class a schema-less source copy + $target_class->result_source_instance( bless + { %$new_source, schema => ref $new_source->{schema} || $new_source->{schema} }, + ref $new_source, + ); + } } - } -# Class::C3->reinitialize(); - { - no strict 'refs'; - no warnings 'redefine'; + foreach my $meth (qw/class source resultset/) { + no warnings 'redefine'; *{"${target}::${meth}"} = subname "${target}::${meth}" => sub { shift->schema->$meth(@_) }; } } + + Class::C3->reinitialize() if DBIx::Class::_ENV_::OLD_MRO; + return $schema; } @@ -985,31 +1011,54 @@ sub svp_rollback { =over 4 +=item Arguments: %attrs? + =item Return Value: $new_schema =back Clones the schema and its associated result_source objects and returns the -copy. +copy. The resulting copy will have the same attributes as the source schema, +except for those attributes explicitly overriden by the provided C<%attrs>. =cut sub clone { - my ($self) = @_; - my $clone = { (ref $self ? %$self : ()) }; + my $self = shift; + + my $clone = { + (ref $self ? %$self : ()), + (@_ == 1 && ref $_[0] eq 'HASH' ? %{ $_[0] } : @_), + }; 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); + $clone->$_(undef) for qw/class_mappings source_registrations storage/; + + $clone->_copy_state_from($self); + + return $clone; +} + +# Needed in Schema::Loader - if you refactor, please make a compatibility shim +# -- Caelum +sub _copy_state_from { + my ($self, $from) = @_; + + $self->class_mappings({ %{$from->class_mappings} }); + $self->source_registrations({ %{$from->source_registrations} }); + + foreach my $moniker ($from->sources) { + my $source = $from->source($moniker); my $new = $source->new($source); # 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); + $self->register_extra_source($moniker => $new); + } + + if ($from->storage) { + $self->storage($from->storage); + $self->storage->set_schema($self); } - $clone->storage->set_schema($clone) if $clone->storage; - return $clone; } =head2 throw_exception @@ -1020,8 +1069,8 @@ sub clone { =back -Throws an exception. Defaults to using L to report errors from -user's perspective. See L for details on overriding +Throws an exception. Obeys the exemption rules of L to report +errors from outer-user's perspective. See L for details on overriding this method's behavior. If L is turned on, C's default behavior will provide a detailed stack trace. @@ -1168,12 +1217,14 @@ format. sub ddl_filename { 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); + require File::Spec; + + $version = "$preversion-$version" if $preversion; + + my $class = blessed($self) || $self; + $class =~ s/::/-/g; - return $filename; + return File::Spec->catfile($dir, "$class-$version-$type.sql"); } =head2 thaw @@ -1187,18 +1238,20 @@ reference to any schema, so are rather useless. sub thaw { my ($self, $obj) = @_; local $DBIx::Class::ResultSourceHandle::thaw_schema = $self; + require Storable; return Storable::thaw($obj); } =head2 freeze -This doesn't actually do anything more than call L, it is just +This doesn't actually do anything more than call L, it is just provided here for symmetry. =cut sub freeze { - return Storable::freeze($_[1]); + require Storable; + return Storable::nfreeze($_[1]); } =head2 dclone @@ -1220,6 +1273,7 @@ objects so their references to the schema object sub dclone { my ($self, $obj) = @_; local $DBIx::Class::ResultSourceHandle::thaw_schema = $self; + require Storable; return Storable::dclone($obj); } @@ -1288,11 +1342,7 @@ moniker. =cut -sub register_source { - my $self = shift; - - $self->_register_source(@_); -} +sub register_source { shift->_register_source(@_) } =head2 unregister_source @@ -1306,11 +1356,7 @@ Removes the L from the schema for the given moniker. =cut -sub unregister_source { - my $self = shift; - - $self->_unregister_source(@_); -} +sub unregister_source { shift->_unregister_source(@_) } =head2 register_extra_source @@ -1325,42 +1371,74 @@ 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_extra_source { shift->_register_source(@_, { extra => 1 }) } 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); - return if ($params->{extra}); - 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"; + return $source if $params->{extra}; + + my $rs_class = $source->result_class; + if ($rs_class and my $rsrc = try { $rs_class->result_source_instance } ) { + my %map = %{$self->class_mappings}; + if ( + exists $map{$rs_class} + and + $map{$rs_class} ne $moniker + and + $rsrc ne $_[2] # orig_source + ) { + carp + "$rs_class already had a registered source which was replaced by this call. " + . 'Perhaps you wanted register_extra_source(), though it is more likely you did ' + . 'something wrong.' + ; + } + + $map{$rs_class} = $moniker; + $self->class_mappings(\%map); + } + + return $source; +} + +my $global_phase_destroy; +sub DESTROY { + return if $global_phase_destroy ||= in_global_destruction; + + my $self = shift; + my $srcs = $self->source_registrations; + + for my $moniker (keys %$srcs) { + # find first source that is not about to be GCed (someone other than $self + # holds a reference to it) and reattach to it, weakening our own link + # + # during global destruction (if we have not yet bailed out) this should throw + # which will serve as a signal to not try doing anything else + # however beware - on older perls the exception seems randomly untrappable + # due to some weird race condition during thread joining :((( + if (ref $srcs->{$moniker} and svref_2object($srcs->{$moniker})->REFCNT > 1) { + local $@; + eval { + $srcs->{$moniker}->schema($self); + weaken $srcs->{$moniker}; + 1; + } or do { + $global_phase_destroy = 1; + }; + + last; + } } - $map{$rs_class} = $moniker; - $self->class_mappings(\%map); } sub _unregister_source { @@ -1411,62 +1489,58 @@ more information. =cut -{ - my $warn; +sub compose_connection { + my ($self, $target, @info) = @_; - sub compose_connection { - my ($self, $target, @info) = @_; + carp_once "compose_connection deprecated as of 0.08000" + unless $INC{"DBIx/Class/CDBICompat.pm"}; - carp "compose_connection deprecated as of 0.08000" - unless ($INC{"DBIx/Class/CDBICompat.pm"} || $warn++); - - my $base = 'DBIx::Class::ResultSetProxy'; - try { - eval "require ${base};" - } - catch { - $self->throw_exception - ("No arguments to load_classes and couldn't load ${base} ($_)") - }; - - 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'; - my $name = join '::', $target, 'schema'; - *$name = subname $name, sub { $schema }; - } + my $base = 'DBIx::Class::ResultSetProxy'; + try { + eval "require ${base};" + } + catch { + $self->throw_exception + ("No arguments to load_classes and couldn't load ${base} ($_)") + }; - $schema->connection(@info); - foreach my $moniker ($schema->sources) { - my $source = $schema->source($moniker); + 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; - #warn "$moniker $class $source ".$source->storage; - $class->mk_classdata(result_source_instance => $source); + $self->inject_base($class, $base); $class->mk_classdata(resultset_instance => $source->resultset); - $class->mk_classdata(class_resolver => $schema); + $class->mk_classdata(class_resolver => $self); } - return $schema; + $self->connection(@info); + return $self; } + + my $schema = $self->compose_namespace($target, $base); + { + no strict 'refs'; + my $name = join '::', $target, 'schema'; + *$name = subname $name, 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; } 1; -=head1 AUTHORS +=head1 AUTHOR AND CONTRIBUTORS -Matt S. Trout +See L and L in DBIx::Class =head1 LICENSE