skip_relationships
skip_load_external
moniker_map
+ column_accessor_map
custom_column_info
inflect_singular
inflect_plural
preserve_case
col_collision_map
real_dump_directory
+ datetime_undef_if_invalid
/);
=head1 NAME
stations_visited | StationVisited
routeChange | RouteChange
+=head2 column_accessor_map
+
+Same as moniker_map, but for column accessor names. If a coderef is
+passed, the code is called with arguments of
+
+ 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_name => name of the database 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),
+ }
+
=head2 inflect_plural
Just like L</moniker_map> above (can be hash/code-ref, falls back to default
Sets the locale attribute for L<DBIx::Class::InflateColumn::DateTime> for all
columns with the DATE/DATETIME/TIMESTAMP data_types.
+=head2 datetime_undef_if_invalid
+
+Pass a C<0> for this option when using MySQL if you B<DON'T> want C<<
+datetime_undef_if_invalid => 1 >> in your column info for DATE, DATETIME and
+TIMESTAMP columns.
+
+The default is recommended to deal with data such as C<00/00/00> which
+sometimes ends up in such columns in MySQL.
+
=head2 config_file
File in Perl format, which should return a HASH reference, from which to read
eval_without_redefine_warnings ("require $class");
}
catch {
- die "Failed to reload class $class: $_";
+ my $source = slurp $self->_get_dump_filename($class);
+ die "Failed to reload class $class: $_.\n\nCLASS SOURCE:\n\n$source";
};
}
. qq|# DO NOT MODIFY THE FIRST PART OF THIS FILE\n\n|;
if ($self->use_moose) {
- $schema_text.= qq|use Moose;\nuse MooseX::NonMoose;\nuse namespace::autoclean;\nextends '$schema_base_class';\n\n|;
+ $schema_text.= qq|use Moose;\nuse namespace::autoclean;\nextends '$schema_base_class';\n\n|;
}
else {
$schema_text .= qq|use strict;\nuse warnings;\n\nuse base '$schema_base_class';\n\n|;
}
}
- $custom_content ||= $self->_default_custom_content;
+ $custom_content ||= $self->_default_custom_content($is_schema);
# If upgrading to use_moose=1 replace default custom content with default Moose custom content.
# If there is already custom content, which does not have the Moose content, add it.
};
if ($custom_content eq $non_moose_custom_content) {
- $custom_content = $self->_default_custom_content;
+ $custom_content = $self->_default_custom_content($is_schema);
}
- elsif ($custom_content !~ /\Q@{[$self->_default_moose_custom_content]}\E/) {
- $custom_content .= $self->_default_custom_content;
+ elsif ($custom_content !~ /\Q@{[$self->_default_moose_custom_content($is_schema)]}\E/) {
+ $custom_content .= $self->_default_custom_content($is_schema);
}
}
elsif (defined $self->use_moose && $old_gen) {
}
sub _default_moose_custom_content {
- return qq|\n__PACKAGE__->meta->make_immutable;|;
+ my ($self, $is_schema) = @_;
+
+ if (not $is_schema) {
+ return qq|\n__PACKAGE__->meta->make_immutable;|;
+ }
+
+ return qq|\n__PACKAGE__->meta->make_immutable(inline_constructor => 0);|;
}
sub _default_custom_content {
- my $self = shift;
+ my ($self, $is_schema) = @_;
my $default = qq|\n\n# You can replace this text with custom|
. qq| code or comments, and it will be preserved on regeneration|;
if ($self->use_moose) {
- $default .= $self->_default_moose_custom_content;
+ $default .= $self->_default_moose_custom_content($is_schema);
}
$default .= qq|\n1;\n|;
return $default;
die $@ if $@;
push @methods, @{ Class::Inspector->methods($class) || [] };
- push @methods, @{ Class::Inspector->methods('UNIVERSAL') || [] };
}
+ push @methods, @{ Class::Inspector->methods('UNIVERSAL') };
+
my %methods;
@methods{@methods} = ();
}
}
-sub _make_column_accessor_name {
- my ($self, $column_name) = @_;
+# use the same logic to run moniker_map, column_accessor_map, and
+# relationship_name_map
+sub _run_user_map {
+ my ( $self, $map, $default_code, $ident, @extra ) = @_;
+
+ my $default_ident = $default_code->( $ident, @extra );
+ my $new_ident;
+ if( $map && ref $map eq 'HASH' ) {
+ $new_ident = $map->{ $ident };
+ }
+ elsif( $map && ref $map eq 'CODE' ) {
+ $new_ident = $map->( $ident, $default_ident, @extra );
+ }
+
+ $new_ident ||= $default_ident;
+
+ return $new_ident;
+}
+
+sub _default_column_accessor_name {
+ my ( $self, $column_name ) = @_;
+
+ my $accessor_name = $column_name;
+ $accessor_name =~ s/\W+/_/g;
+
+ if ((($self->naming->{column_accessors}||'') =~ /(\d+)/ && $1 < 7) || (not $self->preserve_case)) {
+ # older naming just lc'd the col accessor and that's all.
+ return lc $accessor_name;
+ }
return join '_', map lc, split_name $column_name;
+
+}
+
+sub _make_column_accessor_name {
+ my ($self, $column_name, $column_context_info ) = @_;
+
+ my $accessor = $self->_run_user_map(
+ $self->column_accessor_map,
+ sub { $self->_default_column_accessor_name( shift ) },
+ $column_name,
+ $column_context_info,
+ );
+
+ return $accessor;
}
# Set up metadata (cols, pks, etc)
$self->_dbic_stmt($table_class, 'table', $full_table_name);
- my $cols = $self->_table_columns($table);
+ my $cols = $self->_table_columns($table);
my $col_info = $self->__columns_info_for($table);
+ ### generate all the column accessor names
while (my ($col, $info) = each %$col_info) {
- if ($col =~ /\W/) {
- ($info->{accessor} = $col) =~ s/\W+/_/g;
- }
- }
+ # hashref of other info that could be used by
+ # user-defined accessor map functions
+ my $context = {
+ table_class => $table_class,
+ table_moniker => $table_moniker,
+ table_name => $table_name,
+ full_table_name => $full_table_name,
+ schema_class => $schema_class,
+ column_info => $info,
+ };
- if ($self->preserve_case) {
- while (my ($col, $info) = each %$col_info) {
- if ($col ne lc($col)) {
- if ((not exists $self->naming->{column_accessors}) || (($self->naming->{column_accessors} =~ /(\d+)/)[0] >= 7)) {
- $info->{accessor} = $self->_make_column_accessor_name($info->{accessor} || $col);
- }
- else {
- $info->{accessor} = lc($info->{accessor} || $col);
- }
- }
- }
- }
- else {
- # XXX this needs to go away
- $col_info = { map { lc($_), $col_info->{$_} } keys %$col_info };
+ $info->{accessor} = $self->_make_column_accessor_name( $col, $context );
}
$self->_resolve_col_accessor_collisions($full_table_name, $col_info);
+ # prune any redundant accessor names
+ while (my ($col, $info) = each %$col_info) {
+ no warnings 'uninitialized';
+ delete $info->{accessor} if $info->{accessor} eq $col;
+ }
+
my $fks = $self->_table_fk_info($table);
foreach my $fkdef (@$fks) {
sub _table2moniker {
my ( $self, $table ) = @_;
- my $moniker;
-
- if( ref $self->moniker_map eq 'HASH' ) {
- $moniker = $self->moniker_map->{$table};
- }
- elsif( ref $self->moniker_map eq 'CODE' ) {
- $moniker = $self->moniker_map->($table);
- }
-
- $moniker ||= $self->_default_table2moniker($table);
-
- return $moniker;
+ $self->_run_user_map(
+ $self->moniker_map,
+ sub { $self->_default_table2moniker( shift ) },
+ $table
+ );
}
sub _load_relationships {