pod_comment_mode
pod_comment_spillover_length
preserve_case
+ col_collision_map
/);
=head1 NAME
The default behavior is instead to only replace the top portion of the
file, up to and including the final stanza which contains
-C<# DO NOT MODIFY THIS OR ANYTHING ABOVE!>
+C<# DO NOT MODIFY THE FIRST PART OF THIS FILE>
leaving any customizations you placed after that as they were.
When C<really_erase_my_files> is not set, if the output file already exists,
It is safe to upgrade your existing Schema to this option.
+=head2 col_collision_map
+
+This option controls how accessors for column names which collide with perl
+methods are named. See L</COLUMN ACCESSOR COLLISIONS> for more information.
+
+This option takes either a single L<sprintf|perlfunc/sprintf> format or a hashref of
+strings which are compiled to regular expressions that map to
+L<sprintf|perlfunc/sprintf> formats.
+
+Examples:
+
+ col_collision_map => 'column_%s'
+
+ col_collision_map => { '(.*)' => 'column_%s' }
+
+ col_collision_map => { '(foo).*(bar)' => 'column_%s_%s' }
+
=head1 METHODS
None of these methods are intended for direct invocation by regular
$self->pod_comment_mode('auto') unless defined $self->pod_comment_mode;
$self->pod_comment_spillover_length(60) unless defined $self->pod_comment_spillover_length;
+ if (my $col_collision_map = $self->col_collision_map) {
+ if (my $reftype = ref $col_collision_map) {
+ if ($reftype ne 'HASH') {
+ croak "Invalid type $reftype for option 'col_collision_map'";
+ }
+ }
+ else {
+ $self->col_collision_map({ '(.*)' => $col_collision_map });
+ }
+ }
+
$self;
}
}
sub _resolve_col_accessor_collisions {
- my ($self, $col_info) = @_;
+ my ($self, $table, $col_info) = @_;
my $base = $self->result_base_class || 'DBIx::Class::Core';
my @components = map "DBIx::Class::$_", @{ $self->components || [] };
+ my $table_name = ref $table ? $$table : $table;
+
my @methods;
for my $class ($base, @components, $self->use_moose ? 'Moose::Object' : ()) {
die $@ if $@;
push @methods, @{ Class::Inspector->methods($class) || [] };
+ push @methods, @{ Class::Inspector->methods('UNIVERSAL') || [] };
}
my %methods;
next if $accessor eq 'id'; # special case (very common column)
if (exists $methods{$accessor}) {
- $info->{accessor} = undef;
+ my $mapped = 0;
+
+ if (my $map = $self->col_collision_map) {
+ for my $re (keys %$map) {
+ if (my @matches = $col =~ /$re/) {
+ $info->{accessor} = sprintf $map->{$re}, @matches;
+ $mapped = 1;
+ }
+ }
+ }
+
+ if (not $mapped) {
+ warn <<"EOF";
+Column $col in table $table_name collides with an inherited method.
+See "COLUMN ACCESSOR COLLISIONS" in perldoc DBIx::Class::Schema::Loader::Base .
+EOF
+ $info->{accessor} = undef;
+ }
}
}
}
$col_info = { map { lc($_), $col_info->{$_} } keys %$col_info };
}
- $self->_resolve_col_accessor_collisions($col_info);
+ $self->_resolve_col_accessor_collisions($full_table_name, $col_info);
my $fks = $self->_table_fk_info($table);
contain multiple entries per table for the original and normalized table
names, as above in L</monikers>.
+=head1 COLUMN ACCESSOR COLLISIONS
+
+Occasionally you may have a column name that collides with a perl method, such
+as C<can>. In such cases, the default action is to set the C<accessor> of the
+column spec to C<undef>.
+
+You can then name the accessor yourself by placing code such as the following
+below the md5:
+
+ __PACKAGE__->add_column('+can' => { accessor => 'my_can' });
+
+Another option is to use the L</col_collision_map> option.
+
=head1 SEE ALSO
L<DBIx::Class::Schema::Loader>