X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FDBIx%2FClass%2FSchema%2FLoader%2FBase.pm;h=31221e6392830d7495c86e670835f9812778f278;hb=4a6249b20462d8b7ff041a29473bf5e13cf2fe6c;hp=8a0ad1f022cbfdd7ba77cb2d8a62db158aae0791;hpb=5fc335ab21e8dcf1ddbc9801a8486e6c613bc643;p=dbsrgits%2FDBIx-Class-Schema-Loader.git diff --git a/lib/DBIx/Class/Schema/Loader/Base.pm b/lib/DBIx/Class/Schema/Loader/Base.pm index 8a0ad1f..31221e6 100644 --- a/lib/DBIx/Class/Schema/Loader/Base.pm +++ b/lib/DBIx/Class/Schema/Loader/Base.pm @@ -3,6 +3,7 @@ package DBIx::Class::Schema::Loader::Base; use strict; use warnings; use base qw/Class::Accessor::Grouped Class::C3::Componentised/; +use MRO::Compat; use mro 'c3'; use Carp::Clan qw/^DBIx::Class/; use DBIx::Class::Schema::Loader::RelBuilder (); @@ -28,7 +29,7 @@ use List::MoreUtils qw/all any firstidx uniq/; use File::Temp 'tempfile'; use namespace::clean; -our $VERSION = '0.07015'; +our $VERSION = '0.07035'; __PACKAGE__->mk_group_ro_accessors('simple', qw/ schema @@ -252,7 +253,7 @@ transition instead of just being lowercased, so C becomes C. (EXPERIMENTAL) The default mode is L, to get L mode, you have to specify it in -L explictly until C<0.08> comes out. +L explicitly until C<0.08> comes out. L and L are created using L or L if @@ -379,18 +380,103 @@ same database and schema as the table/column whose comment is being retrieved. =head2 relationship_attrs -Hashref of attributes to pass to each generated relationship, listed -by type. Also supports relationship type 'all', containing options to -pass to all generated relationships. Attributes set for more specific -relationship types override those set in 'all'. +Hashref of attributes to pass to each generated relationship, listed by type. +Also supports relationship type 'all', containing options to pass to all +generated relationships. Attributes set for more specific relationship types +override those set in 'all', and any attributes specified by this option +override the introspected attributes of the foreign key if any. For example: relationship_attrs => { - belongs_to => { is_deferrable => 0 }, + has_many => { cascade_delete => 1, cascade_copy => 1 }, + might_have => { cascade_delete => 1, cascade_copy => 1 }, }, -use this to turn off DEFERRABLE on your foreign key constraints. +use this to turn L cascades to on on your +L and +L relationships, they default +to off. + +Can also be a coderef, for more precise control, in which case the coderef gets +this hash of parameters (as a list:) + + rel_name # the name of the relationship + rel_type # the type of the relationship: 'belongs_to', 'has_many' or 'might_have' + local_source # the DBIx::Class::ResultSource object for the source the rel is *from* + remote_source # the DBIx::Class::ResultSource object for the source the rel is *to* + local_table # a DBIx::Class::Schema::Loader::Table object for the table of the source the rel is from + local_cols # an arrayref of column names of columns used in the rel in the source it is from + remote_table # a DBIx::Class::Schema::Loader::Table object for the table of the source the rel is to + remote_cols # an arrayref of column names of columns used in the rel in the source it is to + attrs # the attributes that would be set + +it should return the new hashref of attributes, or nothing for no changes. + +For example: + + relationship_attrs => sub { + my %p = @_; + + say "the relationship name is: $p{rel_name}"; + say "the relationship is a: $p{rel_type}"; + say "the local class is: ", $p{local_source}->result_class; + say "the remote class is: ", $p{remote_source}->result_class; + say "the local table is: ", $p{local_table}->sql_name; + say "the rel columns in the local table are: ", (join ", ", @{$p{local_cols}}); + say "the remote table is: ", $p{remote_table}->sql_name; + say "the rel columns in the remote table are: ", (join ", ", @{$p{remote_cols}}); + + if ($p{local_table} eq 'dogs' && @{$p{local_cols}} == 1 && $p{local_cols}[0] eq 'name') { + $p{attrs}{could_be_snoopy} = 1; + + reutrn $p{attrs}; + } + }, + +These are the default attributes: + + has_many => { + cascade_delete => 0, + cascade_copy => 0, + }, + might_have => { + cascade_delete => 0, + cascade_copy => 0, + }, + belongs_to => { + on_delete => 'CASCADE', + on_update => 'CASCADE', + is_deferrable => 1, + }, + +For L relationships, these +defaults are overridden by the attributes introspected from the foreign key in +the database, if this information is available (and the driver is capable of +retrieving it.) + +This information overrides the defaults mentioned above, and is then itself +overridden by the user's L for C if any are +specified. + +In general, for most databases, for a plain foreign key with no rules, the +values for a L relationship +will be: + + on_delete => 'NO ACTION', + on_update => 'NO ACTION', + is_deferrable => 0, + +In the cases where an attribute is not supported by the DB, a value matching +the actual behavior is used, for example Oracle does not support C +rules, so C is set to C. This is done so that the +behavior of the schema is preserved when cross deploying to a different RDBMS +such as SQLite for testing. + +In the cases where the DB does not support C foreign keys, the +value is set to C<1> if L has a working C<< +$storage->with_deferred_fk_checks >>. This is done so that the same +L code can be used, and cross deployed from and to such databases. =head2 debug @@ -447,7 +533,7 @@ C, C =item * Informix, MSSQL, Sybase ASE -C, C, C +C, C, C =back @@ -532,6 +618,10 @@ If it is a coderef, the argument passed will be a hashref of this form: remote_class => name of the DBIC class we are related to, remote_moniker => moniker of the DBIC class we are related to, remote_columns => columns in the other table in the relationship, + # for type => "many_to_many" only: + link_class => name of the DBIC class for the link table + link_moniker => moniker of the DBIC class for the link table + link_rel_name => name of the relationship to the link table } DBICSL will try to use the value returned as the relationship name. @@ -593,7 +683,7 @@ load certain components for specified Result classes. For example: 'InflateColumn::DateTime', ], } - + You may use this in conjunction with L. =head2 result_roles @@ -613,7 +703,7 @@ certain roles for specified Result classes. For example: ], RouteChange => 'YourApp::Role::TripEvent', } - + You may use this in conjunction with L. =head2 use_namespaces @@ -746,7 +836,8 @@ L = C or greater is required with this option. Set to true to prepend the L to table names for C<< __PACKAGE__->table >> calls, and to some other things like Oracle sequences. -This attribute is automatically set to true for multi db_schema configurations. +This attribute is automatically set to true for multi db_schema configurations, +unless explicitly set to false by the user. =head2 use_moose @@ -884,7 +975,7 @@ sub new { } $self->result_components_map($self->{result_component_map}) } - + if (defined $self->{result_role_map}) { if (defined $self->result_roles_map) { croak "Specify only one of result_roles_map or result_role_map"; @@ -1051,7 +1142,7 @@ sub new { if (defined $self->db_schema) { if (ref $self->db_schema eq 'ARRAY') { - if (@{ $self->db_schema } > 1) { + if (@{ $self->db_schema } > 1 && not defined $self->{qualify_objects}) { $self->{qualify_objects} = 1; } elsif (@{ $self->db_schema } == 0) { @@ -1059,7 +1150,7 @@ sub new { } } elsif (not ref $self->db_schema) { - if ($self->db_schema eq '%') { + if ($self->db_schema eq '%' && not defined $self->{qualify_objects}) { $self->{qualify_objects} = 1; } @@ -1483,19 +1574,19 @@ sub _load_tables { # check for moniker clashes my $inverse_moniker_idx; - foreach my $table (values %{ $self->_tables }) { - push @{ $inverse_moniker_idx->{$self->monikers->{$table->sql_name}} }, $table; + foreach my $imtable (values %{ $self->_tables }) { + push @{ $inverse_moniker_idx->{$self->monikers->{$imtable->sql_name}} }, $imtable; } my @clashes; foreach my $moniker (keys %$inverse_moniker_idx) { - my $tables = $inverse_moniker_idx->{$moniker}; - if (@$tables > 1) { + my $imtables = $inverse_moniker_idx->{$moniker}; + if (@$imtables > 1) { my $different_databases = - $tables->[0]->can('database') && (uniq map $_->database||'', @$tables) > 1; + $imtables->[0]->can('database') && (uniq map $_->database||'', @$imtables) > 1; my $different_schemas = - (uniq map $_->schema||'', @$tables) > 1; + (uniq map $_->schema||'', @$imtables) > 1; if ($different_databases || $different_schemas) { my ($use_schema, $use_database) = (1, 0); @@ -1506,11 +1597,11 @@ sub _load_tables { # If any monikers are in the same database, we have to distinguish by # both schema and database. my %db_counts; - $db_counts{$_}++ for map $_->database, @$tables; + $db_counts{$_}++ for map $_->database, @$imtables; $use_schema = any { $_ > 1 } values %db_counts; } - delete $self->monikers->{$_->sql_name} for @$tables; + foreach my $tbl (@$imtables) { delete $self->monikers->{$tbl->sql_name}; } my $moniker_parts = [ @{ $self->moniker_parts } ]; @@ -1524,15 +1615,14 @@ sub _load_tables { my %new_monikers; - $new_monikers{$_->sql_name} = $self->_table2moniker($_) for @$tables; - - $self->monikers->{$_} = $new_monikers{$_} for map $_->sql_name, @$tables; + foreach my $tbl (@$imtables) { $new_monikers{$tbl->sql_name} = $self->_table2moniker($tbl); } + foreach my $name (map $_->sql_name, @$imtables) { $self->monikers->{$name} = $new_monikers{$name}; } # check if there are still clashes my %by_moniker; - + while (my ($t, $m) = each %new_monikers) { - push @{ $by_moniker{$m} }, $t; + push @{ $by_moniker{$m} }, $t; } foreach my $m (grep @{ $by_moniker{$_} } > 1, keys %by_moniker) { @@ -1544,7 +1634,7 @@ sub _load_tables { } else { push @clashes, sprintf ("tables %s reduced to the same source moniker '%s'", - join (', ', map $_->sql_name, @$tables), + join (', ', map $_->sql_name, @$imtables), $moniker, ); } @@ -1559,9 +1649,8 @@ sub _load_tables { ; } - $self->_make_src_class($_) for @tables; - - $self->_setup_src_meta($_) for @tables; + foreach my $tbl (@tables) { $self->_make_src_class($tbl); } + foreach my $tbl (@tables) { $self->_setup_src_meta($tbl); } if(!$self->skip_relationships) { # The relationship loader needs a working schema @@ -1574,10 +1663,8 @@ sub _load_tables { @INC = grep $_ ne $self->dump_directory, @INC; } - $self->_load_roles($_) for @tables; - - $self->_load_external($_) - for map { $self->classes->{$_->sql_name} } @tables; + foreach my $tbl (@tables) { $self->_load_roles($tbl); } + foreach my $tbl (map { $self->classes->{$_->sql_name} } @tables) { $self->_load_external($tbl); } # Reload without unloading first to preserve any symbols from external # packages. @@ -1603,7 +1690,7 @@ sub _reload_classes { $self->_dump_to_dir(map { $self->classes->{$_->sql_name} } @tables); unshift @INC, $self->dump_directory; - + my @to_register; my %have_source = map { $_ => $self->schema->source($_) } $self->schema->sources; @@ -1611,7 +1698,7 @@ sub _reload_classes { for my $table (@tables) { my $moniker = $self->monikers->{$table->sql_name}; my $class = $self->classes->{$table->sql_name}; - + { no warnings 'redefine'; local *Class::C3::reinitialize = sub {}; # to speed things up, reinitialized below @@ -1781,7 +1868,7 @@ sub _dump_to_dir { my $result_base_class = $self->result_base_class || 'DBIx::Class::Core'; foreach my $src_class (@classes) { - my $src_text = + my $src_text = qq|use utf8;\n| . qq|package $src_class;\n\n| . qq|# Created by DBIx::Class::Schema::Loader\n| @@ -1836,7 +1923,7 @@ sub _sig_comment { my ($self, $version, $ts) = @_; return qq|\n\n# Created by DBIx::Class::Schema::Loader| . qq| v| . $version - . q| @ | . $ts + . q| @ | . $ts . qq|\n# DO NOT MODIFY THIS OR ANYTHING ABOVE! md5sum:|; } @@ -1981,7 +2068,7 @@ sub _default_moose_custom_content { if (not $is_schema) { return qq|\n__PACKAGE__->meta->make_immutable;|; } - + return qq|\n__PACKAGE__->meta->make_immutable(inline_constructor => 0);|; } @@ -2707,12 +2794,12 @@ sub _make_pod { elsif ($method eq 'add_unique_constraint') { $self->_pod($class, '=head1 UNIQUE CONSTRAINTS') unless $self->{_uniqs_started}{$class}; - + my ($name, $cols) = @_; $self->_pod($class, "=head2 C<$name>"); $self->_pod($class, '=over 4'); - + foreach my $col (@$cols) { $self->_pod($class, "=item \* L"); } @@ -2725,7 +2812,7 @@ sub _make_pod { elsif ($method eq 'set_primary_key') { $self->_pod($class, "=head1 PRIMARY KEY"); $self->_pod($class, '=over 4'); - + foreach my $col (@_) { $self->_pod($class, "=item \* L"); } @@ -2780,7 +2867,7 @@ sub __table_comment { if (my $code = $self->can('_table_comment')) { return $self->_filter_comment($self->$code(@_)); } - + return ''; }