X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FDBIx%2FClass%2FSchema%2FLoader%2FBase.pm;h=0ea7f0bf0b94a5d47caff48f62be8273e9123841;hb=8e6c80c9ded48d2f9450de4200c4490b13d0c942;hp=b95ed427d362116647651f1ba46f32aecbda33ab;hpb=8fa7becae8a917861cd28833059ed65109f20221;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 b95ed42..0ea7f0b 100644 --- a/lib/DBIx/Class/Schema/Loader/Base.pm +++ b/lib/DBIx/Class/Schema/Loader/Base.pm @@ -29,7 +29,7 @@ use IPC::Open2; use Symbol 'gensym'; use namespace::clean; -our $VERSION = '0.07010'; +our $VERSION = '0.07011'; __PACKAGE__->mk_group_ro_accessors('simple', qw/ schema @@ -59,6 +59,7 @@ __PACKAGE__->mk_group_ro_accessors('simple', qw/ result_base_class result_roles use_moose + only_autoclean overwrite_modifications relationship_attrs @@ -262,9 +263,12 @@ L or L if L is set; this is only significant for names with non-C<\w> characters such as C<.>. +CamelCase identifiers with words in all caps, e.g. C are supported +correctly in this mode. + For relationships, belongs_to accessors are made from column names by stripping -postfixes other than C<_id> as well, just C, C<_?ref>, C<_?cd>, C<_?code> -and C<_num>. +postfixes other than C<_id> as well, for example just C, C<_?ref>, C<_?cd>, +C<_?code> and C<_?num>, case insensitively. =item preserve @@ -722,15 +726,16 @@ loader options. =head2 preserve_case -Usually column names are lowercased, to make them easier to work with in -L. This option lets you turn this behavior off, if the driver -supports it. +Normally database names are lowercased and split by underscore, use this option +if you have CamelCase database names. Drivers for case sensitive databases like Sybase ASE or MSSQL with a case-sensitive collation will turn this option on unconditionally. -Currently the drivers for SQLite, mysql, MSSQL and Firebird/InterBase support -setting this option. +B L = C is highly recommended with this option as the +semantics of this mode are much improved for CamelCase database names. + +L = C or greater is required with this option. =head2 qualify_objects @@ -740,11 +745,27 @@ __PACKAGE__->table >> calls, and to some other things like Oracle sequences. =head2 use_moose Creates Schema and Result classes that use L, L and -L. The default content after the md5 sum also makes the -classes immutable. +L (or L, see below). The default +content after the md5 sum also makes the classes immutable. It is safe to upgrade your existing Schema to this option. +=head2 only_autoclean + +By default, we use L to remove imported functions from +your generated classes. It uses L to do this, after +telling your object's metaclass that any operator Ls in your class +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 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. + =head2 col_collision_map This option controls how accessors for column names which collide with perl @@ -1649,8 +1670,15 @@ sub _dump_to_dir { . qq|# Created by DBIx::Class::Schema::Loader\n| . qq|# DO NOT MODIFY THE FIRST PART OF THIS FILE\n\n|; + my $autoclean + = $self->only_autoclean + ? 'namespace::autoclean' + : 'MooseX::MarkAsMethods autoclean => 1' + ; + if ($self->use_moose) { - $schema_text.= qq|use Moose;\nuse namespace::autoclean;\nextends '$schema_base_class';\n\n|; + + $schema_text.= qq|use Moose;\nuse $autoclean;\nextends '$schema_base_class';\n\n|; } else { $schema_text .= qq|use strict;\nuse warnings;\n\nuse base '$schema_base_class';\n\n|; @@ -1708,7 +1736,7 @@ sub _dump_to_dir { unless $result_base_class eq 'DBIx::Class::Core'; if ($self->use_moose) { - $src_text.= qq|use Moose;\nuse MooseX::NonMoose;\nuse namespace::autoclean;|; + $src_text.= qq|use Moose;\nuse MooseX::NonMoose;\nuse $autoclean;|; # these options 'use base' which is compile time if (@{ $self->left_base_classes } || @{ $self->additional_base_classes }) { @@ -1775,17 +1803,13 @@ sub _write_classfile { my $custom_content = $old_custom || ''; - # prepend extra custom content from a *renamed* class (singularization effect) + # Use custom content from a renamed class, the class names in it are + # rewritten below. if (my $renamed_class = $self->_upgrading_classes->{$class}) { my $old_filename = $self->_get_dump_filename($renamed_class); if (-f $old_filename) { - my $extra_custom = ($self->_parse_generated_file ($old_filename))[4]; - - $extra_custom =~ s/\n\n# You can replace.*\n1;\n//; - - $custom_content = join ("\n", '', $extra_custom, $custom_content) - if $extra_custom; + $custom_content = ($self->_parse_generated_file ($old_filename))[4]; unlink $old_filename; } @@ -2185,20 +2209,27 @@ sub _run_user_map { sub _default_column_accessor_name { my ( $self, $column_name ) = @_; - my $accessor_name = $self->_to_identifier('column_accessors', $column_name, '_'); + my $preserve = ($self->naming->{column_accessors}||'') eq 'preserve'; + + my $v = $self->_get_naming_v('column_accessors'); + + my $accessor_name = $preserve ? + $self->_to_identifier('column_accessors', $column_name) # assume CamelCase + : + $self->_to_identifier('column_accessors', $column_name, '_'); $accessor_name =~ s/\W+/_/g; # only if naming < v8, otherwise to_identifier # takes care of it - if ((($self->naming->{column_accessors}||'') =~ /(\d+)/ && $1 < 7) || (not $self->preserve_case)) { + if ($preserve) { + return $accessor_name; + } + elsif ($v < 7 || (not $self->preserve_case)) { # older naming just lc'd the col accessor and that's all. return lc $accessor_name; } - elsif (($self->naming->{column_accessors}||'') eq 'preserve') { - return $accessor_name; - } - return join '_', map lc, split_name $column_name; + return join '_', map lc, split_name $column_name, $v; } sub _make_column_accessor_name { @@ -2363,7 +2394,7 @@ sub _get_naming_v { } sub _to_identifier { - my ($self, $naming_key, $name, $sep_char) = @_; + my ($self, $naming_key, $name, $sep_char, $force) = @_; my $v = $self->_get_naming_v($naming_key); @@ -2371,7 +2402,7 @@ sub _to_identifier { \&String::ToIdentifier::EN::to_identifier : \&String::ToIdentifier::EN::Unicode::to_identifier; - return $v >= 8 ? $to_identifier->($name, $sep_char) : $name; + return $v >= 8 || $force ? $to_identifier->($name, $sep_char) : $name; } # Make a moniker from a table @@ -2390,14 +2421,17 @@ sub _default_table2moniker { my $part = $name_parts[$i]; if ($i != $name_idx || $v >= 8) { - $part = $self->_to_identifier('monikers', $part, '_'); + $part = $self->_to_identifier('monikers', $part, '_', 1); } if ($i == $name_idx && $v == 5) { $part = Lingua::EN::Inflect::Number::to_S($part); } - my @part_parts = map lc, $v > 6 ? split_name $part : split /[\W_]+/, $part; + my @part_parts = map lc, $v > 6 ? + # use v8 semantics for all moniker parts except name + ($i == $name_idx ? split_name $part, $v : split_name $part) + : split /[\W_]+/, $part; if ($i == $name_idx && $v >= 6) { my $as_phrase = join ' ', @part_parts;