X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FDBIx%2FClass%2FSchema.pm;h=55cf8fc674b83b7f310ba15603dff1c18f0643cd;hb=0c90fabe2d883d5a51ee47491b6c9af2c5f53e60;hp=2913a2f4997e144e3bc0832aa367b73bb79ac453;hpb=ca83d811f3ce60ebb819ce9ad54179837f6157c6;p=dbsrgits%2FDBIx-Class.git diff --git a/lib/DBIx/Class/Schema.pm b/lib/DBIx/Class/Schema.pm index 2913a2f..55cf8fc 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 @@ -97,13 +100,17 @@ sub register_source { %$source = %{ $source->new( { %$source, source_name => $moniker }) }; - $self->source_registrations->{$moniker} = $source; + 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) { - $self->class_mappings->{$source->result_class} = $moniker; + my %map = %{$self->class_mappings}; + $map{$source->result_class} = $moniker; + $self->class_mappings(\%map); } } @@ -477,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, @@ -491,6 +500,8 @@ L and use the resulting schema object to operate on L objects with L for more information. +=end hidden + =cut { @@ -499,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};"; @@ -592,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(@_) }; @@ -624,9 +637,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 @@ -640,6 +653,13 @@ in cases where the appropriate subclass is not autodetected, such as when dealing with MSSQL via L, 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 for an example of this. + =head2 connection =over 4 @@ -662,20 +682,33 @@ or L 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); - $self->on_connect() if($self->can('on_connect')); 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 @@ -722,6 +755,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 @@ -773,6 +821,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 @@ -829,6 +928,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 @@ -845,7 +956,15 @@ sub populate { } return @created; } - $self->storage->insert_bulk($self->source($name), \@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 @@ -858,7 +977,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, @@ -880,6 +999,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 @@ -890,16 +1021,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 @@ -909,10 +1043,6 @@ 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. Saying that, it -has been used successfully by many people, including the core dev team. - 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. @@ -929,6 +1059,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 and L. +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 @@ -1007,6 +1161,53 @@ sub ddl_filename { 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