X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FDBIx%2FClass%2FSchema%2FLoader%2FBase.pm;h=34817116bb86e66c2caf1616cea207080bb089c6;hb=46564a42215c5309753f3e0609ae1adddf68d083;hp=ab03a98bd3b8584cfb97919ff7de5f3cd9f889ea;hpb=ba12c8acfa1dd66cbea6c9cfd40a3a33244ab6bd;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 ab03a98..3481711 100644 --- a/lib/DBIx/Class/Schema/Loader/Base.pm +++ b/lib/DBIx/Class/Schema/Loader/Base.pm @@ -20,16 +20,18 @@ use File::Temp (); use Class::Unload; use Class::Inspector (); use Scalar::Util 'looks_like_number'; -use DBIx::Class::Schema::Loader::Utils qw/split_name dumper_squashed eval_package_without_redefine_warnings class_path slurp_file sigwarn_silencer/; +use DBIx::Class::Schema::Loader::Column; +use DBIx::Class::Schema::Loader::Utils qw/split_name dumper_squashed eval_package_without_redefine_warnings class_path slurp_file sigwarn_silencer firstidx uniq/; use DBIx::Class::Schema::Loader::Optional::Dependencies (); use Try::Tiny; use DBIx::Class (); use Encode qw/encode decode/; -use List::MoreUtils qw/all any firstidx uniq/; +use List::Util qw/all any none/; use File::Temp 'tempfile'; +use curry; use namespace::clean; -our $VERSION = '0.07042'; +our $VERSION = '0.07048_01'; __PACKAGE__->mk_group_ro_accessors('simple', qw/ schema @@ -84,6 +86,7 @@ __PACKAGE__->mk_group_ro_accessors('simple', qw/ moniker_to_table uniq_to_primary quiet + allow_extra_m2m_cols /); @@ -399,10 +402,10 @@ override the introspected attributes of the foreign key if any. For example: - relationship_attrs => { - has_many => { cascade_delete => 1, cascade_copy => 1 }, - might_have => { cascade_delete => 1, cascade_copy => 1 }, - }, + relationship_attrs => { + has_many => { cascade_delete => 1, cascade_copy => 1 }, + might_have => { cascade_delete => 1, cascade_copy => 1 }, + }, use this to turn L cascades to on on your L and @@ -410,15 +413,15 @@ 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:) +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_table # the 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_table # the 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 @@ -559,11 +562,7 @@ database and/or schema. Only load matching tables. -=head2 exclude - -Exclude matching tables. - -These can be specified either as a regex (preferrably on the C +These can be specified either as a regex (preferably on the C form), or as an arrayref of arrayrefs. Regexes are matched against the (unqualified) table name, while arrayrefs are matched according to L. @@ -580,6 +579,13 @@ For example: In this case only the tables C and C in C and C in C will be dumped. +=head2 exclude + +Exclude matching tables. + +The tables to exclude are specified in the same way as for the +L option. + =head2 moniker_map Overrides the default table name to moniker translation. Either @@ -608,14 +614,27 @@ a hashref of unqualified table name keys and moniker values =item * -a coderef for a translator function taking a L argument (which stringifies to the -unqualified table name) and returning a scalar moniker +a coderef that returns the moniker, which is called with the following +arguments: -The function is also passed a coderef that can be called with either -of the hashref forms to get the moniker mapped accordingly. This is -useful if you need to handle some monikers specially, but want to use -the hashref form for the rest. +=over + +=item * + +the L object for the table + +=item * + +the default moniker that DBIC would ordinarily give this table + +=item * + +a coderef that can be called with either of the hashref forms to get +the moniker mapped accordingly. This is useful if you need to handle +some monikers specially, but want to use the hashref form for the +rest. + +=back =back @@ -638,7 +657,7 @@ together. Examples: Map for overriding the monikerization of individual L. The keys are the moniker part to override, the value is either a -hashref of coderef for mapping the corresponding part of the +hashref or coderef for mapping the corresponding part of the moniker. If a coderef is used, it gets called with the moniker part and the hash key the code ref was found under. @@ -656,23 +675,39 @@ L takes precedence over this. =head2 col_accessor_map -Same as moniker_map, but for column accessor names. If a coderef is -passed, the code is called with arguments of +Same as moniker_map, but for column accessor names. The nested +hashref form is traversed according to L, with an +extra level at the bottom for the column name. If a coderef is +passed, the code is called with the following arguments: + +=over + +=item * + +the L object for the column + +=item * + +the default accessor name that DBICSL would ordinarily give this column + +=item * + +a hashref of this form: - the name of the column in the underlying database, - default accessor name that DBICSL would ordinarily give this column, - { - table_class => name of the DBIC class we are building, - table_moniker => calculated moniker for this table (after moniker_map if present), - table => table object of interface DBIx::Class::Schema::Loader::Table, - full_table_name => schema-qualified name of the database table (RDBMS specific), - schema_class => name of the schema class we are building, - column_info => hashref of column info (data_type, is_nullable, etc), - } - coderef ref that can be called with a hashref map + { + table_class => name of the DBIC class we are building, + table_moniker => calculated moniker for this table (after moniker_map if present), + table => the DBIx::Class::Schema::Loader::Table object for the table, + full_table_name => schema-qualified name of the database table (RDBMS specific), + schema_class => name of the schema class we are building, + column_info => hashref of column info (data_type, is_nullable, etc), + } + +=item * -the L
stringifies to the -unqualified table name. +a coderef that can be called with a hashref map + +=back =head2 rel_name_map @@ -708,9 +743,9 @@ If it is a coderef, it will be passed a hashref of this form: 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 + 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, } In addition it is passed a coderef that can be called with a hashref map. @@ -767,13 +802,13 @@ A hashref of moniker keys and component values. Unlike L, which loads the given components into every Result class, this option allows you to load certain components for specified Result classes. For example: - result_components_map => { - StationVisited => '+YourApp::Schema::Component::StationVisited', - RouteChange => [ - '+YourApp::Schema::Component::RouteChange', - 'InflateColumn::DateTime', - ], - } + result_components_map => { + StationVisited => '+YourApp::Schema::Component::StationVisited', + RouteChange => [ + '+YourApp::Schema::Component::RouteChange', + 'InflateColumn::DateTime', + ], + } You may use this in conjunction with L. @@ -787,13 +822,13 @@ A hashref of moniker keys and role values. Unlike L, which applies the given roles to every Result class, this option allows you to apply certain roles for specified Result classes. For example: - result_roles_map => { - StationVisited => [ - 'YourApp::Role::Building', - 'YourApp::Role::Destination', - ], - RouteChange => 'YourApp::Role::TripEvent', - } + result_roles_map => { + StationVisited => [ + 'YourApp::Role::Building', + 'YourApp::Role::Destination', + ], + RouteChange => 'YourApp::Role::TripEvent', + } You may use this in conjunction with L. @@ -877,18 +912,18 @@ L for a column. Must be a coderef that returns a hashref with the extra attributes. -Receives the L
(which -stringifies to the unqualified table name), column name and column_info. +Receives the L object, column name +and column_info. For example: - custom_column_info => sub { - my ($table, $column_name, $column_info) = @_; + custom_column_info => sub { + my ($table, $column_name, $column_info) = @_; - if ($column_name eq 'dog' && $column_info->{default_value} eq 'snoopy') { - return { is_snoopy => 1 }; - } - }, + if ($column_name eq 'dog' && $column_info->{default_value} eq 'snoopy') { + return { is_snoopy => 1 }; + } + }, This attribute can also be used to set C on a non-datetime column so it also receives the L and/or L. @@ -993,6 +1028,13 @@ Automatically promotes the largest unique constraints with non-nullable columns on tables to primary keys, assuming there is only one largest unique constraint. +=head2 allow_extra_m2m_cols + +Generate C relationship bridges even if the link table has +extra columns other than the foreign keys. The primary key must still +equal the union of the foreign keys. + + =head2 filter_generated_code An optional hook that lets you filter the generated text for various classes @@ -1283,7 +1325,7 @@ sub new { if (ref $self->moniker_parts ne 'ARRAY') { croak 'moniker_parts must be an arrayref'; } - if ((firstidx { $_ eq 'name' } @{ $self->moniker_parts }) == -1) { + if (none { $_ eq 'name' } @{ $self->moniker_parts }) { croak "moniker_parts option *must* contain 'name'"; } } @@ -1344,7 +1386,7 @@ EOF return unless -e $filename; my ($old_gen, $old_md5, $old_ver, $old_ts, $old_custom) = - $self->_parse_generated_file($filename); + $self->_parse_generated_file($filename); return unless $old_ver; @@ -1558,18 +1600,18 @@ sub _load_external { } $self->_ext_stmt($class, - qq|# These lines were loaded from '$real_inc_path' found in \@INC.\n| - .qq|# They are now part of the custom portion of this file\n| - .qq|# for you to hand-edit. If you do not either delete\n| - .qq|# this section or remove that file from \@INC, this section\n| - .qq|# will be repeated redundantly when you re-create this\n| - .qq|# file again via Loader! See skip_load_external to disable\n| - .qq|# this feature.\n| + qq|# These lines were loaded from '$real_inc_path' found in \@INC.\n| + .qq|# They are now part of the custom portion of this file\n| + .qq|# for you to hand-edit. If you do not either delete\n| + .qq|# this section or remove that file from \@INC, this section\n| + .qq|# will be repeated redundantly when you re-create this\n| + .qq|# file again via Loader! See skip_load_external to disable\n| + .qq|# this feature.\n| ); chomp $code; $self->_ext_stmt($class, $code); $self->_ext_stmt($class, - qq|# End of lines loaded from '$real_inc_path' | + qq|# End of lines loaded from '$real_inc_path'| ); } @@ -1601,7 +1643,7 @@ EOF chomp $code; $self->_ext_stmt($class, $code); $self->_ext_stmt($class, - qq|# End of lines loaded from '$old_real_inc_path' | + qq|# End of lines loaded from '$old_real_inc_path'| ); } } @@ -1615,9 +1657,7 @@ Does the actual schema-construction work. sub load { my $self = shift; - $self->_load_tables( - $self->_tables_list({ constraint => $self->constraint, exclude => $self->exclude }) - ); + $self->_load_tables($self->_tables_list); } =head2 rescan @@ -1639,7 +1679,7 @@ sub rescan { $self->_relbuilder->{schema} = $schema; my @created; - my @current = $self->_tables_list({ constraint => $self->constraint, exclude => $self->exclude }); + my @current = $self->_tables_list; foreach my $table (@current) { if(!exists $self->_tables->{$table->sql_name}) { @@ -1861,14 +1901,14 @@ sub _reload_classes { } sub _moose_metaclass { - return undef unless $INC{'Class/MOP.pm'}; # if CMOP is not loaded the class could not have loaded in the 1st place + return undef unless $INC{'Class/MOP.pm'}; # if CMOP is not loaded the class could not have loaded in the 1st place - my $class = $_[1]; + my $class = $_[1]; - my $mc = try { Class::MOP::class_of($class) } - or return undef; + my $mc = try { Class::MOP::class_of($class) } + or return undef; - return $mc->isa('Moose::Meta::Class') ? $mc : undef; + return $mc->isa('Moose::Meta::Class') ? $mc : undef; } # We use this instead of ensure_class_loaded when there are package symbols we @@ -1975,7 +2015,8 @@ sub _dump_to_dir { my @attr = qw/resultset_namespace default_resultset_class/; - unshift @attr, 'result_namespace' unless (not $self->result_namespace) || $self->result_namespace eq 'Result'; + unshift @attr, 'result_namespace' + if $self->result_namespace && $self->result_namespace ne 'Result'; for my $attr (@attr) { if ($self->$attr) { @@ -2023,7 +2064,7 @@ sub _dump_to_dir { } } else { - $src_text .= qq|use base '$result_base_class';\n|; + $src_text .= qq|use base '$result_base_class';\n|; } $self->_write_classfile($src_class, $src_text); @@ -2164,10 +2205,10 @@ sub _write_classfile { my $compare_to; if ($old_md5) { - $compare_to = $text . $self->_sig_comment($old_ver, $old_ts); - if (Digest::MD5::md5_base64(encode 'UTF-8', $compare_to) eq $old_md5) { - return unless $self->_upgrading_from && $is_schema; - } + $compare_to = $text . $self->_sig_comment($old_ver, $old_ts); + if (Digest::MD5::md5_base64(encode 'UTF-8', $compare_to) eq $old_md5) { + return unless $self->_upgrading_from && $is_schema; + } } push @{$self->generated_classes}, $class; @@ -2175,11 +2216,11 @@ sub _write_classfile { return if $self->dry_run; $text .= $self->_sig_comment( - $self->omit_version ? undef : $self->version_to_dump, - $self->omit_timestamp ? undef : POSIX::strftime('%Y-%m-%d %H:%M:%S', localtime) + $self->omit_version ? undef : $self->version_to_dump, + $self->omit_timestamp ? undef : POSIX::strftime('%Y-%m-%d %H:%M:%S', localtime) ); - open(my $fh, '>:encoding(UTF-8)', $filename) + open(my $fh, '>:raw:encoding(UTF-8)', $filename) or croak "Cannot open '$filename' for writing: $!"; # Write the top half and its MD5 sum @@ -2228,22 +2269,30 @@ sub _parse_generated_file { my $mark_re = qr{^(# DO NOT MODIFY THIS OR ANYTHING ABOVE! md5sum:)([A-Za-z0-9/+]{22})\r?\n}; - my ($md5, $ts, $ver, $gen); + my ($real_md5, $ts, $ver, $gen); local $_; while(<$fh>) { if(/$mark_re/) { my $pre_md5 = $1; - $md5 = $2; + my $mark_md5 = $2; # Pull out the version and timestamp from the line above - ($ver, $ts) = $gen =~ m/^# Created by DBIx::Class::Schema::Loader( v[\d.]+)?( @ [\d-]+ [\d:]+)?\r?\Z/m; + ($ver, $ts) = $gen =~ m/^# Created by DBIx::Class::Schema::Loader( v[\d._]+)?( @ [\d-]+ [\d:]+)?\r?\Z/m; $ver =~ s/^ v// if $ver; $ts =~ s/^ @ // if $ts; $gen .= $pre_md5; - croak "Checksum mismatch in '$fn', the auto-generated part of the file has been modified outside of this loader. Aborting.\nIf you want to overwrite these modifications, set the 'overwrite_modifications' loader option.\n" - if !$self->overwrite_modifications && Digest::MD5::md5_base64(encode 'UTF-8', $gen) ne $md5; - + $real_md5 = Digest::MD5::md5_base64(encode 'UTF-8', $gen); + if ($real_md5 ne $mark_md5) { + if ($self->overwrite_modifications) { + # Setting this to something that is not a valid MD5 forces + # the file to be rewritten. + $real_md5 = 'not an MD5'; + } + else { + croak "Checksum mismatch in '$fn', the auto-generated part of the file has been modified outside of this loader. Aborting.\nIf you want to overwrite these modifications, set the 'overwrite_modifications' loader option.\n"; + } + } last; } else { @@ -2252,14 +2301,14 @@ sub _parse_generated_file { } my $custom = do { local $/; <$fh> } - if $md5; + if $real_md5; $custom ||= ''; $custom =~ s/$CRLF|$LF/\n/g; close $fh; - return ($gen, $md5, $ver, $ts, $custom); + return ($gen, $real_md5, $ver, $ts, $custom); } sub _use { @@ -2424,8 +2473,10 @@ sub _is_result_class_method { push @roles, @{ $self->result_roles_map->{$table_moniker} } if exists $self->result_roles_map->{$table_moniker}; - for my $class ($base, @components, - ($self->use_moose ? 'Moose::Object' : ()), @roles) { + for my $class ( + $base, @components, @roles, + ($self->use_moose ? 'Moose::Object' : ()), + ) { $self->ensure_class_loaded($class); push @methods, @{ Class::Inspector->methods($class) || [] }; @@ -2480,7 +2531,7 @@ sub _run_user_map { my $default_ident = $default_code->( $ident, @extra ); my $new_ident; if( $map && ref $map eq 'HASH' ) { - if (my @parts = try{ @{ $ident } }) { + if (my @parts = try { @{ $ident } }) { my $part_map = $map; while (@parts) { my $part = shift @parts; @@ -2544,10 +2595,10 @@ sub _make_column_accessor_name { my $accessor = $self->_run_user_map( $self->col_accessor_map, - sub { $self->_default_column_accessor_name( shift ) }, + $self->curry::_default_column_accessor_name, $column_name, $column_context_info, - ); + ); return $accessor; } @@ -2557,6 +2608,8 @@ sub _table_is_view { return 0; } +sub _view_definition { undef } + # Set up metadata (cols, pks, etc) sub _setup_src_meta { my ($self, $table) = @_; @@ -2567,11 +2620,17 @@ sub _setup_src_meta { my $table_class = $self->classes->{$table->sql_name}; my $table_moniker = $self->monikers->{$table->sql_name}; + # Must come before ->table $self->_dbic_stmt($table_class, 'table_class', 'DBIx::Class::ResultSource::View') - if $self->_table_is_view($table); + if my $is_view = $self->_table_is_view($table); $self->_dbic_stmt($table_class, 'table', $table->dbic_name); + # Must come after ->table + if ($is_view and my $view_def = $self->_view_definition($table)) { + $self->_dbic_stmt($table_class, 'result_source_instance->view_definition', $view_def); + } + my $cols = $self->_table_columns($table); my $col_info = $self->__columns_info_for($table); @@ -2588,8 +2647,12 @@ sub _setup_src_meta { schema_class => $schema_class, column_info => $info, }; + my $col_obj = DBIx::Class::Schema::Loader::Column->new( + table => $table, + name => $col, + ); - $info->{accessor} = $self->_make_column_accessor_name( $col, $context ); + $info->{accessor} = $self->_make_column_accessor_name( $col_obj, $context ); } $self->_resolve_col_accessor_collisions($table, $col_info); @@ -2785,9 +2848,9 @@ sub _table2moniker { $self->_run_user_map( $self->moniker_map, - sub { $self->_default_table2moniker( shift ) }, + $self->curry::_default_table2moniker, $table - ); + ); } sub _load_relationships { @@ -2946,7 +3009,7 @@ sub _make_pod { looks_like_number($s) ? $s : qq{'$s'}; " $_: $s" - } sort keys %$attrs, + } sort keys %$attrs, ); if (my $comment = $self->__column_comment($self->class_to_table->{$class}, $col_counter, $name)) { $self->_pod( $class, $comment ); @@ -3193,9 +3256,9 @@ You can also control the renaming with the L option. L, L -=head1 AUTHOR +=head1 AUTHORS -See L and L. +See L. =head1 LICENSE