use Class::Unload;
use Class::Inspector ();
use Scalar::Util 'looks_like_number';
-use File::Slurp 'read_file';
-use DBIx::Class::Schema::Loader::Utils qw/split_name dumper_squashed eval_package_without_redefine_warnings class_path/;
+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::Optional::Dependencies ();
use Try::Tiny;
use DBIx::Class ();
additional_base_classes
left_base_classes
components
+ schema_components
skip_relationships
skip_load_external
moniker_map
loader_class
qualify_objects
tables
+ table_comments_table
+ column_comments_table
class_to_table
uniq_to_primary
+ quiet
/);
preserve_case
col_collision_map
rel_collision_map
+ rel_name_map
real_dump_directory
result_components_map
result_roles_map
naming_set
/);
+my $CURRENT_V = 'v7';
+
+my @CLASS_ARGS = qw(
+ schema_components schema_base_class result_base_class
+ additional_base_classes left_base_classes additional_classes components
+ result_roles
+);
+
+my $LF = "\x0a";
+my $CRLF = "\x0d\x0a";
+
=head1 NAME
DBIx::Class::Schema::Loader::Base - Base DBIx::Class::Schema::Loader Implementation.
__PACKAGE__->naming('v7');
+=head2 quiet
+
+If true, will not print the usual C<Dumping manual schema ... Schema dump
+completed.> messages. Does not affect warnings (except for warnings related to
+L</really_erase_my_files>.)
+
=head2 generate_pod
By default POD will be generated for columns and relationships, using database
metadata for the text if available and supported.
-Reading database metadata (e.g. C<COMMENT ON TABLE some_table ...>) is only
-supported for Postgres right now.
+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.
+
+(If you wish you can change the name of these tables with the parameters
+L</table_comments_table> and L</column_comments_table>.)
+
+As a fallback you can use built-in commenting mechanisms. Currently this
+is only supported for PostgreSQL and MySQL. To create comments in
+PostgreSQL you add statements of the form C<COMMENT ON TABLE some_table ...>.
+To create comments in MySQL you add C<COMMENT '...'> to the end of the
+column or table definition. Note that MySQL restricts the length of comments,
+and also does not handle complex Unicode characters properly.
Set this to C<0> to turn off all POD generation.
The default is C<60>
+=head2 table_comments_table
+
+The table to look for comments about tables in. By default C<table_comments>.
+See L</generate_pod> for details.
+
+=head2 column_comments_table
+
+The table to look for comments about columns in. By default C<column_comments>.
+See L</generate_pod> for details.
+
=head2 relationship_attrs
Hashref of attributes to pass to each generated relationship, listed
column_info => hashref of column info (data_type, is_nullable, etc),
}
+=head2 rel_name_map
+
+Similar in idea to moniker_map, but different in the details. It can be
+a hashref or a code ref.
+
+If it is a hashref, keys can be either the default relationship name, or the
+moniker. The keys that are the default relationship name should map to the
+name you want to change the relationship to. Keys that are monikers should map
+to hashes mapping relationship names to their translation. You can do both at
+once, and the more specific moniker version will be picked up first. So, for
+instance, you could have
+
+ {
+ bar => "baz",
+ Foo => {
+ bar => "blat",
+ },
+ }
+
+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:
+
+ {
+ name => default relationship name,
+ type => the relationship type eg: C<has_many>,
+ local_class => name of the DBIC class we are building,
+ local_moniker => moniker of the DBIC class we are building,
+ local_columns => columns in this table in the relationship,
+ 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,
+ }
+
+DBICSL will try to use the value returned as the relationship name.
+
=head2 inflect_plural
Just like L</moniker_map> above (can be hash/code-ref, falls back to default
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 table
+List of additional components to be loaded into all of your Result
classes. A good example would be
L<InflateColumn::DateTime|DBIx::Class::InflateColumn::DateTime>
=cut
-my $CURRENT_V = 'v7';
-
-my @CLASS_ARGS = qw(
- schema_base_class result_base_class additional_base_classes
- left_base_classes additional_classes components result_roles
-);
-
# ensure that a peice of object data is a valid arrayref, creating
# an empty one or encapsulating whatever's there.
sub _ensure_arrayref {
}
}
- $self->result_components_map($self->{result_component_map})
- if defined $self->{result_component_map};
-
- $self->result_roles_map($self->{result_role_map})
- if defined $self->{result_role_map};
+ if (defined $self->{result_component_map}) {
+ if (defined $self->result_components_map) {
+ croak "Specify only one of result_components_map or result_component_map";
+ }
+ $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->result_roles_map($self->{result_role_map})
+ }
croak "the result_roles and result_roles_map options may only be used in conjunction with use_moose=1"
if ((not defined $self->use_moose) || (not $self->use_moose))
&& ((defined $self->result_roles) || (defined $self->result_roles_map));
- $self->_ensure_arrayref(qw/additional_classes
+ $self->_ensure_arrayref(qw/schema_components
+ additional_classes
additional_base_classes
left_base_classes
components
$self->{schema_class} ||= ( ref $self->{schema} || $self->{schema} );
$self->{schema} ||= $self->{schema_class};
+ $self->{table_comments_table} ||= 'table_comments';
+ $self->{column_comments_table} ||= 'column_comments';
croak "dump_overwrite is deprecated. Please read the"
. " DBIx::Class::Schema::Loader::Base documentation"
}
}
+ if (my $rel_collision_map = $self->rel_collision_map) {
+ if (my $reftype = ref $rel_collision_map) {
+ if ($reftype ne 'HASH') {
+ croak "Invalid type $reftype for option 'rel_collision_map'";
+ }
+ }
+ else {
+ $self->rel_collision_map({ '(.*)' => $rel_collision_map });
+ }
+ }
+
+ if (defined(my $rel_name_map = $self->rel_name_map)) {
+ my $reftype = ref $rel_name_map;
+ if ($reftype ne 'HASH' && $reftype ne 'CODE') {
+ croak "Invalid type $reftype for option 'rel_name_map', must be HASH or CODE";
+ }
+ }
+
$self;
}
warn qq/# Loaded external class definition for '$class'\n/
if $self->debug;
- my $code = $self->_rewrite_old_classnames(scalar read_file($real_inc_path, binmode => ':encoding(UTF-8)'));
+ my $code = $self->_rewrite_old_classnames(slurp_file $real_inc_path);
if ($self->dynamic) { # load the class too
eval_package_without_redefine_warnings($class, $code);
}
if ($old_real_inc_path) {
- my $code = read_file($old_real_inc_path, binmode => ':encoding(UTF-8)');
+ my $code = slurp_file $old_real_inc_path;
$self->_ext_stmt($class, <<"EOF");
if(!$self->skip_relationships) {
# The relationship loader needs a working schema
- $self->{quiet} = 1;
+ local $self->{quiet} = 1;
local $self->{dump_directory} = $self->{temp_directory};
$self->_reload_classes(\@tables);
$self->_load_relationships(\@tables);
- $self->{quiet} = 0;
# Remove that temp dir from INC so it doesn't get reloaded
@INC = grep $_ ne $self->dump_directory, @INC;
eval_package_without_redefine_warnings ($class, "require $class");
}
catch {
- my $source = read_file($self->_get_dump_filename($class), binmode => ':encoding(UTF-8)');
+ my $source = slurp_file $self->_get_dump_filename($class);
die "Failed to reload class $class: $_.\n\nCLASS SOURCE:\n\n$source";
};
}
my $target_dir = $self->dump_directory;
warn "Dumping manual schema for $schema_class to directory $target_dir ...\n"
- unless $self->{dynamic} or $self->{quiet};
+ unless $self->dynamic or $self->quiet;
my $schema_text =
qq|package $schema_class;\n\n|
$schema_text .= qq|use strict;\nuse warnings;\n\nuse base '$schema_base_class';\n\n|;
}
+ my @schema_components = @{ $self->schema_components || [] };
+
+ if (@schema_components) {
+ my $schema_components = dump @schema_components;
+ $schema_components = "($schema_components)" if @schema_components == 1;
+
+ $schema_text .= "__PACKAGE__->load_components${schema_components};\n\n";
+ }
+
if ($self->use_namespaces) {
$schema_text .= qq|__PACKAGE__->load_namespaces|;
my $namespace_options;
}
}
- warn "Schema dump completed.\n" unless $self->{dynamic} or $self->{quiet};
+ warn "Schema dump completed.\n" unless $self->dynamic or $self->quiet;
}
if (-f $filename && $self->really_erase_my_files) {
warn "Deleting existing file '$filename' due to "
- . "'really_erase_my_files' setting\n" unless $self->{quiet};
+ . "'really_erase_my_files' setting\n" unless $self->quiet;
unlink($filename);
}
or croak "Cannot open '$fn' for reading: $!";
my $mark_re =
- qr{^(# DO NOT MODIFY THIS OR ANYTHING ABOVE! md5sum:)([A-Za-z0-9/+]{22})\n};
+ qr{^(# DO NOT MODIFY THIS OR ANYTHING ABOVE! md5sum:)([A-Za-z0-9/+]{22})\r?\n};
my ($md5, $ts, $ver, $gen);
while(<$fh>) {
$md5 = $2;
# Pull out the version and timestamp from the line above
- ($ver, $ts) = $gen =~ m/^# Created by DBIx::Class::Schema::Loader v(.*?) @ (.*?)\Z/m;
+ ($ver, $ts) = $gen =~ m/^# Created by DBIx::Class::Schema::Loader v(.*?) @ (.*?)\r?\Z/m;
$gen .= $pre_md5;
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"
my $custom = do { local $/; <$fh> }
if $md5;
- close ($fh);
+ $custom ||= '';
+ $custom =~ s/$CRLF|$LF/\n/g;
+
+ close $fh;
return ($gen, $md5, $ver, $ts, $custom);
}
}
}
-# use the same logic to run moniker_map, col_accessor_map, and
-# relationship_name_map
+# use the same logic to run moniker_map, col_accessor_map
sub _run_user_map {
my ( $self, $map, $default_code, $ident, @extra ) = @_;
my $rel_stmts = $self->_relbuilder->generate_code(\@tables);
foreach my $src_class (sort keys %$rel_stmts) {
- my $src_stmts = $rel_stmts->{$src_class};
- foreach my $stmt (@$src_stmts) {
- $self->_dbic_stmt($src_class,$stmt->{method},@{$stmt->{args}});
+ # sort by rel name
+ my @src_stmts = map $_->[1],
+ sort { $a->[0] cmp $b->[0] }
+ map [ $_->{args}[0], $_ ], @{ $rel_stmts->{$src_class} };
+
+ foreach my $stmt (@src_stmts) {
+ $self->_dbic_stmt($src_class,$stmt->{method}, @{$stmt->{args}});
}
}
}