X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FDBIx%2FClass%2FSchema.pm;h=6fca48e5431d8bda0ef73ec5245e9d5300a66a34;hb=4b8a53eabdb1629bacdb95f04ca8fc3718ca7c58;hp=5b86fecb3e570c25203d7fa3991de07c3866e676;hpb=dee99c2433a9f090cba9dd0349459a1df0b25c3a;p=dbsrgits%2FDBIx-Class.git diff --git a/lib/DBIx/Class/Schema.pm b/lib/DBIx/Class/Schema.pm index 5b86fec..6fca48e 100644 --- a/lib/DBIx/Class/Schema.pm +++ b/lib/DBIx/Class/Schema.pm @@ -6,9 +6,10 @@ use warnings; use DBIx::Class::Exception; use DBIx::Class::Carp; use Try::Tiny; -use Scalar::Util 'weaken'; +use Scalar::Util qw/weaken blessed/; use Sub::Name 'subname'; use B 'svref_2object'; +use Devel::GlobalDestruction; use namespace::clean; use base qw/DBIx::Class/; @@ -167,12 +168,9 @@ sub _findallmod { my $ns = shift || ref $proto || $proto; require Module::Find; - my @mods = Module::Find::findallmod($ns); - # 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 @@ -408,7 +406,7 @@ sub load_classes { =item Arguments: $storage_type|{$storage_type, \%args} -=item Return value: $storage_type|{$storage_type, \%args} +=item Return Value: $storage_type|{$storage_type, \%args} =item Default value: DBIx::Class::Storage::DBI @@ -434,7 +432,7 @@ L for an example of this. =item Arguments: $code_reference -=item Return value: $code_reference +=item Return Value: $code_reference =item Default value: None @@ -532,9 +530,9 @@ sub connect { shift->clone->connection(@_) } =over 4 -=item Arguments: $source_name +=item Arguments: L<$source_name|DBIx::Class::ResultSource/source_name> -=item Return Value: $resultset +=item Return Value: L<$resultset|DBIx::Class::ResultSet> =back @@ -546,17 +544,17 @@ name. =cut sub resultset { - my ($self, $moniker) = @_; + my ($self, $source_name) = @_; $self->throw_exception('resultset() expects a source name') - unless defined $moniker; - return $self->source($moniker)->resultset; + unless defined $source_name; + return $self->source($source_name)->resultset; } =head2 sources =over 4 -=item Return Value: @source_names +=item Return Value: L<@source_names|DBIx::Class::ResultSource/source_name> =back @@ -572,9 +570,9 @@ sub sources { return keys %{shift->source_registrations}; } =over 4 -=item Arguments: $source_name +=item Arguments: L<$source_name|DBIx::Class::ResultSource/source_name> -=item Return Value: $result_source +=item Return Value: L<$result_source|DBIx::Class::ResultSource> =back @@ -591,14 +589,14 @@ sub source { $self->throw_exception("source() expects a source name") unless @_; - my $moniker = shift; + my $source_name = shift; my $sreg = $self->source_registrations; - return $sreg->{$moniker} if exists $sreg->{$moniker}; + return $sreg->{$source_name} if exists $sreg->{$source_name}; # if we got here, they probably passed a full class name - my $mapped = $self->class_mappings->{$moniker}; - $self->throw_exception("Can't find source for ${moniker}") + my $mapped = $self->class_mappings->{$source_name}; + $self->throw_exception("Can't find source for ${source_name}") unless $mapped && exists $sreg->{$mapped}; return $sreg->{$mapped}; } @@ -607,7 +605,7 @@ sub source { =over 4 -=item Arguments: $source_name +=item Arguments: L<$source_name|DBIx::Class::ResultSource/source_name> =item Return Value: $classname @@ -620,8 +618,7 @@ Retrieves the Result class name for the given source name. =cut sub class { - my ($self, $moniker) = @_; - return $self->source($moniker)->result_class; + return shift->source(shift)->result_class; } =head2 txn_do @@ -740,59 +737,42 @@ found in L. =over 4 -=item Arguments: $source_name, \@data; +=item Arguments: L<$source_name|DBIx::Class::ResultSource/source_name>, [ \@column_list, \@row_values+ ] | [ \%col_data+ ] -=item Return value: \@$objects | nothing +=item Return Value: L<\@result_objects|DBIx::Class::Manual::ResultClass> (scalar context) | L<@result_objects|DBIx::Class::Manual::ResultClass> (list context) =back -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 in L 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. +A convenience shortcut to L. Equivalent to: -Otherwise, each set of data is inserted into the database using -L, and a arrayref of the resulting row -objects is returned. + $schema->resultset($source_name)->populate([...]); -e.g. +=over 4 - $schema->populate('Artist', [ - [ qw/artistid name/ ], - [ 1, 'Popular Band' ], - [ 2, 'Indie Band' ], - ... - ]); +=item NOTE -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 s bulk insert method. So the performance will be much better for -storages that support this method. +The context of this method call has an important effect on what is +submitted to storage. In void context data is fed directly to fastpath +insertion routines provided by the underlying storage (most often +L), bypassing the L and +L calls on the +L class, including any +augmentation of these methods provided by components. For example if you +are using something like L to create primary +keys for you, you will find that your PKs are empty. In this case you +will have to explicitly force scalar or list context in order to create +those values. -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 to populate your primary keys you MUST use -wantarray context if you want the PKs automatically created. +=back =cut sub populate { my ($self, $name, $data) = @_; - if(my $rs = $self->resultset($name)) { - if(defined wantarray) { - return $rs->populate($data); - } else { - $rs->populate($data); - } - } else { - $self->throw_exception("$name is not a resultset"); - } + my $rs = $self->resultset($name) + or $self->throw_exception("'$name' is not a resultset"); + + return $rs->populate($data); } =head2 connection @@ -887,16 +867,16 @@ will produce the output # my ($self, $target, $base) = @_; # my $schema = $self->clone; -# foreach my $moniker ($schema->sources) { -# my $source = $schema->source($moniker); -# my $target_class = "${target}::${moniker}"; +# foreach my $source_name ($schema->sources) { +# my $source = $schema->source($source_name); +# my $target_class = "${target}::${source_name}"; # $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); +# $schema->register_source($source_name, $source); # } # return $schema; # } @@ -918,14 +898,14 @@ sub compose_namespace { use warnings qw/redefine/; no strict qw/refs/; - foreach my $moniker ($self->sources) { - my $orig_source = $self->source($moniker); + foreach my $source_name ($self->sources) { + my $orig_source = $self->source($source_name); - my $target_class = "${target}::${moniker}"; + my $target_class = "${target}::${source_name}"; $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 + my $new_source = $schema->register_source($source_name, bless { %$orig_source, result_class => $target_class }, ref $orig_source, ); @@ -1034,18 +1014,33 @@ sub clone { }; 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 $source_name ($from->sources) { + my $source = $from->source($source_name); 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($source_name => $new); } - $clone->storage->set_schema($clone) if $clone->storage; - return $clone; + if ($from->storage) { + $self->storage($from->storage); + $self->storage->set_schema($self); + } } =head2 throw_exception @@ -1124,7 +1119,7 @@ sub deploy { =item Arguments: See L -=item Return value: $listofstatements +=item Return Value: $listofstatements =back @@ -1173,7 +1168,7 @@ sub create_ddl_dir { =item Arguments: $database-type, $version, $directory, $preversion -=item Return value: $normalised_filename +=item Return Value: $normalised_filename =back @@ -1206,12 +1201,12 @@ sub ddl_filename { require File::Spec; - my $filename = ref($self); - $filename =~ s/::/-/g; - $filename = File::Spec->catfile($dir, "$filename-$version-$type.sql"); - $filename =~ s/$version/$preversion-$version/ if($preversion); + $version = "$preversion-$version" if $preversion; - return $filename; + my $class = blessed($self) || $self; + $class =~ s/::/-/g; + + return File::Spec->catfile($dir, "$class-$version-$type.sql"); } =head2 thaw @@ -1292,7 +1287,7 @@ sub schema_version { =over 4 -=item Arguments: $moniker, $component_class +=item Arguments: $source_name, $component_class =back @@ -1305,27 +1300,27 @@ file). You may also need it to register classes at runtime. Registers a class which isa DBIx::Class::ResultSourceProxy. Equivalent to calling: - $schema->register_source($moniker, $component_class->result_source_instance); + $schema->register_source($source_name, $component_class->result_source_instance); =cut sub register_class { - my ($self, $moniker, $to_register) = @_; - $self->register_source($moniker => $to_register->result_source_instance); + my ($self, $source_name, $to_register) = @_; + $self->register_source($source_name => $to_register->result_source_instance); } =head2 register_source =over 4 -=item Arguments: $moniker, $result_source +=item Arguments: $source_name, L<$result_source|DBIx::Class::ResultSource> =back This method is called by L. Registers the L in the schema with the given -moniker. +source name. =cut @@ -1335,11 +1330,11 @@ sub register_source { shift->_register_source(@_) } =over 4 -=item Arguments: $moniker +=item Arguments: $source_name =back -Removes the L from the schema for the given moniker. +Removes the L from the schema for the given source name. =cut @@ -1349,7 +1344,7 @@ sub unregister_source { shift->_unregister_source(@_) } =over 4 -=item Arguments: $moniker, $result_source +=item Arguments: $source_name, L<$result_source|DBIx::Class::ResultSource> =back @@ -1361,15 +1356,15 @@ has a source and you want to register an extra one. sub register_extra_source { shift->_register_source(@_, { extra => 1 }) } sub _register_source { - my ($self, $moniker, $source, $params) = @_; + my ($self, $source_name, $source, $params) = @_; - $source = $source->new({ %$source, source_name => $moniker }); + $source = $source->new({ %$source, source_name => $source_name }); $source->schema($self); weaken $source->{schema} if ref($self); my %reg = %{$self->source_registrations}; - $reg{$moniker} = $source; + $reg{$source_name} = $source; $self->source_registrations(\%reg); return $source if $params->{extra}; @@ -1380,7 +1375,7 @@ sub _register_source { if ( exists $map{$rs_class} and - $map{$rs_class} ne $moniker + $map{$rs_class} ne $source_name and $rsrc ne $_[2] # orig_source ) { @@ -1391,55 +1386,48 @@ sub _register_source { ; } - $map{$rs_class} = $moniker; + $map{$rs_class} = $source_name; $self->class_mappings(\%map); } return $source; } -{ - my $global_phase_destroy; - - # SpeedyCGI runs END blocks every cycle but keeps object instances - # hence we have to disable the globaldestroy hatch, and rely on the - # eval trap below (which appears to work, but is risky done so late) - END { $global_phase_destroy = 1 unless $CGI::SpeedyCGI::i_am_speedy } - - sub DESTROY { - return if $global_phase_destroy; - - 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 will throw - # which will serve as a signal to not try doing anything else - if (ref $srcs->{$moniker} and svref_2object($srcs->{$moniker})->REFCNT > 1) { - local $@; - eval { - $srcs->{$moniker}->schema($self); - 1; - } or do { - $global_phase_destroy = 1; - last; - }; - - weaken $srcs->{$moniker}; - last; - } +my $global_phase_destroy; +sub DESTROY { + return if $global_phase_destroy ||= in_global_destruction; + + my $self = shift; + my $srcs = $self->source_registrations; + + for my $source_name (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->{$source_name} and svref_2object($srcs->{$source_name})->REFCNT > 1) { + local $@; + eval { + $srcs->{$source_name}->schema($self); + weaken $srcs->{$source_name}; + 1; + } or do { + $global_phase_destroy = 1; + }; + + last; } } } sub _unregister_source { - my ($self, $moniker) = @_; + my ($self, $source_name) = @_; my %reg = %{$self->source_registrations}; - my $source = delete $reg{$moniker}; + my $source = delete $reg{$source_name}; $self->source_registrations(\%reg); if ($source->result_class) { my %map = %{$self->class_mappings}; @@ -1500,8 +1488,8 @@ sub compose_connection { 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); + foreach my $source_name ($self->sources) { + my $source = $self->source($source_name); my $class = $source->result_class; $self->inject_base($class, $base); $class->mk_classdata(resultset_instance => $source->resultset); @@ -1519,10 +1507,10 @@ sub compose_connection { } $schema->connection(@info); - foreach my $moniker ($schema->sources) { - my $source = $schema->source($moniker); + foreach my $source_name ($schema->sources) { + my $source = $schema->source($source_name); my $class = $source->result_class; - #warn "$moniker $class $source ".$source->storage; + #warn "$source_name $class $source ".$source->storage; $class->mk_classdata(result_source_instance => $source); $class->mk_classdata(resultset_instance => $source->resultset); $class->mk_classdata(class_resolver => $schema); @@ -1532,9 +1520,9 @@ sub compose_connection { 1; -=head1 AUTHORS +=head1 AUTHOR AND CONTRIBUTORS -Matt S. Trout +See L and L in DBIx::Class =head1 LICENSE