X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=dbsrgits%2FDBIx-Class-Schema-Loader.git;a=blobdiff_plain;f=lib%2FDBIx%2FClass%2FSchema%2FLoader%2FBase.pm;h=4fdc9e79c32d4dfed8845d2dd23a74d38cb1c887;hp=3df396dd3f574823930c6dbbb0990d833868f153;hb=6d0f96209ca74e7bc0857df2ce3a78b7f15a5ce9;hpb=4591a4fff466d291cb7f597dcf829f87df5852d8 diff --git a/lib/DBIx/Class/Schema/Loader/Base.pm b/lib/DBIx/Class/Schema/Loader/Base.pm index 3df396d..4fdc9e7 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/; +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.07036_01'; +our $VERSION = '0.07049'; __PACKAGE__->mk_group_ro_accessors('simple', qw/ schema @@ -61,6 +63,10 @@ __PACKAGE__->mk_group_ro_accessors('simple', qw/ use_moose only_autoclean overwrite_modifications + dry_run + generated_classes + omit_version + omit_timestamp relationship_attrs @@ -80,6 +86,7 @@ __PACKAGE__->mk_group_ro_accessors('simple', qw/ moniker_to_table uniq_to_primary quiet + allow_extra_m2m_cols /); @@ -110,6 +117,7 @@ __PACKAGE__->mk_group_accessors('simple', qw/ qualify_objects moniker_parts moniker_part_separator + moniker_part_map /); my $CURRENT_V = 'v7'; @@ -205,7 +213,7 @@ How to name column accessors in Result classes. =item force_ascii For L mode and later, uses L instead of -L to force monikers and other identifiers to +L to force monikers and other identifiers to ASCII. =back @@ -304,6 +312,11 @@ If true, will not print the usual C messages. Does not affect warnings (except for warnings related to L.) +=head2 dry_run + +If true, don't actually write out the generated files. This can only be +used with static schema generation. + =head2 generate_pod By default POD will be generated for columns and relationships, using database @@ -389,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 @@ -400,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 @@ -547,11 +560,31 @@ database and/or schema. =head2 constraint -Only load tables matching regex. Best specified as a qr// regex. +Only load matching tables. + +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. + +For example: + + db_schema => [qw(some_schema other_schema)], + moniker_parts => [qw(schema name)], + constraint => [ + [ qr/\Asome_schema\z/ => qr/\A(?:foo|bar)\z/ ], + [ qr/\Aother_schema\z/ => qr/\Abaz\z/ ], + ], + +In this case only the tables C and C in C and +C in C will be dumped. =head2 exclude -Exclude tables matching regex. Best specified as a qr// regex. +Exclude matching tables. + +The tables to exclude are specified in the same way as for the +L option. =head2 moniker_map @@ -581,9 +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: + +=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 @@ -602,24 +653,61 @@ together. Examples: stations_visited | StationVisited routeChange | RouteChange +=head2 moniker_part_map + +Map for overriding the monikerization of individual L. +The keys are the moniker part to override, the value is either a +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. + +For example: + + moniker_part_map => { + schema => sub { ... }, + }, + +Given the table C, the code ref would be called with the +arguments C and C, plus a coderef similar to the one +described in L. + +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: - 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), - } +=over -the L
stringifies to the -unqualified table name. +=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: + + { + 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 * + +a coderef that can be called with a hashref map + +=back =head2 rel_name_map @@ -643,7 +731,7 @@ instance, you could have and relationships that would have been named C will now be named C except that in the table whose moniker is C it will be named C. -If it is a coderef, the argument passed will be a hashref of this form: +If it is a coderef, it will be passed a hashref of this form: { name => default relationship name, @@ -655,11 +743,13 @@ If it is a coderef, the argument passed will be 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. + DBICSL will try to use the value returned as the relationship name. =head2 inflect_plural @@ -712,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. @@ -732,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. @@ -807,6 +897,14 @@ made to Loader-generated code. Again, you should be using version control on your schema classes. Be careful with this option. +=head2 omit_version + +Omit the package version from the signature comment. + +=head2 omit_timestamp + +Omit the creation timestamp from the signature comment. + =head2 custom_column_info Hook for adding extra attributes to the @@ -814,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. @@ -892,12 +990,13 @@ are methods, which will cause namespace::autoclean to spare them from removal. This prevents the "Hey, where'd my overloads go?!" effect. -If you don't care about operator overloads, enabling this option falls back to -just using L itself. +If you don't care about operator overloads (or if you know your Moose is at at +least version 2.1400, where MooseX::MarkAsMethods is no longer necessary), +enabling this option falls back to just using L itself. If none of the above made any sense, or you don't have some pressing need to only use L, leaving this set to the default is -recommended. +just fine. =head2 col_collision_map @@ -930,6 +1029,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 @@ -946,8 +1052,19 @@ be generated. filter_generated_code => sub { my ($type, $class, $text) = @_; - ... - return $new_code; + ... + return $new_code; + } + +You can also use this option to set L in your generated classes. This will leave +the generated code in the default format, but will allow you to tidy +your classes at any point in future, without worrying about changing the +portions of the file which are checksummed, since C will just +ignore all text between the markers. + + filter_generated_code => sub { + return "#<<<\n$_[2]\n#>>>"; } =head1 METHODS @@ -1065,9 +1182,17 @@ sub new { $self->_validate_result_roles_map; if ($self->use_moose) { - if (not DBIx::Class::Schema::Loader::Optional::Dependencies->req_ok_for('use_moose')) { - die sprintf "You must install the following CPAN modules to enable the use_moose option: %s.\n", - DBIx::Class::Schema::Loader::Optional::Dependencies->req_missing_for('use_moose'); + if ($self->only_autoclean) { + if (not DBIx::Class::Schema::Loader::Optional::Dependencies->req_ok_for('use_moose_only_autoclean')) { + die sprintf "You must install the following CPAN modules to enable the use_moose and only_autoclean options: %s.\n", + DBIx::Class::Schema::Loader::Optional::Dependencies->req_missing_for('use_moose_only_autoclean'); + } + } + else { + if (not DBIx::Class::Schema::Loader::Optional::Dependencies->req_ok_for('use_moose')) { + die sprintf "You must install the following CPAN modules to enable the use_moose option: %s.\n", + DBIx::Class::Schema::Loader::Optional::Dependencies->req_missing_for('use_moose'); + } } } @@ -1077,6 +1202,7 @@ sub new { $self->{class_to_table} = {}; $self->{classes} = {}; $self->{_upgrading_classes} = {}; + $self->{generated_classes} = []; $self->{schema_class} ||= ( ref $self->{schema} || $self->{schema} ); $self->{schema} ||= $self->{schema_class}; @@ -1088,6 +1214,10 @@ sub new { if $self->{dump_overwrite}; $self->{dynamic} = ! $self->{dump_directory}; + + croak "dry_run can only be used with static schema generation" + if $self->dynamic and $self->dry_run; + $self->{temp_directory} ||= File::Temp::tempdir( 'dbicXXXX', TMPDIR => 1, CLEANUP => 1, @@ -1204,7 +1334,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'"; } } @@ -1212,6 +1342,9 @@ sub new { if (not defined $self->moniker_part_separator) { $self->moniker_part_separator(''); } + if (not defined $self->moniker_part_map) { + $self->moniker_part_map({}), + } return $self; } @@ -1262,7 +1395,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; @@ -1404,6 +1537,8 @@ sub _find_file_in_inc { foreach my $prefix (@INC) { my $fullpath = File::Spec->catfile($prefix, $file); + # abs_path pure-perl fallback warns for non-existent files + local $SIG{__WARN__} = sigwarn_silencer(qr/^stat\(.*\Q$file\E\)/); return $fullpath if -f $fullpath # abs_path throws on Windows for nonexistent files and (try { Cwd::abs_path($fullpath) }) ne @@ -1474,18 +1609,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'| ); } @@ -1517,7 +1652,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'| ); } } @@ -1531,9 +1666,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 @@ -1555,7 +1688,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}) { @@ -1696,6 +1829,8 @@ sub _load_tables { # The relationship loader needs a working schema local $self->{quiet} = 1; local $self->{dump_directory} = $self->{temp_directory}; + local $self->{generated_classes} = []; + local $self->{dry_run} = 0; $self->_reload_classes(\@tables); $self->_load_relationships(\@tables); @@ -1731,6 +1866,8 @@ sub _reload_classes { unshift @INC, $self->dump_directory; + return if $self->dry_run; + my @to_register; my %have_source = map { $_ => $self->schema->source($_) } $self->schema->sources; @@ -1773,14 +1910,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 @@ -1826,6 +1963,8 @@ sub get_dump_filename { sub _ensure_dump_subdirs { my ($self, $class) = (@_); + return if $self->dry_run; + my @name_parts = split(/::/, $class); pop @name_parts; # we don't care about the very last element, # which is a filename @@ -1885,7 +2024,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) { @@ -1933,7 +2073,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); @@ -1962,8 +2102,8 @@ sub _dump_to_dir { sub _sig_comment { my ($self, $version, $ts) = @_; return qq|\n\n# Created by DBIx::Class::Schema::Loader| - . qq| v| . $version - . q| @ | . $ts + . (defined($version) ? q| v| . $version : '') + . (defined($ts) ? q| @ | . $ts : '') . qq|\n# DO NOT MODIFY THIS OR ANYTHING ABOVE! md5sum:|; } @@ -1973,7 +2113,7 @@ sub _write_classfile { my $filename = $self->_get_dump_filename($class); $self->_ensure_dump_subdirs($class); - if (-f $filename && $self->really_erase_my_files) { + if (-f $filename && $self->really_erase_my_files && !$self->dry_run) { warn "Deleting existing file '$filename' due to " . "'really_erase_my_files' setting\n" unless $self->quiet; unlink($filename); @@ -1997,7 +2137,7 @@ sub _write_classfile { if (-f $old_filename) { $custom_content = ($self->_parse_generated_file ($old_filename))[4]; - unlink $old_filename; + unlink $old_filename unless $self->dry_run; } } @@ -2064,28 +2204,32 @@ sub _write_classfile { croak "filter '$filter' exited non-zero: $exit_code"; } } - if (not $text or not $text =~ /\bpackage\b/) { - warn("$class skipped due to filter") if $self->debug; - return; - } + if (not $text or not $text =~ /\bpackage\b/) { + warn("$class skipped due to filter") if $self->debug; + return; + } } # Check and see if the dump is in fact different 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; + + return if $self->dry_run; + $text .= $self->_sig_comment( - $self->version_to_dump, - 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 @@ -2134,19 +2278,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(.*?) @ (.*?)\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 { @@ -2155,14 +2310,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 { @@ -2327,8 +2482,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) || [] }; @@ -2383,7 +2540,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; @@ -2402,7 +2559,13 @@ sub _run_user_map { } } elsif( $map && ref $map eq 'CODE' ) { - $new_ident = $map->( $ident, $default_ident, @extra ); + my $cb = sub { + my ($cb_map) = @_; + croak "reentered map must be a hashref" + unless 'HASH' eq ref($cb_map); + return $self->_run_user_map($cb_map, $default_code, $ident, @extra); + }; + $new_ident = $map->( $ident, $default_ident, @extra, $cb ); } $new_ident ||= $default_ident; @@ -2441,14 +2604,21 @@ 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; } +sub _table_is_view { + #my ($self, $table) = @_; + return 0; +} + +sub _view_definition { undef } + # Set up metadata (cols, pks, etc) sub _setup_src_meta { my ($self, $table) = @_; @@ -2459,8 +2629,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 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); @@ -2477,8 +2656,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); @@ -2616,7 +2799,8 @@ sub _default_table2moniker { my $v = $self->_get_naming_v('monikers'); - my @name_parts = map $table->$_, @{ $self->moniker_parts }; + my @moniker_parts = @{ $self->moniker_parts }; + my @name_parts = map $table->$_, @moniker_parts; my $name_idx = firstidx { $_ eq 'name' } @{ $self->moniker_parts }; @@ -2625,6 +2809,16 @@ sub _default_table2moniker { foreach my $i (0 .. $#name_parts) { my $part = $name_parts[$i]; + my $moniker_part = $self->_run_user_map( + $self->moniker_part_map->{$moniker_parts[$i]}, + sub { '' }, + $part, $moniker_parts[$i], + ); + if (length $moniker_part) { + push @all_parts, $moniker_part; + next; + } + if ($i != $name_idx || $v >= 8) { $part = $self->_to_identifier('monikers', $part, '_', 1); } @@ -2663,9 +2857,9 @@ sub _table2moniker { $self->_run_user_map( $self->moniker_map, - sub { $self->_default_table2moniker( shift ) }, + $self->curry::_default_table2moniker, $table - ); + ); } sub _load_relationships { @@ -2824,7 +3018,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 ); @@ -2900,12 +3094,7 @@ sub _base_class_pod { return '' unless $self->generate_pod; - return <<"EOF" -=head1 BASE CLASS: L<$base_class> - -=cut - -EOF + return "\n=head1 BASE CLASS: L<$base_class>\n\n=cut\n\n"; } sub _filter_comment { @@ -3028,6 +3217,11 @@ Returns a hashref of table to class mappings. In some cases it will contain multiple entries per table for the original and normalized table names, as above in L. +=head2 generated_classes + +Returns an arrayref of classes that were actually generated (i.e. not +skipped because there were no changes). + =head1 NON-ENGLISH DATABASES If you use the loader on a database with table and column names in a language @@ -3071,9 +3265,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