X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FDBIx%2FClass%2FSchema.pm;h=cbcddbcf01747473b8e3fb8e737e3ccce90b5b72;hb=64cdad22d9b4022de379ae43174c15ce8dc81b59;hp=77bd865397e4dc4adc2fbf4a2698fdf86f265385;hpb=c216324aa4b0f79ba056fbe74adbd735421e378a;p=dbsrgits%2FDBIx-Class-Historic.git diff --git a/lib/DBIx/Class/Schema.pm b/lib/DBIx/Class/Schema.pm index 77bd865..cbcddbc 100644 --- a/lib/DBIx/Class/Schema.pm +++ b/lib/DBIx/Class/Schema.pm @@ -3,8 +3,10 @@ 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; require Module::Find; use base qw/DBIx::Class/; @@ -14,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 @@ -93,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}; @@ -105,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 @@ -275,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 ]); } } } @@ -461,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, @@ -475,6 +500,8 @@ L and use the resulting schema object to operate on L objects with L for more information. +=end hidden + =cut { @@ -483,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};"; @@ -558,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/; @@ -579,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(@_) }; @@ -611,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 @@ -627,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 @@ -649,19 +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); 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 @@ -708,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 @@ -759,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 @@ -815,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 @@ -831,7 +956,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 @@ -844,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, @@ -866,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 @@ -876,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 @@ -895,13 +1043,16 @@ 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. Furthermore, you can use the +C parser parameter to prevent the parser from creating an index for each +FK. + =cut sub deploy { @@ -910,20 +1061,71 @@ 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 -=item Arguments: \@databases, $version, $directory, $sqlt_args +=item Arguments: \@databases, $version, $directory, $preversion, $sqlt_args =back Creates an SQL file based on the Schema, for each of the specified -database types, in the given directory. +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'] + +=item version - $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. + =cut sub create_ddl_dir { @@ -935,23 +1137,81 @@ sub create_ddl_dir { =head2 ddl_filename (EXPERIMENTAL) - my $filename = $table->ddl_filename($type, $dir, $version) +=over 4 + +=item Arguments: $directory, $database-type, $version, $preversion + +=back + + my $filename = $table->ddl_filename($type, $dir, $version, $preversion) -Creates a filename for a SQL file based on the table class name. Not -intended for direct end user use. +This method is called by C to compose a file name out of +the supplied directory, database type and version number. The default file +name format is: C<$dir$schema-$version-$type.sql>. + +You may override this method in your schema if you wish to use a different +format. =cut sub ddl_filename { - my ($self, $type, $dir, $version) = @_; + my ($self, $type, $dir, $version, $pversion) = @_; my $filename = ref($self); - $filename =~ s/::/-/; - $filename = "$dir$filename-$version-$type.sql"; + $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