X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FDBIx%2FClass%2FSchema.pm;h=ae0c4278951c335043b921cb571b749ddcfda2e7;hb=ddf66ced51e4cb9b888001bc926bc0b3c3af0f8b;hp=1d6af1e92ed939741045a32a4b2533875ea93d43;hpb=bb3dbebc510ea41f116313bbe8c9a0453707e3e5;p=dbsrgits%2FDBIx-Class-Historic.git diff --git a/lib/DBIx/Class/Schema.pm b/lib/DBIx/Class/Schema.pm index 1d6af1e..ae0c427 100644 --- a/lib/DBIx/Class/Schema.pm +++ b/lib/DBIx/Class/Schema.pm @@ -3,6 +3,7 @@ package DBIx::Class::Schema; use strict; use warnings; +use DBIx::Class::Exception; use Carp::Clan qw/^DBIx::Class/; use Scalar::Util qw/weaken/; use File::Spec; @@ -15,6 +16,8 @@ __PACKAGE__->mk_classdata('source_registrations' => {}); __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 @@ -94,10 +97,15 @@ moniker. sub register_source { my ($self, $moniker, $source) = @_; + + %$source = %{ $source->new( { %$source, source_name => $moniker }) }; + my %reg = %{$self->source_registrations}; $reg{$moniker} = $source; $self->source_registrations(\%reg); + $source->schema($self); + weaken($source->{schema}) if ref($self); if ($source->result_class) { my %map = %{$self->class_mappings}; @@ -106,6 +114,19 @@ sub register_source { } } +sub _unregister_source { + my ($self, $moniker) = @_; + my %reg = %{$self->source_registrations}; + + my $source = delete $reg{$moniker}; + $self->source_registrations(\%reg); + if ($source->result_class) { + my %map = %{$self->class_mappings}; + delete $map{$source->result_class}; + $self->class_mappings(\%map); + } +} + =head2 class =over 4 @@ -276,9 +297,10 @@ sub load_classes { } } $class->ensure_class_loaded($comp_class); - $comp_class->source_name($comp) unless $comp_class->source_name; - push(@to_register, [ $comp_class->source_name, $comp_class ]); + $comp = $comp_class->source_name || $comp; +# $DB::single = 1; + push(@to_register, [ $comp, $comp_class ]); } } } @@ -462,7 +484,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 to the target namespace, calls L with @db_info on the new schema, @@ -476,6 +500,8 @@ L and use the resulting schema object to operate on L objects with L for more information. +=end hidden + =cut { @@ -484,7 +510,8 @@ more information. sub compose_connection { my ($self, $target, @info) = @_; - warn "compose_connection deprecated as of 0.08000" unless $warn++; + warn "compose_connection deprecated as of 0.08000" + unless ($INC{"DBIx/Class/CDBICompat.pm"} || $warn++); my $base = 'DBIx::Class::ResultSetProxy'; eval "require ${base};"; @@ -559,9 +586,6 @@ will produce the output sub compose_namespace { my ($self, $target, $base) = @_; - my %reg = %{ $self->source_registrations }; - my %target; - my %map; my $schema = $self->clone; { no warnings qw/redefine/; @@ -580,6 +604,7 @@ sub compose_namespace { Class::C3->reinitialize(); { no strict 'refs'; + no warnings 'redefine'; foreach my $meth (qw/class source resultset/) { *{"${target}::${meth}"} = sub { shift->schema->$meth(@_) }; @@ -660,7 +685,6 @@ sub connection { my $storage = $storage_class->new($self); $storage->connect_info(\@info); $self->storage($storage); - $self->on_connect() if($self->can('on_connect')); return $self; } @@ -710,6 +734,21 @@ sub txn_do { $self->storage->txn_do(@_); } +=head2 txn_scope_guard + +Runs C on the schema's storage. + +=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 @@ -761,6 +800,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 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 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 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 @@ -817,6 +907,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 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 to populate your primary keys you MUST use +wantarray context if you want the PKs automatically created. =cut @@ -833,7 +935,15 @@ sub populate { } return @created; } - $self->storage->insert_bulk($self->source($name)->from, \@names, $data); + my @results_to_create; + foreach my $datum (@$data) { + my %result_to_create; + foreach my $index (0..$#names) { + $result_to_create{$names[$index]} = $$datum[$index]; + } + push @results_to_create, \%result_to_create; + } + $rs->populate(\@results_to_create); } =head2 exception_action @@ -846,7 +956,7 @@ sub populate { If C is set for this class/object, L will prefer to call this code reference with the exception as an argument, -rather than its normal action. +rather than its normal C or C action. Your subroutine should probably just wrap the error in the exception object/class of your choosing and rethrow. If, against all sage advice, @@ -868,6 +978,18 @@ Example: # suppress all exceptions, like a moron: $schema_obj->exception_action(sub { 1 }); +=head2 stacktrace + +=over 4 + +=item Arguments: boolean + +=back + +Whether L should include stack trace information. +Defaults to false normally, but defaults to true if C<$ENV{DBIC_TRACE}> +is true. + =head2 throw_exception =over 4 @@ -878,16 +1000,19 @@ Example: Throws an exception. Defaults to using L to report errors from user's perspective. See L for details on overriding -this method's behavior. +this method's behavior. If L is turned on, C's +default behavior will provide a detailed stack trace. =cut sub throw_exception { my $self = shift; - croak @_ if !$self->exception_action || !$self->exception_action->(@_); + + DBIx::Class::Exception->throw($_[0], $self->stacktrace) + if !$self->exception_action || !$self->exception_action->(@_); } -=head2 deploy (EXPERIMENTAL) +=head2 deploy =over 4 @@ -897,13 +1022,14 @@ sub throw_exception { Attempts to deploy the schema to the current storage using L. -Note that this feature is currently EXPERIMENTAL and may not work correctly -across all databases, or fully handle complex relationships. - 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. +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 +only the sources listed will get deployed. + =cut sub deploy { @@ -983,13 +1109,60 @@ sub ddl_filename { my ($self, $type, $dir, $version, $pversion) = @_; my $filename = ref($self); - $filename =~ s/::/-/; + $filename =~ s/::/-/g; $filename = File::Spec->catfile($dir, "$filename-$version-$type.sql"); $filename =~ s/$version/$pversion-$version/ if($pversion); 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 object when you deploy the schema via +L or L. + +For an example of what you can do with this, see +L. + +=head2 thaw + +Provided as the recommened way of thawing schema objects. You can call +C 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, 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 cloned.) + +=cut + +sub dclone { + my ($self, $obj) = @_; + local $DBIx::Class::ResultSourceHandle::thaw_schema = $self; + return Storable::dclone($obj); +} + 1; =head1 AUTHORS