result_roles_map
datetime_undef_if_invalid
_result_class_methods
+ naming_set
/);
=head1 NAME
$self->version_to_dump($DBIx::Class::Schema::Loader::VERSION);
$self->schema_version_to_dump($DBIx::Class::Schema::Loader::VERSION);
+ if (not defined $self->naming) {
+ $self->naming_set(0);
+ }
+ else {
+ $self->naming_set(1);
+ }
+
if ((not ref $self->naming) && defined $self->naming) {
my $naming_ver = $self->naming;
$self->{naming} = {
# just in case, though no one is likely to dump a dynamic schema
$self->schema_version_to_dump('0.04006');
- if (not %{ $self->naming }) {
+ if (not $self->naming_set) {
warn <<EOF unless $ENV{SCHEMA_LOADER_BACKCOMPAT};
Dynamic schema detected, will run in 0.04006 mode.
$self->_upgrading_from('v4');
}
- $self->naming->{relationships} ||= 'v4';
- $self->naming->{monikers} ||= 'v4';
-
- if ((not defined $self->use_namespaces)
- && $self->naming->{monikers} ne 'v4') {
+ if ((not defined $self->use_namespaces) && ($self->naming_set)) {
$self->use_namespaces(1);
}
+ $self->naming->{relationships} ||= 'v4';
+ $self->naming->{monikers} ||= 'v4';
+
if ($self->use_namespaces) {
$self->_upgrading_from_load_classes(1);
}
@INC = grep $_ ne $self->dump_directory, @INC;
}
+ $self->_load_roles($_) for @tables;
+
$self->_load_external($_)
for map { $self->classes->{$_} } @tables;
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);
}
$self->classes->{$table} = $table_class;
$self->monikers->{$table} = $table_moniker;
+ $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->_pod_class_list($table_class, 'ADDITIONAL BASE CLASSES', @{$self->additional_base_classes});
- $self->_with($table_class, @roles) if @roles;
+ $self->_inject($table_class, @{$self->additional_base_classes});
}
sub _is_result_class_method {
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;
}
}
+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) = @_;