use base qw/Class::Accessor::Grouped Class::C3::Componentised/;
use mro 'c3';
use Carp::Clan qw/^DBIx::Class/;
-use DBIx::Class::Schema::Loader::RelBuilder;
-use Data::Dump qw/ dump /;
-use POSIX qw//;
-use File::Spec qw//;
-use Cwd qw//;
-use Digest::MD5 qw//;
-use Lingua::EN::Inflect::Number qw//;
-use Lingua::EN::Inflect::Phrase qw//;
-use File::Temp qw//;
+use DBIx::Class::Schema::Loader::RelBuilder ();
+use Data::Dump 'dump';
+use POSIX ();
+use File::Spec ();
+use Cwd ();
+use Digest::MD5 ();
+use Lingua::EN::Inflect::Number ();
+use Lingua::EN::Inflect::Phrase ();
+use String::ToIdentifier::EN ();
+use String::ToIdentifier::EN::Unicode ();
+use File::Temp ();
use Class::Unload;
use Class::Inspector ();
use Scalar::Util 'looks_like_number';
=head1 SYNOPSIS
-See L<DBIx::Class::Schema::Loader>
+See L<DBIx::Class::Schema::Loader>.
=head1 DESCRIPTION
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.
How to name column accessors in Result classes.
+=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 to
+ASCII.
+
=back
The values can be:
If you don't have any CamelCase table or column names, you can upgrade without
breaking any of your code.
+=item v8
+
+(EXPERIMENTAL)
+
+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> 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<.>.
+
+For relationships, belongs_to accessors are made from column names by stripping
+postfixes other than C<_id> as well, just C<id>, C<_?ref>, C<_?cd>, C<_?code>
+and C<_num>.
+
=item preserve
For L</monikers>, this option does not inflect the table names but makes
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
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);
};
}
if (@clashes) {
die 'Unable to load schema - chosen moniker/class naming style results in moniker clashes. '
- . 'Either change the naming style, or supply an explicit moniker_map: '
+ . 'In multi db_schema configurations you may need to set moniker_parts, '
+ . 'otherwise change the naming style, or supply an explicit moniker_map: '
. join ('; ', @clashes)
. "\n"
;
unless $self->dynamic or $self->quiet;
my $schema_text =
- qq|package $schema_class;\n\n|
+ qq|use utf8;\n|
+ . qq|package $schema_class;\n\n|
. qq|# Created by DBIx::Class::Schema::Loader\n|
. qq|# DO NOT MODIFY THE FIRST PART OF THIS FILE\n\n|;
foreach my $src_class (@classes) {
my $src_text =
- qq|package $src_class;\n\n|
+ qq|use utf8;\n|
+ . qq|package $src_class;\n\n|
. qq|# Created by DBIx::Class::Schema::Loader\n|
. qq|# DO NOT MODIFY THE FIRST PART OF THIS FILE\n\n|;
);
}
- my $old_class = join(q{::}, @result_namespace, $table_moniker);
+ my $old_table_moniker = do {
+ local $self->naming->{monikers} = $upgrading_v;
+ $self->_table2moniker($table);
+ };
+
+ my $old_class = join(q{::}, @result_namespace, $old_table_moniker);
$self->_upgrading_classes->{$table_class} = $old_class
unless $table_class eq $old_class;
sub _default_column_accessor_name {
my ( $self, $column_name ) = @_;
- my $accessor_name = $column_name;
- $accessor_name =~ s/\W+/_/g;
+ my $accessor_name = $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)) {
# older naming just lc'd the col accessor and that's all.
$self->_dbic_stmt($table_class, 'set_primary_key', @$pks)
if @$pks;
+ # Sort unique constraints by constraint name for repeatable results (rels
+ # are sorted as well elsewhere.)
+ @uniqs = sort { $a->[0] cmp $b->[0] } @uniqs;
+
foreach my $uniq (@uniqs) {
my ($name, $cols) = @$uniq;
$self->_dbic_stmt($table_class,'add_unique_constraint', $name, $cols);
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) = @_;
+
+ 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 ? $to_identifier->($name, $sep_char) : $name;
+}
+
# Make a moniker from a table
sub _default_table2moniker {
- no warnings 'uninitialized';
my ($self, $table) = @_;
+ my $v = $self->_get_naming_v('monikers');
+
my @name_parts = map $table->$_, @{ $self->moniker_parts };
my $name_idx = firstidx { $_ eq 'name' } @{ $self->moniker_parts };
- if ($self->naming->{monikers} eq 'v4') {
- return join '', map ucfirst, map split(/[\W_]+/, lc $_), @name_parts;
- }
- elsif ($self->naming->{monikers} eq 'v5') {
- my @parts = map lc, @name_parts;
- $parts[$name_idx] = Lingua::EN::Inflect::Number::to_S($parts[$name_idx]);
+ my @all_parts;
- return join '', map ucfirst, map split(/[\W_]+/, $_), @parts;
- }
- elsif ($self->naming->{monikers} eq 'v6') {
- (my $as_phrase = join '', map lc, @name_parts) =~ s/_+/ /g;
- my $inflected = Lingua::EN::Inflect::Phrase::to_S($as_phrase);
+ foreach my $i (0 .. $#name_parts) {
+ my $part = $name_parts[$i];
- return join '', map ucfirst, split /\W+/, $inflected;
- }
+ if ($i != $name_idx || $v >= 8) {
+ $part = $self->_to_identifier('monikers', $part, '_');
+ }
- my @words = map lc, map split_name $_, @name_parts;
- my $as_phrase = join ' ', @words;
+ 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 $inflected = $self->naming->{monikers} eq 'plural' ?
- Lingua::EN::Inflect::Phrase::to_PL($as_phrase)
- :
- $self->naming->{monikers} eq 'preserve' ?
- $as_phrase
- :
- Lingua::EN::Inflect::Phrase::to_S($as_phrase);
+ if ($i == $name_idx && $v >= 6) {
+ my $as_phrase = join ' ', @part_parts;
- return join '', map ucfirst, split /\W+/, $inflected;
+ my $inflected = ($self->naming->{monikers}||'') eq 'plural' ?
+ Lingua::EN::Inflect::Phrase::to_PL($as_phrase)
+ :
+ ($self->naming->{monikers}||'') eq 'preserve' ?
+ $as_phrase
+ :
+ Lingua::EN::Inflect::Phrase::to_S($as_phrase);
+
+ @part_parts = split /\s+/, $inflected;
+ }
+
+ push @all_parts, map ucfirst, @part_parts;
+ }
+
+ return join '', @all_parts;
}
sub _table2moniker {
sub _base_class_pod {
my ($self, $base_class) = @_;
- return unless $self->generate_pod;
+ return '' unless $self->generate_pod;
return <<"EOF"
=head1 BASE CLASS: L<$base_class>
contain multiple entries per table for the original and normalized table
names, as above in L</monikers>.
+=head1 NON-ENGLISH DATABASES
+
+If you use the loader on a database with table and column names in a language
+other than English, you will want to turn off the English language specific
+heuristics.
+
+To do so, use something like this in your laoder options:
+
+ naming => { monikers => 'v4' },
+ inflect_singular => sub { "$_[0]_rel" },
+ inflect_plural => sub { "$_[0]_rel" },
+
=head1 COLUMN ACCESSOR COLLISIONS
Occasionally you may have a column name that collides with a perl method, such
projects / dbsrgits/DBIx-Class-Schema-Loader.git / blobdiff