use DBIx::Class::Schema::Loader::Optional::Dependencies ();
use Try::Tiny;
use DBIx::Class ();
+use Encode qw/decode encode/;
use namespace::clean;
our $VERSION = '0.07010';
datetime_undef_if_invalid
_result_class_methods
naming_set
+ tables
/);
=head1 NAME
=head2 result_components_map
-A hashref of moniker keys and component values. Unlike C<components>, which
+A hashref of moniker keys and component values. Unlike L</components>, which
loads the given components into every Result class, this option allows you to
load certain components for specified Result classes. For example:
],
}
-You may use this in conjunction with C<components>.
+You may use this in conjunction with L</components>.
=head2 result_roles
=head2 result_roles_map
-A hashref of moniker keys and role values. Unlike C<result_roles>, which
+A hashref of moniker keys and role values. Unlike L</result_roles>, which
applies the given roles to every Result class, this option allows you to apply
certain roles for specified Result classes. For example:
RouteChange => 'YourApp::Role::TripEvent',
}
-You may use this in conjunction with C<components>.
+You may use this in conjunction with L</result_roles>.
=head2 use_namespaces
}
$self->{monikers} = {};
- $self->{classes} = {};
+ $self->{tables} = {};
+ $self->{classes} = {};
$self->{_upgrading_classes} = {};
$self->{schema_class} ||= ( ref $self->{schema} || $self->{schema} );
warn qq/# Loaded external class definition for '$class'\n/
if $self->debug;
- my $code = $self->_rewrite_old_classnames(scalar slurp $real_inc_path);
+ my $code = $self->_rewrite_old_classnames(decode 'UTF-8', scalar slurp $real_inc_path);
if ($self->dynamic) { # load the class too
eval_package_without_redefine_warnings($class, $code);
}
if ($old_real_inc_path) {
- my $code = slurp $old_real_inc_path;
+ my $code = decode 'UTF-8', scalar slurp $old_real_inc_path;
$self->_ext_stmt($class, <<"EOF");
$self->{quiet} = 1;
local $self->{dump_directory} = $self->{temp_directory};
$self->_reload_classes(\@tables);
- $self->_load_relationships($_) for @tables;
- $self->_relbuilder->cleanup;
+ $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;
}
+ $self->_load_roles($_) for @tables;
+
$self->_load_external($_)
for map { $self->classes->{$_} } @tables;
eval_package_without_redefine_warnings ($class, "require $class");
}
catch {
- my $source = slurp $self->_get_dump_filename($class);
+ my $source = decode 'UTF-8', scalar slurp $self->_get_dump_filename($class);
die "Failed to reload class $class: $_.\n\nCLASS SOURCE:\n\n$source";
};
}
else {
$src_text .= qq|use base '$result_base_class';\n\n|;
}
+
+ $self->_base_class_pod($src_class, $result_base_class)
+ unless $result_base_class eq 'DBIx::Class::Core';
+
$self->_write_classfile($src_class, $src_text);
}
my $compare_to;
if ($old_md5) {
$compare_to = $text . $self->_sig_comment($old_ver, $old_ts);
- if (Digest::MD5::md5_base64($compare_to) eq $old_md5) {
+ if (Digest::MD5::md5_base64(encode 'UTF-8', $compare_to) eq $old_md5) {
return unless $self->_upgrading_from && $is_schema;
}
}
POSIX::strftime('%Y-%m-%d %H:%M:%S', localtime)
);
- open(my $fh, '>', $filename)
+ open(my $fh, '>:encoding(UTF-8)', $filename)
or croak "Cannot open '$filename' for writing: $!";
# Write the top half and its MD5 sum
- print $fh $text . Digest::MD5::md5_base64($text) . "\n";
+ print $fh $text . Digest::MD5::md5_base64(encode 'UTF-8', $text) . "\n";
# Write out anything loaded via external partial class file in @INC
print $fh qq|$_\n|
return unless -f $fn;
- open(my $fh, '<', $fn)
+ open(my $fh, '<:encoding(UTF-8)', $fn)
or croak "Cannot open '$fn' for reading: $!";
my $mark_re =
$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"
- if !$self->overwrite_modifications && Digest::MD5::md5_base64($gen) ne $md5;
+ if !$self->overwrite_modifications && Digest::MD5::md5_base64(encode 'UTF-8', $gen) ne $md5;
last;
}
$self->classes->{$table} = $table_class;
$self->monikers->{$table} = $table_moniker;
+ $self->tables->{$table_moniker} = $table;
+
+ $self->_pod_class_list($table_class, 'ADDITIONAL CLASSES USED', @{$self->additional_classes});
$self->_use ($table_class, @{$self->additional_classes});
+
+ $self->_pod_class_list($table_class, 'LEFT BASE CLASSES', @{$self->left_base_classes});
+
$self->_inject($table_class, @{$self->left_base_classes});
my @components = @{ $self->components || [] };
push @components, @{ $self->result_components_map->{$table_moniker} }
if exists $self->result_components_map->{$table_moniker};
- $self->_dbic_stmt($table_class, 'load_components', @components) if @components;
+ my @fq_components = @components;
+ foreach my $component (@fq_components) {
+ if ($component !~ s/^\+//) {
+ $component = "DBIx::Class::$component";
+ }
+ }
- $self->_inject($table_class, @{$self->additional_base_classes});
+ $self->_pod_class_list($table_class, 'COMPONENTS LOADED', @fq_components);
- my @roles = @{ $self->result_roles || [] };
- push @roles, @{ $self->result_roles_map->{$table_moniker} }
- if exists $self->result_roles_map->{$table_moniker};
+ $self->_dbic_stmt($table_class, 'load_components', @components) if @components;
- $self->_with($table_class, @roles) if @roles;
+ $self->_pod_class_list($table_class, 'ADDITIONAL BASE CLASSES', @{$self->additional_base_classes});
+
+ $self->_inject($table_class, @{$self->additional_base_classes});
}
sub _is_result_class_method {
my ($self, $name, $table_name) = @_;
- my $table_moniker = $table_name ? $self->_table2moniker($table_name) : '';
+ my $table_moniker = $table_name ? $self->monikers->{$table_name} : '';
$self->_result_class_methods({})
if not defined $self->_result_class_methods;
return $accessor;
}
+sub _quote {
+ my ($self, $identifier) = @_;
+
+ my $qt = $self->schema->storage->sql_maker->quote_char;
+
+ if (ref $qt) {
+ return $qt->[0] . $identifier . $qt->[1];
+ }
+
+ return "${qt}${identifier}${qt}";
+}
+
# Set up metadata (cols, pks, etc)
sub _setup_src_meta {
my ($self, $table) = @_;
my $schema = $self->schema;
my $schema_class = $self->schema_class;
- my $table_class = $self->classes->{$table};
+ my $table_class = $self->classes->{$table};
my $table_moniker = $self->monikers->{$table};
my $table_name = $table;
- my $name_sep = $self->schema->storage->sql_maker->name_sep;
+
+ my $sql_maker = $self->schema->storage->sql_maker;
+ my $name_sep = $sql_maker->name_sep;
if ($name_sep && $table_name =~ /\Q$name_sep\E/) {
- $table_name = \ $self->_quote_table_name($table_name);
+ $table_name = \ $self->_quote($table_name);
}
- my $full_table_name = ($self->qualify_objects ? ($self->db_schema . '.') : '') . (ref $table_name ? $$table_name : $table_name);
+ my $full_table_name = ($self->qualify_objects ?
+ ($self->_quote($self->db_schema) . '.') : '')
+ . (ref $table_name ? $$table_name : $table_name);
# be careful to not create refs Data::Dump can "optimize"
- $full_table_name = \do {"".$full_table_name} if ref $table_name;
+ $full_table_name = \do {"".$full_table_name} if ref $table_name;
$self->_dbic_stmt($table_class, 'table', $full_table_name);
$info->{accessor} = $self->_make_column_accessor_name( $col, $context );
}
- $self->_resolve_col_accessor_collisions($full_table_name, $col_info);
+ $self->_resolve_col_accessor_collisions($table, $col_info);
# prune any redundant accessor names
while (my ($col, $info) = each %$col_info) {
}
sub _load_relationships {
- my ($self, $table) = @_;
+ my ($self, $tables) = @_;
+
+ my @tables;
+
+ foreach my $table (@$tables) {
+ my $tbl_fk_info = $self->_table_fk_info($table);
+ foreach my $fkdef (@$tbl_fk_info) {
+ $fkdef->{remote_source} =
+ $self->monikers->{delete $fkdef->{remote_table}};
+ }
+ my $tbl_uniq_info = $self->_table_uniq_info($table);
+
+ my $local_moniker = $self->monikers->{$table};
- my $tbl_fk_info = $self->_table_fk_info($table);
- foreach my $fkdef (@$tbl_fk_info) {
- $fkdef->{remote_source} =
- $self->monikers->{delete $fkdef->{remote_table}};
+ push @tables, [ $local_moniker, $tbl_fk_info, $tbl_uniq_info ];
}
- my $tbl_uniq_info = $self->_table_uniq_info($table);
- my $local_moniker = $self->monikers->{$table};
- my $rel_stmts = $self->_relbuilder->generate_code($local_moniker, $tbl_fk_info, $tbl_uniq_info);
+ my $rel_stmts = $self->_relbuilder->generate_code(\@tables);
foreach my $src_class (sort keys %$rel_stmts) {
my $src_stmts = $rel_stmts->{$src_class};
}
}
+sub _load_roles {
+ my ($self, $table) = @_;
+
+ my $table_moniker = $self->monikers->{$table};
+ my $table_class = $self->classes->{$table};
+
+ my @roles = @{ $self->result_roles || [] };
+ push @roles, @{ $self->result_roles_map->{$table_moniker} }
+ if exists $self->result_roles_map->{$table_moniker};
+
+ if (@roles) {
+ $self->_pod_class_list($table_class, 'L<Moose> ROLES APPLIED', @roles);
+
+ $self->_with($table_class, @roles);
+ }
+}
+
# Overload these in driver class:
# Returns an arrayref of column names
}
}
+sub _pod_class_list {
+ my ($self, $class, $title, @classes) = @_;
+
+ return unless @classes && $self->generate_pod;
+
+ $self->_pod($class, "=head1 $title");
+ $self->_pod($class, '=over 4');
+
+ foreach my $link (@classes) {
+ $self->_pod($class, "=item * L<$link>");
+ }
+
+ $self->_pod($class, '=back');
+ $self->_pod_cut($class);
+}
+
+sub _base_class_pod {
+ my ($self, $class, $base_class) = @_;
+
+ return unless $self->generate_pod;
+
+ $self->_pod($class, "=head1 BASE CLASS: L<$base_class>");
+ $self->_pod_cut($class);
+}
+
sub _filter_comment {
my ($self, $txt) = @_;
push(@{$self->{_ext_storage}->{$class}}, $stmt);
}
-sub _quote_table_name {
- my ($self, $table) = @_;
-
- my $qt = $self->schema->storage->sql_maker->quote_char;
-
- return $table unless $qt;
-
- if (ref $qt) {
- return $qt->[0] . $table . $qt->[1];
- }
-
- return $qt . $table . $qt;
-}
-
sub _custom_column_info {
my ( $self, $table_name, $column_name, $column_info ) = @_;