use strict;
use warnings;
use base qw/Class::Accessor::Grouped Class::C3::Componentised/;
+use MRO::Compat;
use mro 'c3';
use Carp::Clan qw/^DBIx::Class/;
use DBIx::Class::Schema::Loader::RelBuilder ();
use Class::Unload;
use Class::Inspector ();
use Scalar::Util 'looks_like_number';
-use DBIx::Class::Schema::Loader::Utils qw/split_name dumper_squashed eval_package_without_redefine_warnings class_path slurp_file/;
+use DBIx::Class::Schema::Loader::Column;
+use DBIx::Class::Schema::Loader::Utils qw/split_name dumper_squashed eval_package_without_redefine_warnings class_path slurp_file sigwarn_silencer firstidx uniq/;
use DBIx::Class::Schema::Loader::Optional::Dependencies ();
use Try::Tiny;
use DBIx::Class ();
use Encode qw/encode decode/;
-use List::MoreUtils qw/all firstidx/;
-use IPC::Open2;
-use Symbol 'gensym';
+use List::Util qw/all any none/;
+use File::Temp 'tempfile';
use namespace::clean;
-our $VERSION = '0.07010';
+our $VERSION = '0.07044';
__PACKAGE__->mk_group_ro_accessors('simple', qw/
schema
result_base_class
result_roles
use_moose
+ only_autoclean
overwrite_modifications
+ dry_run
+ generated_classes
+ omit_version
+ omit_timestamp
relationship_attrs
moniker_to_table
uniq_to_primary
quiet
+ allow_extra_m2m_cols
/);
db_schema
qualify_objects
moniker_parts
+ moniker_part_separator
+ moniker_part_map
/);
my $CURRENT_V = 'v7';
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::EN::Unicode> to force monikers and other identifiers to
+ASCII.
=back
=item v7
This mode is identical to C<v6> mode, except that monikerization of CamelCase
-table names is also done correctly.
+table names is also done better (but best in v8.)
-CamelCase column names in case-preserving mode will also be handled correctly
-for relationship name inflection. See L</preserve_case>.
+CamelCase column names in case-preserving mode will also be handled better
+for relationship name inflection (but best in v8.) See L</preserve_case>.
In this mode, CamelCase L</column_accessors> are normalized based on case
transition instead of just being lowercased, so C<FooId> becomes C<foo_id>.
-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</naming> explicitly 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<.>.
-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<.>.
+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
completed.> messages. Does not affect warnings (except for warnings related to
L</really_erase_my_files>.)
+=head2 dry_run
+
+If true, don't actually write out the generated files. This can only be
+used with static schema generation.
+
=head2 generate_pod
By default POD will be generated for columns and relationships, using database
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
-by type. Also supports relationship type 'all', containing options to
-pass to all generated relationships. Attributes set for more specific
-relationship types override those set in 'all'.
+Hashref of attributes to pass to each generated relationship, listed by type.
+Also supports relationship type 'all', containing options to pass to all
+generated relationships. Attributes set for more specific relationship types
+override those set in 'all', and any attributes specified by this option
+override the introspected attributes of the foreign key if any.
For example:
- relationship_attrs => {
- belongs_to => { is_deferrable => 0 },
- },
+ relationship_attrs => {
+ has_many => { cascade_delete => 1, cascade_copy => 1 },
+ might_have => { cascade_delete => 1, cascade_copy => 1 },
+ },
+
+use this to turn L<DBIx::Class> cascades to on on your
+L<has_many|DBIx::Class::Relationship/has_many> and
+L<might_have|DBIx::Class::Relationship/might_have> relationships, they default
+to off.
-use this to turn off DEFERRABLE on your foreign key constraints.
+Can also be a coderef, for more precise control, in which case the coderef gets
+this hash of parameters (as a list:)
+
+ rel_name # the name of the relationship
+ rel_type # the type of the relationship: 'belongs_to', 'has_many' or 'might_have'
+ local_source # the DBIx::Class::ResultSource object for the source the rel is *from*
+ remote_source # the DBIx::Class::ResultSource object for the source the rel is *to*
+ local_table # a DBIx::Class::Schema::Loader::Table object for the table of the source the rel is from
+ local_cols # an arrayref of column names of columns used in the rel in the source it is from
+ remote_table # a DBIx::Class::Schema::Loader::Table object for the table of the source the rel is to
+ remote_cols # an arrayref of column names of columns used in the rel in the source it is to
+ attrs # the attributes that would be set
+
+it should return the new hashref of attributes, or nothing for no changes.
+
+For example:
+
+ relationship_attrs => sub {
+ my %p = @_;
+
+ say "the relationship name is: $p{rel_name}";
+ say "the relationship is a: $p{rel_type}";
+ say "the local class is: ", $p{local_source}->result_class;
+ say "the remote class is: ", $p{remote_source}->result_class;
+ say "the local table is: ", $p{local_table}->sql_name;
+ say "the rel columns in the local table are: ", (join ", ", @{$p{local_cols}});
+ say "the remote table is: ", $p{remote_table}->sql_name;
+ say "the rel columns in the remote table are: ", (join ", ", @{$p{remote_cols}});
+
+ if ($p{local_table} eq 'dogs' && @{$p{local_cols}} == 1 && $p{local_cols}[0] eq 'name') {
+ $p{attrs}{could_be_snoopy} = 1;
+
+ reutrn $p{attrs};
+ }
+ },
+
+These are the default attributes:
+
+ has_many => {
+ cascade_delete => 0,
+ cascade_copy => 0,
+ },
+ might_have => {
+ cascade_delete => 0,
+ cascade_copy => 0,
+ },
+ belongs_to => {
+ on_delete => 'CASCADE',
+ on_update => 'CASCADE',
+ is_deferrable => 1,
+ },
+
+For L<belongs_to|DBIx::Class::Relationship/belongs_to> relationships, these
+defaults are overridden by the attributes introspected from the foreign key in
+the database, if this information is available (and the driver is capable of
+retrieving it.)
+
+This information overrides the defaults mentioned above, and is then itself
+overridden by the user's L</relationship_attrs> for C<belongs_to> if any are
+specified.
+
+In general, for most databases, for a plain foreign key with no rules, the
+values for a L<belongs_to|DBIx::Class::Relationship/belongs_to> relationship
+will be:
+
+ on_delete => 'NO ACTION',
+ on_update => 'NO ACTION',
+ is_deferrable => 0,
+
+In the cases where an attribute is not supported by the DB, a value matching
+the actual behavior is used, for example Oracle does not support C<ON UPDATE>
+rules, so C<on_update> is set to C<NO ACTION>. This is done so that the
+behavior of the schema is preserved when cross deploying to a different RDBMS
+such as SQLite for testing.
+
+In the cases where the DB does not support C<DEFERRABLE> foreign keys, the
+value is set to C<1> if L<DBIx::Class> has a working C<<
+$storage->with_deferred_fk_checks >>. This is done so that the same
+L<DBIx::Class> code can be used, and cross deployed from and to such databases.
=head2 debug
for all owners in all databases.
-You may need to control naming of monikers with L</moniker_parts> if you have
-name clashes for tables in different schemas/databases.
+Name clashes resulting from the same table name in different databases/schemas
+will be resolved automatically by prefixing the moniker with the database
+and/or schema.
+
+To prefix/suffix all monikers with the database and/or schema, see
+L</moniker_parts>.
=head2 moniker_parts
The L</moniker_parts> option is an arrayref of methods on the table class
corresponding to parts of the fully qualified table name, defaulting to
C<['name']>, in the order those parts are used to create the moniker name.
+The parts are joined together using L</moniker_part_separator>.
The C<'name'> entry B<must> be present.
=item * Informix, MSSQL, Sybase ASE
-C<database>, C<schema>, C<name>
+C<database>, C<schema>, C<name>
=back
+=head2 moniker_part_separator
+
+String used to join L</moniker_parts> when creating the moniker.
+Defaults to the empty string. Use C<::> to get a separate namespace per
+database and/or schema.
+
=head2 constraint
-Only load tables matching regex. Best specified as a qr// regex.
+Only load matching tables.
=head2 exclude
-Exclude tables matching regex. Best specified as a qr// regex.
+Exclude matching tables.
+
+These can be specified either as a regex (preferrably on the C<qr//>
+form), or as an arrayref of arrayrefs. Regexes are matched against
+the (unqualified) table name, while arrayrefs are matched according to
+L</moniker_parts>.
+
+For example:
+
+ db_schema => [qw(some_schema other_schema)],
+ moniker_parts => [qw(schema name)],
+ constraint => [
+ [ qr/\Asome_schema\z/ => qr/\A(?:foo|bar)\z/ ],
+ [ qr/\Aother_schema\z/ => qr/\Abaz\z/ ],
+ ],
+
+In this case only the tables C<foo> and C<bar> in C<some_schema> and
+C<baz> in C<other_schema> will be dumped.
=head2 moniker_map
-Overrides the default table name to moniker translation. Can be either
-a hashref of table keys and moniker values, or a coderef for a translator
-function taking a single scalar table name argument and returning
-a scalar moniker. If the hash entry does not exist, or the function
-returns a false value, the code falls back to default behavior
-for that table name.
+Overrides the default table name to moniker translation. Either
+
+=over
+
+=item *
+
+a nested hashref, which will be traversed according to L</moniker_parts>
+
+For example:
+
+ moniker_parts => [qw(schema name)],
+ moniker_map => {
+ foo => {
+ bar => "FooishBar",
+ },
+ },
+
+In which case the table C<bar> in the C<foo> schema would get the moniker
+C<FooishBar>.
+
+=item *
+
+a hashref of unqualified table name keys and moniker values
+
+=item *
+
+a coderef for a translator function taking a L<table
+object|DBIx::Class::Schema::Loader::Table> argument (which stringifies to the
+unqualified table name) and returning a scalar moniker
+
+The function is also passed a coderef that can be called with either
+of the hashref forms to get the moniker mapped accordingly. This is
+useful if you need to handle some monikers specially, but want to use
+the hashref form for the rest.
+
+=back
+
+If the hash entry does not exist, or the function returns a false
+value, the code falls back to default behavior for that table name.
The default behavior is to split on case transition and non-alphanumeric
boundaries, singularize the resulting phrase, then join the titlecased words
stations_visited | StationVisited
routeChange | RouteChange
+=head2 moniker_part_map
+
+Map for overriding the monikerization of individual L</moniker_parts>.
+The keys are the moniker part to override, the value is either a
+hashref of coderef for mapping the corresponding part of the
+moniker. If a coderef is used, it gets called with the moniker part
+and the hash key the code ref was found under.
+
+For example:
+
+ moniker_part_map => {
+ schema => sub { ... },
+ },
+
+Given the table C<foo.bar>, the code ref would be called with the
+arguments C<foo> and C<schema>, plus a coderef similar to the one
+described in L</moniker_map>.
+
+L</moniker_map> takes precedence over this.
+
=head2 col_accessor_map
-Same as moniker_map, but for column accessor names. If a coderef is
+Same as moniker_map, but for column accessor names. The nested
+hashref form is traversed according to L</moniker_parts>, with an
+extra level at the bottom for the column name. 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),
+ the DBIx::Class::Schema::Loader::Column object for the column,
+ 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 => table object of interface DBIx::Class::Schema::Loader::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),
}
+ coderef ref that can be called with a hashref map
+
+The L<column|DBIx::Class::Schema::Loader::Column> and
+L<table|DBIx::Class::Schema::Loader::Table> objects stringify to their
+unqualified names.
=head2 rel_name_map
and relationships that would have been named C<bar> will now be named C<baz>
except that in the table whose moniker is C<Foo> it will be named C<blat>.
-If it is a coderef, the argument passed will be a hashref of this form:
+If it is a coderef, it will be passed a hashref of this form:
{
name => default relationship name,
remote_class => name of the DBIC class we are related to,
remote_moniker => moniker of the DBIC class we are related to,
remote_columns => columns in the other table in the relationship,
+ # for type => "many_to_many" only:
+ link_class => name of the DBIC class for the link table
+ link_moniker => moniker of the DBIC class for the link table
+ link_rel_name => name of the relationship to the link table
}
+In addition it is passed a coderef that can be called with a hashref map.
+
DBICSL will try to use the value returned as the relationship name.
=head2 inflect_plural
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
loads the given components into every Result class, this option allows you to
load certain components for specified Result classes. For example:
- result_components_map => {
- StationVisited => '+YourApp::Schema::Component::StationVisited',
- RouteChange => [
- '+YourApp::Schema::Component::RouteChange',
- 'InflateColumn::DateTime',
- ],
- }
-
+ result_components_map => {
+ StationVisited => '+YourApp::Schema::Component::StationVisited',
+ RouteChange => [
+ '+YourApp::Schema::Component::RouteChange',
+ 'InflateColumn::DateTime',
+ ],
+ }
+
You may use this in conjunction with L</components>.
=head2 result_roles
applies the given roles to every Result class, this option allows you to apply
certain roles for specified Result classes. For example:
- result_roles_map => {
- StationVisited => [
- 'YourApp::Role::Building',
- 'YourApp::Role::Destination',
- ],
- RouteChange => 'YourApp::Role::TripEvent',
- }
-
+ result_roles_map => {
+ StationVisited => [
+ 'YourApp::Role::Building',
+ 'YourApp::Role::Destination',
+ ],
+ RouteChange => 'YourApp::Role::TripEvent',
+ }
+
You may use this in conjunction with L</result_roles>.
=head2 use_namespaces
Again, you should be using version control on your schema classes. Be
careful with this option.
+=head2 omit_version
+
+Omit the package version from the signature comment.
+
+=head2 omit_timestamp
+
+Omit the creation timestamp from the signature comment.
+
=head2 custom_column_info
Hook for adding extra attributes to the
Must be a coderef that returns a hashref with the extra attributes.
-Receives the table name, column name and column_info.
+Receives the L<table object|DBIx::Class::Schema::Loader::Table> (which
+stringifies to the unqualified table name), column name and column_info.
For example:
- custom_column_info => sub {
- my ($table_name, $column_name, $column_info) = @_;
+ custom_column_info => sub {
+ my ($table, $column_name, $column_info) = @_;
- if ($column_name eq 'dog' && $column_info->{default_value} eq 'snoopy') {
- return { is_snoopy => 1 };
- }
- },
+ if ($column_name eq 'dog' && $column_info->{default_value} eq 'snoopy') {
+ return { is_snoopy => 1 };
+ }
+ },
This attribute can also be used to set C<inflate_datetime> on a non-datetime
column so it also receives the L</datetime_timezone> and/or L</datetime_locale>.
=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
Set to true to prepend the L</db_schema> to table names for C<<
__PACKAGE__->table >> calls, and to some other things like Oracle sequences.
+This attribute is automatically set to true for multi db_schema configurations,
+unless explicitly set to false by the user.
+
=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
on tables to primary keys, assuming there is only one largest unique
constraint.
+=head2 allow_extra_m2m_cols
+
+Generate C<many_to_many> relationship bridges even if the link table has
+extra columns other than the foreign keys. The primary key must still
+equal the union of the foreign keys.
+
+
=head2 filter_generated_code
An optional hook that lets you filter the generated text for various classes
filter_generated_code => sub {
my ($type, $class, $text) = @_;
- ...
- return $new_code;
+ ...
+ return $new_code;
+ }
+
+You can also use this option to set L<perltidy markers|perltidy/Skipping
+Selected Sections of Code> in your generated classes. This will leave
+the generated code in the default format, but will allow you to tidy
+your classes at any point in future, without worrying about changing the
+portions of the file which are checksummed, since C<perltidy> will just
+ignore all text between the markers.
+
+ filter_generated_code => sub {
+ return "#<<<\n$_[2]\n#>>>";
}
=head1 METHODS
=cut
-# ensure that a peice of object data is a valid arrayref, creating
+# ensure that a piece of object data is a valid arrayref, creating
# an empty one or encapsulating whatever's there.
sub _ensure_arrayref {
my $self = shift;
}
$self->result_components_map($self->{result_component_map})
}
-
+
if (defined $self->{result_role_map}) {
if (defined $self->result_roles_map) {
croak "Specify only one of result_roles_map or result_role_map";
$self->{class_to_table} = {};
$self->{classes} = {};
$self->{_upgrading_classes} = {};
+ $self->{generated_classes} = [];
$self->{schema_class} ||= ( ref $self->{schema} || $self->{schema} );
$self->{schema} ||= $self->{schema_class};
if $self->{dump_overwrite};
$self->{dynamic} = ! $self->{dump_directory};
+
+ croak "dry_run can only be used with static schema generation"
+ if $self->dynamic and $self->dry_run;
+
$self->{temp_directory} ||= File::Temp::tempdir( 'dbicXXXX',
TMPDIR => 1,
CLEANUP => 1,
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} ||= {};
if (defined $self->db_schema) {
if (ref $self->db_schema eq 'ARRAY') {
- if (@{ $self->db_schema } > 1) {
+ if (@{ $self->db_schema } > 1 && not defined $self->{qualify_objects}) {
$self->{qualify_objects} = 1;
}
elsif (@{ $self->db_schema } == 0) {
}
}
elsif (not ref $self->db_schema) {
- if ($self->db_schema eq '%') {
+ if ($self->db_schema eq '%' && not defined $self->{qualify_objects}) {
$self->{qualify_objects} = 1;
}
if (ref $self->moniker_parts ne 'ARRAY') {
croak 'moniker_parts must be an arrayref';
}
- if ((firstidx { $_ eq 'name' } @{ $self->moniker_parts }) == -1) {
+ if (none { $_ eq 'name' } @{ $self->moniker_parts }) {
croak "moniker_parts option *must* contain 'name'";
}
}
+ if (not defined $self->moniker_part_separator) {
+ $self->moniker_part_separator('');
+ }
+ if (not defined $self->moniker_part_map) {
+ $self->moniker_part_map({}),
+ }
+
return $self;
}
return unless -e $filename;
my ($old_gen, $old_md5, $old_ver, $old_ts, $old_custom) =
- $self->_parse_generated_file($filename);
+ $self->_parse_generated_file($filename);
return unless $old_ver;
foreach my $c (@classes) {
# components default to being under the DBIx::Class namespace unless they
- # are preceeded with a '+'
+ # are preceded with a '+'
if ( $key =~ m/component/ && $c !~ s/^\+// ) {
$c = 'DBIx::Class::' . $c;
}
foreach my $prefix (@INC) {
my $fullpath = File::Spec->catfile($prefix, $file);
+ # abs_path pure-perl fallback warns for non-existent files
+ local $SIG{__WARN__} = sigwarn_silencer(qr/^stat\(.*\Q$file\E\)/);
return $fullpath if -f $fullpath
- # abs_path throws on Windows for nonexistant files
+ # abs_path throws on Windows for nonexistent files
and (try { Cwd::abs_path($fullpath) }) ne
((try { Cwd::abs_path(File::Spec->catfile($self->dump_directory, $file)) }) || '');
}
}
$self->_ext_stmt($class,
- qq|# These lines were loaded from '$real_inc_path' found in \@INC.\n|
- .qq|# They are now part of the custom portion of this file\n|
- .qq|# for you to hand-edit. If you do not either delete\n|
- .qq|# this section or remove that file from \@INC, this section\n|
- .qq|# will be repeated redundantly when you re-create this\n|
- .qq|# file again via Loader! See skip_load_external to disable\n|
- .qq|# this feature.\n|
+ qq|# These lines were loaded from '$real_inc_path' found in \@INC.\n|
+ .qq|# They are now part of the custom portion of this file\n|
+ .qq|# for you to hand-edit. If you do not either delete\n|
+ .qq|# this section or remove that file from \@INC, this section\n|
+ .qq|# will be repeated redundantly when you re-create this\n|
+ .qq|# file again via Loader! See skip_load_external to disable\n|
+ .qq|# this feature.\n|
);
chomp $code;
$self->_ext_stmt($class, $code);
$self->_ext_stmt($class,
- qq|# End of lines loaded from '$real_inc_path' |
+ qq|# End of lines loaded from '$real_inc_path'|
);
}
chomp $code;
$self->_ext_stmt($class, $code);
$self->_ext_stmt($class,
- qq|# End of lines loaded from '$old_real_inc_path' |
+ qq|# End of lines loaded from '$old_real_inc_path'|
);
}
}
sub load {
my $self = shift;
- $self->_load_tables(
- $self->_tables_list({ constraint => $self->constraint, exclude => $self->exclude })
- );
+ $self->_load_tables($self->_tables_list);
}
=head2 rescan
$self->_relbuilder->{schema} = $schema;
my @created;
- my @current = $self->_tables_list({ constraint => $self->constraint, exclude => $self->exclude });
+ my @current = $self->_tables_list;
foreach my $table (@current) {
if(!exists $self->_tables->{$table->sql_name}) {
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);
};
}
sub _load_tables {
my ($self, @tables) = @_;
- # Save the new tables to the tables list
+ # Save the new tables to the tables list and compute monikers
foreach (@tables) {
- $self->_tables->{$_->sql_name} = $_;
+ $self->_tables->{$_->sql_name} = $_;
+ $self->monikers->{$_->sql_name} = $self->_table2moniker($_);
}
- $self->_make_src_class($_) for @tables;
-
- # sanity-check for moniker clashes
+ # check for moniker clashes
my $inverse_moniker_idx;
- foreach my $table (values %{ $self->_tables }) {
- push @{ $inverse_moniker_idx->{$self->monikers->{$table->sql_name}} }, $table;
+ foreach my $imtable (values %{ $self->_tables }) {
+ push @{ $inverse_moniker_idx->{$self->monikers->{$imtable->sql_name}} }, $imtable;
}
my @clashes;
foreach my $moniker (keys %$inverse_moniker_idx) {
- my $tables = $inverse_moniker_idx->{$moniker};
- if (@$tables > 1) {
- push @clashes, sprintf ("tables %s reduced to the same source moniker '%s'",
- join (', ', map $_->sql_name, @$tables),
- $moniker,
- );
- }
+ my $imtables = $inverse_moniker_idx->{$moniker};
+ if (@$imtables > 1) {
+ my $different_databases =
+ $imtables->[0]->can('database') && (uniq map $_->database||'', @$imtables) > 1;
+
+ my $different_schemas =
+ (uniq map $_->schema||'', @$imtables) > 1;
+
+ if ($different_databases || $different_schemas) {
+ my ($use_schema, $use_database) = (1, 0);
+
+ if ($different_databases) {
+ $use_database = 1;
+
+ # If any monikers are in the same database, we have to distinguish by
+ # both schema and database.
+ my %db_counts;
+ $db_counts{$_}++ for map $_->database, @$imtables;
+ $use_schema = any { $_ > 1 } values %db_counts;
+ }
+
+ foreach my $tbl (@$imtables) { delete $self->monikers->{$tbl->sql_name}; }
+
+ my $moniker_parts = [ @{ $self->moniker_parts } ];
+
+ my $have_schema = any { $_ eq 'schema' } @{ $self->moniker_parts };
+ my $have_database = any { $_ eq 'database' } @{ $self->moniker_parts };
+
+ unshift @$moniker_parts, 'schema' if $use_schema && !$have_schema;
+ unshift @$moniker_parts, 'database' if $use_database && !$have_database;
+
+ local $self->{moniker_parts} = $moniker_parts;
+
+ my %new_monikers;
+
+ foreach my $tbl (@$imtables) { $new_monikers{$tbl->sql_name} = $self->_table2moniker($tbl); }
+ foreach my $name (map $_->sql_name, @$imtables) { $self->monikers->{$name} = $new_monikers{$name}; }
+
+ # check if there are still clashes
+ my %by_moniker;
+
+ while (my ($t, $m) = each %new_monikers) {
+ push @{ $by_moniker{$m} }, $t;
+ }
+
+ foreach my $m (grep @{ $by_moniker{$_} } > 1, keys %by_moniker) {
+ push @clashes, sprintf ("tried disambiguating by moniker_parts, but tables %s still reduced to the same source moniker '%s'",
+ join (', ', @{ $by_moniker{$m} }),
+ $m,
+ );
+ }
+ }
+ else {
+ push @clashes, sprintf ("tables %s reduced to the same source moniker '%s'",
+ join (', ', map $_->sql_name, @$imtables),
+ $moniker,
+ );
+ }
+ }
}
if (@clashes) {
- die 'Unable to load schema - chosen moniker/class naming style results in moniker clashes. '
- . '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"
- ;
+ die 'Unable to load schema - chosen moniker/class naming style results in moniker clashes. '
+ . 'Change the naming style, or supply an explicit moniker_map: '
+ . join ('; ', @clashes)
+ . "\n"
+ ;
}
- $self->_setup_src_meta($_) for @tables;
+ foreach my $tbl (@tables) { $self->_make_src_class($tbl); }
+ foreach my $tbl (@tables) { $self->_setup_src_meta($tbl); }
if(!$self->skip_relationships) {
# The relationship loader needs a working schema
local $self->{quiet} = 1;
local $self->{dump_directory} = $self->{temp_directory};
+ local $self->{generated_classes} = [];
+ local $self->{dry_run} = 0;
$self->_reload_classes(\@tables);
$self->_load_relationships(\@tables);
@INC = grep $_ ne $self->dump_directory, @INC;
}
- $self->_load_roles($_) for @tables;
-
- $self->_load_external($_)
- for map { $self->classes->{$_->sql_name} } @tables;
+ foreach my $tbl (@tables) { $self->_load_roles($tbl); }
+ foreach my $tbl (map { $self->classes->{$_->sql_name} } @tables) { $self->_load_external($tbl); }
# Reload without unloading first to preserve any symbols from external
# packages.
$self->_dump_to_dir(map { $self->classes->{$_->sql_name} } @tables);
unshift @INC, $self->dump_directory;
-
+
+ return if $self->dry_run;
+
my @to_register;
my %have_source = map { $_ => $self->schema->source($_) }
$self->schema->sources;
for my $table (@tables) {
my $moniker = $self->monikers->{$table->sql_name};
my $class = $self->classes->{$table->sql_name};
-
+
{
no warnings 'redefine';
local *Class::C3::reinitialize = sub {}; # to speed things up, reinitialized below
}
sub _moose_metaclass {
- return undef unless $INC{'Class/MOP.pm'}; # if CMOP is not loaded the class could not have loaded in the 1st place
+ return undef unless $INC{'Class/MOP.pm'}; # if CMOP is not loaded the class could not have loaded in the 1st place
- my $class = $_[1];
+ my $class = $_[1];
- my $mc = try { Class::MOP::class_of($class) }
- or return undef;
+ my $mc = try { Class::MOP::class_of($class) }
+ or return undef;
- return $mc->isa('Moose::Meta::Class') ? $mc : undef;
+ return $mc->isa('Moose::Meta::Class') ? $mc : undef;
}
# We use this instead of ensure_class_loaded when there are package symbols we
sub _ensure_dump_subdirs {
my ($self, $class) = (@_);
+ return if $self->dry_run;
+
my @name_parts = split(/::/, $class);
pop @name_parts; # we don't care about the very last element,
# which is a filename
. 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|;
my $result_base_class = $self->result_base_class || 'DBIx::Class::Core';
foreach my $src_class (@classes) {
- my $src_text =
+ my $src_text =
qq|use utf8;\n|
. qq|package $src_class;\n\n|
. qq|# Created by DBIx::Class::Schema::Loader\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 }) {
}
}
else {
- $src_text .= qq|use base '$result_base_class';\n|;
+ $src_text .= qq|use base '$result_base_class';\n|;
}
$self->_write_classfile($src_class, $src_text);
sub _sig_comment {
my ($self, $version, $ts) = @_;
return qq|\n\n# Created by DBIx::Class::Schema::Loader|
- . qq| v| . $version
- . q| @ | . $ts
+ . (defined($version) ? q| v| . $version : '')
+ . (defined($ts) ? q| @ | . $ts : '')
. qq|\n# DO NOT MODIFY THIS OR ANYTHING ABOVE! md5sum:|;
}
my $filename = $self->_get_dump_filename($class);
$self->_ensure_dump_subdirs($class);
- if (-f $filename && $self->really_erase_my_files) {
+ if (-f $filename && $self->really_erase_my_files && !$self->dry_run) {
warn "Deleting existing file '$filename' due to "
. "'really_erase_my_files' setting\n" unless $self->quiet;
unlink($filename);
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 = ($self->_parse_generated_file ($old_filename))[4];
- $custom_content = join ("\n", '', $extra_custom, $custom_content)
- if $extra_custom;
-
- unlink $old_filename;
+ unlink $old_filename unless $self->dry_run;
}
}
);
}
else {
- my ($out, $in) = (gensym, gensym);
-
- my $pid = open2($out, $in, $filter)
- or croak "Could not open pipe to $filter: $!";
+ my ($fh, $temp_file) = tempfile();
- print $in $text;
+ binmode $fh, ':encoding(UTF-8)';
+ print $fh $text;
+ close $fh;
- close $in;
+ open my $out, qq{$filter < "$temp_file"|}
+ or croak "Could not open pipe to $filter: $!";
$text = decode('UTF-8', do { local $/; <$out> });
$text =~ s/$CR?$LF/\n/g;
- waitpid $pid, 0;
+ close $out;
my $exit_code = $? >> 8;
+ unlink $temp_file
+ or croak "Could not remove temporary file '$temp_file': $!";
+
if ($exit_code != 0) {
croak "filter '$filter' exited non-zero: $exit_code";
}
}
- if (not $text or not $text =~ /\bpackage\b/) {
- warn("$class skipped due to filter") if $self->debug;
- return;
- }
+ if (not $text or not $text =~ /\bpackage\b/) {
+ warn("$class skipped due to filter") if $self->debug;
+ return;
+ }
}
# Check and see if the dump is in fact different
my $compare_to;
if ($old_md5) {
- $compare_to = $text . $self->_sig_comment($old_ver, $old_ts);
- if (Digest::MD5::md5_base64(encode 'UTF-8', $compare_to) eq $old_md5) {
- return unless $self->_upgrading_from && $is_schema;
- }
+ $compare_to = $text . $self->_sig_comment($old_ver, $old_ts);
+ if (Digest::MD5::md5_base64(encode 'UTF-8', $compare_to) eq $old_md5) {
+ return unless $self->_upgrading_from && $is_schema;
+ }
}
+ push @{$self->generated_classes}, $class;
+
+ return if $self->dry_run;
+
$text .= $self->_sig_comment(
- $self->version_to_dump,
- POSIX::strftime('%Y-%m-%d %H:%M:%S', localtime)
+ $self->omit_version ? undef : $self->version_to_dump,
+ $self->omit_timestamp ? undef : POSIX::strftime('%Y-%m-%d %H:%M:%S', localtime)
);
- open(my $fh, '>:encoding(UTF-8)', $filename)
+ open(my $fh, '>:raw:encoding(UTF-8)', $filename)
or croak "Cannot open '$filename' for writing: $!";
# Write the top half and its MD5 sum
if (not $is_schema) {
return qq|\n__PACKAGE__->meta->make_immutable;|;
}
-
+
return qq|\n__PACKAGE__->meta->make_immutable(inline_constructor => 0);|;
}
my $mark_re =
qr{^(# DO NOT MODIFY THIS OR ANYTHING ABOVE! md5sum:)([A-Za-z0-9/+]{22})\r?\n};
- my ($md5, $ts, $ver, $gen);
+ my ($real_md5, $ts, $ver, $gen);
+ local $_;
while(<$fh>) {
if(/$mark_re/) {
my $pre_md5 = $1;
- $md5 = $2;
+ my $mark_md5 = $2;
# Pull out the version and timestamp from the line above
- ($ver, $ts) = $gen =~ m/^# Created by DBIx::Class::Schema::Loader v(.*?) @ (.*?)\r?\Z/m;
+ ($ver, $ts) = $gen =~ m/^# Created by DBIx::Class::Schema::Loader( v[\d.]+)?( @ [\d-]+ [\d:]+)?\r?\Z/m;
+ $ver =~ s/^ v// if $ver;
+ $ts =~ s/^ @ // if $ts;
$gen .= $pre_md5;
+ $real_md5 = Digest::MD5::md5_base64(encode 'UTF-8', $gen);
croak "Checksum mismatch in '$fn', the auto-generated part of the file has been modified outside of this loader. Aborting.\nIf you want to overwrite these modifications, set the 'overwrite_modifications' loader option.\n"
- if !$self->overwrite_modifications && Digest::MD5::md5_base64(encode 'UTF-8', $gen) ne $md5;
+ if !$self->overwrite_modifications && $real_md5 ne $mark_md5;
last;
}
}
my $custom = do { local $/; <$fh> }
- if $md5;
+ if $real_md5;
$custom ||= '';
$custom =~ s/$CRLF|$LF/\n/g;
close $fh;
- return ($gen, $md5, $ver, $ts, $custom);
+ return ($gen, $real_md5, $ver, $ts, $custom);
}
sub _use {
my $schema = $self->schema;
my $schema_class = $self->schema_class;
- my $table_moniker = $self->_table2moniker($table);
+ my $table_moniker = $self->monikers->{$table->sql_name};
my @result_namespace = ($schema_class);
if ($self->use_namespaces) {
my $result_namespace = $self->result_namespace || 'Result';
}
$self->classes->{$table->sql_name} = $table_class;
- $self->monikers->{$table->sql_name} = $table_moniker;
$self->moniker_to_table->{$table_moniker} = $table;
$self->class_to_table->{$table_class} = $table;
push @roles, @{ $self->result_roles_map->{$table_moniker} }
if exists $self->result_roles_map->{$table_moniker};
- for my $class ($base, @components,
- ($self->use_moose ? 'Moose::Object' : ()), @roles) {
+ for my $class (
+ $base, @components, @roles,
+ ($self->use_moose ? 'Moose::Object' : ()),
+ ) {
$self->ensure_class_loaded($class);
push @methods, @{ Class::Inspector->methods($class) || [] };
my $default_ident = $default_code->( $ident, @extra );
my $new_ident;
if( $map && ref $map eq 'HASH' ) {
- $new_ident = $map->{ $ident };
+ if (my @parts = try { @{ $ident } }) {
+ my $part_map = $map;
+ while (@parts) {
+ my $part = shift @parts;
+ last unless exists $part_map->{ $part };
+ if ( !ref $part_map->{ $part } && !@parts ) {
+ $new_ident = $part_map->{ $part };
+ last;
+ }
+ elsif ( ref $part_map->{ $part } eq 'HASH' ) {
+ $part_map = $part_map->{ $part };
+ }
+ }
+ }
+ if( !$new_ident && !ref $map->{ $ident } ) {
+ $new_ident = $map->{ $ident };
+ }
}
elsif( $map && ref $map eq 'CODE' ) {
- $new_ident = $map->( $ident, $default_ident, @extra );
+ my $cb = sub {
+ my ($cb_map) = @_;
+ croak "reentered map must be a hashref"
+ unless 'HASH' eq ref($cb_map);
+ return $self->_run_user_map($cb_map, $default_code, $ident, @extra);
+ };
+ $new_ident = $map->( $ident, $default_ident, @extra, $cb );
}
$new_ident ||= $default_ident;
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');
- if ((($self->naming->{column_accessors}||'') =~ /(\d+)/ && $1 < 7) || (not $self->preserve_case)) {
+ 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 ($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 {
sub { $self->_default_column_accessor_name( shift ) },
$column_name,
$column_context_info,
- );
+ );
return $accessor;
}
+sub _table_is_view {
+ #my ($self, $table) = @_;
+ return 0;
+}
+
# Set up metadata (cols, pks, etc)
sub _setup_src_meta {
my ($self, $table) = @_;
my $table_class = $self->classes->{$table->sql_name};
my $table_moniker = $self->monikers->{$table->sql_name};
+ $self->_dbic_stmt($table_class, 'table_class', 'DBIx::Class::ResultSource::View')
+ if $self->_table_is_view($table);
+
$self->_dbic_stmt($table_class, 'table', $table->dbic_name);
my $cols = $self->_table_columns($table);
my $context = {
table_class => $table_class,
table_moniker => $table_moniker,
- table_name => $table,
+ table_name => $table, # bugwards compatibility, RT#84050
+ table => $table,
full_table_name => $table->dbic_name,
schema_class => $schema_class,
column_info => $info,
};
+ my $col_obj = DBIx::Class::Schema::Loader::Column->new(
+ table => $table,
+ name => $col,
+ );
- $info->{accessor} = $self->_make_column_accessor_name( $col, $context );
+ $info->{accessor} = $self->_make_column_accessor_name( $col_obj, $context );
}
$self->_resolve_col_accessor_collisions($table, $col_info);
return values %{$self->_tables};
}
-# Make a moniker from a table
-sub _default_table2moniker {
- my ($self, $table) = @_;
+sub _get_naming_v {
+ my ($self, $naming_key) = @_;
- my ($v) = ($self->naming->{monikers}||$CURRENT_V) =~ /^v(\d+)\z/;
+ my $v;
- my @name_parts = map $table->$_, @{ $self->moniker_parts };
+ if (($self->naming->{$naming_key}||'') =~ /^v(\d+)\z/) {
+ $v = $1;
+ }
+ else {
+ ($v) = $CURRENT_V =~ /^v(\d+)\z/;
+ }
- my $name_idx = firstidx { $_ eq 'name' } @{ $self->moniker_parts };
+ 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->_get_naming_v('monikers');
+
+ my @moniker_parts = @{ $self->moniker_parts };
+ my @name_parts = map $table->$_, @moniker_parts;
+
+ my $name_idx = firstidx { $_ eq 'name' } @{ $self->moniker_parts };
+
my @all_parts;
foreach my $i (0 .. $#name_parts) {
my $part = $name_parts[$i];
- if ($i != $name_idx || $v > 7) {
- $part = $to_identifier->($part, '_');
+ my $moniker_part = $self->_run_user_map(
+ $self->moniker_part_map->{$moniker_parts[$i]},
+ sub { '' },
+ $part, $moniker_parts[$i],
+ );
+ if (length $moniker_part) {
+ push @all_parts, $moniker_part;
+ next;
+ }
+
+ 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;
@part_parts = split /\s+/, $inflected;
}
- push @all_parts, map ucfirst, @part_parts;
+ push @all_parts, join '', map ucfirst, @part_parts;
}
- return join '', @all_parts;
+ return join $self->moniker_part_separator, @all_parts;
}
sub _table2moniker {
$self->moniker_map,
sub { $self->_default_table2moniker( shift ) },
$table
- );
+ );
}
sub _load_relationships {
foreach my $src_class (sort keys %$rel_stmts) {
# sort by rel name
- my @src_stmts = map $_->[1],
- sort { $a->[0] cmp $b->[0] }
- map [ $_->{args}[0], $_ ], @{ $rel_stmts->{$src_class} };
+ my @src_stmts = map $_->[2],
+ sort {
+ $a->[0] <=> $b->[0]
+ ||
+ $a->[1] cmp $b->[1]
+ } map [
+ ($_->{method} eq 'many_to_many' ? 1 : 0),
+ $_->{args}[0],
+ $_,
+ ], @{ $rel_stmts->{$src_class} };
foreach my $stmt (@src_stmts) {
$self->_dbic_stmt($src_class,$stmt->{method}, @{$stmt->{args}});
looks_like_number($s) ? $s : qq{'$s'};
" $_: $s"
- } sort keys %$attrs,
+ } sort keys %$attrs,
);
if (my $comment = $self->__column_comment($self->class_to_table->{$class}, $col_counter, $name)) {
$self->_pod( $class, $comment );
}
}
$self->_pod_cut( $class );
- } elsif ( $method =~ /^(belongs_to|has_many|might_have)$/ ) {
+ } elsif ( $method =~ /^(?:belongs_to|has_many|might_have)\z/ ) {
$self->_pod( $class, "=head1 RELATIONS" ) unless $self->{_relations_started} { $class } ;
my ( $accessor, $rel_class ) = @_;
$self->_pod( $class, "=head2 $accessor" );
$self->_pod( $class, "Related object: L<$rel_class>" );
$self->_pod_cut( $class );
$self->{_relations_started} { $class } = 1;
+ } elsif ( $method eq 'many_to_many' ) {
+ $self->_pod( $class, "=head1 RELATIONS" ) unless $self->{_relations_started} { $class } ;
+ my ( $accessor, $rel1, $rel2 ) = @_;
+ $self->_pod( $class, "=head2 $accessor" );
+ $self->_pod( $class, 'Type: many_to_many' );
+ $self->_pod( $class, "Composing rels: L</$rel1> -> $rel2" );
+ $self->_pod_cut( $class );
+ $self->{_relations_started} { $class } = 1;
}
elsif ($method eq 'add_unique_constraint') {
$self->_pod($class, '=head1 UNIQUE CONSTRAINTS')
unless $self->{_uniqs_started}{$class};
-
+
my ($name, $cols) = @_;
$self->_pod($class, "=head2 C<$name>");
$self->_pod($class, '=over 4');
-
+
foreach my $col (@$cols) {
$self->_pod($class, "=item \* L</$col>");
}
elsif ($method eq 'set_primary_key') {
$self->_pod($class, "=head1 PRIMARY KEY");
$self->_pod($class, '=over 4');
-
+
foreach my $col (@_) {
$self->_pod($class, "=item \* L</$col>");
}
return '' unless $self->generate_pod;
- return <<"EOF"
-=head1 BASE CLASS: L<$base_class>
-
-=cut
-
-EOF
+ return "\n=head1 BASE CLASS: L<$base_class>\n\n=cut\n\n";
}
sub _filter_comment {
if (my $code = $self->can('_table_comment')) {
return $self->_filter_comment($self->$code(@_));
}
-
+
return '';
}
contain multiple entries per table for the original and normalized table
names, as above in L</monikers>.
+=head2 generated_classes
+
+Returns an arrayref of classes that were actually generated (i.e. not
+skipped because there were no changes).
+
=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:
+To do so, use something like this in your loader options:
naming => { monikers => 'v4' },
inflect_singular => sub { "$_[0]_rel" },
=head1 SEE ALSO
-L<DBIx::Class::Schema::Loader>
+L<DBIx::Class::Schema::Loader>, L<dbicdump>
-=head1 AUTHOR
+=head1 AUTHORS
-See L<DBIx::Class::Schema::Loader/AUTHOR> and L<DBIx::Class::Schema::Loader/CONTRIBUTORS>.
+See L<DBIx::Class::Schema::Loader/AUTHORS>.
=head1 LICENSE
projects / dbsrgits/DBIx-Class-Schema-Loader.git / blobdiff