use Symbol 'gensym';
use namespace::clean;
-our $VERSION = '0.07010';
+our $VERSION = '0.07011';
__PACKAGE__->mk_group_ro_accessors('simple', qw/
schema
result_base_class
result_roles
use_moose
+ only_autoclean
overwrite_modifications
relationship_attrs
The option also takes a hashref:
- naming => { relationships => 'v7', monikers => 'v7' }
+ naming => {
+ relationships => 'v8',
+ monikers => 'v8',
+ column_accessors => 'v8',
+ force_ascii => 1,
+ }
+
+or
+
+ naming => { ALL => 'v8', force_ascii => 1 }
The keys are:
=over 4
+=item ALL
+
+Set L</relationships>, L</monikers> and L</column_accessors> to the specified
+value.
+
=item relationships
How to name relationship accessors.
=item force_ascii
For L</v8> mode and later, uses L<String::ToIdentifier::EN> instead of
-L<String::ToIdentifier::EM::Unicode> to force monikers and other identifiers
-such as relationship names to ASCII.
+L<String::ToIdentifier::EM::Unicode> to force monikers and other identifiers to
+ASCII.
=back
The default mode is L</v7>, to get L</v8> mode, you have to specify it in
L</naming> explictly until C<0.08> comes out.
-L</monikers> are created using L<String::ToIdentifier::EN::Unicode> or
-L<String::ToIdentifier::EN> if L</force_ascii> is set; this is only significant
-for table names with non C<\w> characters such as C<.>.
+L</monikers> and L</column_accessors> are created using
+L<String::ToIdentifier::EN::Unicode> or L<String::ToIdentifier::EN> if
+L</force_ascii> 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<VLANValidID> 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, for example just C<Id>, C<_?ref>, C<_?cd>,
+C<_?code> and C<_?num>, case insensitively.
=item preserve
Comment metadata can be stored in two ways.
The first is that you can create two tables named C<table_comments> and
-C<column_comments> respectively. They both need to have columns named
-C<table_name> and C<comment_text>. The second one needs to have a column
-named C<column_name>. Then data stored in these tables will be used as a
-source of metadata about tables and comments.
+C<column_comments> respectively. These tables must exist in the same database
+and schema as the tables they describe. They both need to have columns named
+C<table_name> and C<comment_text>. The second one needs to have a column named
+C<column_name>. Then data stored in these tables will be used as a source of
+metadata about tables and comments.
(If you wish you can change the name of these tables with the parameters
L</table_comments_table> and L</column_comments_table>.)
The table to look for comments about tables in. By default C<table_comments>.
See L</generate_pod> for details.
+This must not be a fully qualified name, the table will be looked for in the
+same database and schema as the table whose comment is being retrieved.
+
=head2 column_comments_table
The table to look for comments about columns in. By default C<column_comments>.
See L</generate_pod> for details.
+This must not be a fully qualified name, the table will be looked for in the
+same database and schema as the table/column whose comment is being retrieved.
+
=head2 relationship_attrs
Hashref of attributes to pass to each generated relationship, listed
Base class for your schema classes. Defaults to 'DBIx::Class::Schema'.
+=head2 schema_components
+
+List of components to load into the Schema class.
+
=head2 result_base_class
Base class for your table classes (aka result classes). Defaults to
List of additional classes which all of your table classes will use.
-=head2 schema_components
-
-List of components to load into the Schema class.
-
=head2 components
List of additional components to be loaded into all of your Result
=head2 preserve_case
-Usually column names are lowercased, to make them easier to work with in
-L<DBIx::Class>. 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<NOTE:> L</naming> = C<v8> is highly recommended with this option as the
+semantics of this mode are much improved for CamelCase database names.
+
+L</naming> = C<v7> or greater is required with this option.
=head2 qualify_objects
=head2 use_moose
Creates Schema and Result classes that use L<Moose>, L<MooseX::NonMoose> and
-L<namespace::autoclean>. The default content after the md5 sum also makes the
-classes immutable.
+L<MooseX::MarkAsMethods> (or L<namespace::autoclean>, 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<MooseX::MarkAsMethods> to remove imported functions from
+your generated classes. It uses L<namespace::autoclean> to do this, after
+telling your object's metaclass that any operator L<overload>s 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<namespace::autoclean> itself.
+
+If none of the above made any sense, or you don't have some pressing need to
+only use L<namespace::autoclean>, leaving this set to the default is
+recommended.
+
=head2 col_collision_map
This option controls how accessors for column names which collide with perl
column_accessors => $naming_ver,
};
}
+ elsif (ref $self->naming eq 'HASH' && exists $self->naming->{ALL}) {
+ my $val = delete $self->naming->{ALL};
+
+ $self->naming->{$_} = $val
+ foreach qw/relationships monikers column_accessors/;
+ }
if ($self->naming) {
- for (values %{ $self->naming }) {
- $_ = $CURRENT_V if $_ eq 'current';
+ foreach my $key (qw/relationships monikers column_accessors/) {
+ $self->naming->{$key} = $CURRENT_V if ($self->naming->{$key}||'') eq 'current';
}
}
$self->{naming} ||= {};
return if $self->{skip_relationships};
return $self->{relbuilder} ||= do {
-
- no warnings 'uninitialized';
my $relbuilder_suff =
{qw{
v4 ::Compat::v0_040
v5 ::Compat::v0_05
v6 ::Compat::v0_06
+ v7 ::Compat::v0_07
}}
- ->{ $self->naming->{relationships}};
+ ->{$self->naming->{relationships}||$CURRENT_V} || '';
my $relbuilder_class = 'DBIx::Class::Schema::Loader::RelBuilder'.$relbuilder_suff;
$self->ensure_class_loaded($relbuilder_class);
- $relbuilder_class->new( $self );
-
+ $relbuilder_class->new($self);
};
}
. 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|;
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 }) {
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;
}
sub _default_column_accessor_name {
my ( $self, $column_name ) = @_;
- my $accessor_name = $column_name;
- $accessor_name =~ s/\W+/_/g;
+ 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, '_');
- if ((($self->naming->{column_accessors}||'') =~ /(\d+)/ && $1 < 7) || (not $self->preserve_case)) {
+ $accessor_name =~ s/\W+/_/g; # only if naming < v8, otherwise to_identifier
+ # takes care of it
+
+ 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 {
return values %{$self->_tables};
}
+sub _get_naming_v {
+ my ($self, $naming_key) = @_;
+
+ my $v;
+
+ if (($self->naming->{$naming_key}||'') =~ /^v(\d+)\z/) {
+ $v = $1;
+ }
+ else {
+ ($v) = $CURRENT_V =~ /^v(\d+)\z/;
+ }
+
+ return $v;
+}
+
+sub _to_identifier {
+ my ($self, $naming_key, $name, $sep_char, $force) = @_;
+
+ my $v = $self->_get_naming_v($naming_key);
+
+ my $to_identifier = $self->naming->{force_ascii} ?
+ \&String::ToIdentifier::EN::to_identifier
+ : \&String::ToIdentifier::EN::Unicode::to_identifier;
+
+ return $v >= 8 || $force ? $to_identifier->($name, $sep_char) : $name;
+}
+
# Make a moniker from a table
sub _default_table2moniker {
my ($self, $table) = @_;
- my ($v) = ($self->naming->{monikers}||$CURRENT_V) =~ /^v(\d+)\z/;
+ my $v = $self->_get_naming_v('monikers');
my @name_parts = map $table->$_, @{ $self->moniker_parts };
my $name_idx = firstidx { $_ eq 'name' } @{ $self->moniker_parts };
- my $to_identifier = $self->naming->{force_ascii} ?
- \&String::ToIdentifier::EN::to_identifier
- : \&String::ToIdentifier::EN::Unicode::to_identifier;
-
my @all_parts;
foreach my $i (0 .. $#name_parts) {
my $part = $name_parts[$i];
- if ($i != $name_idx || $v > 7) {
- $part = $to_identifier->($part, '_');
+ if ($i != $name_idx || $v >= 8) {
+ $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;
projects / dbsrgits/DBIx-Class-Schema-Loader.git / blobdiff