use strict;
use warnings;
-use base qw/Class::Accessor::Fast/;
+use base qw/Class::Accessor::Fast Class::C3::Componentised/;
use Class::C3;
use Carp::Clan qw/^DBIx::Class/;
-use UNIVERSAL::require;
use DBIx::Class::Schema::Loader::RelBuilder;
use Data::Dump qw/ dump /;
use POSIX qw//;
use Class::Unload;
require DBIx::Class;
-our $VERSION = '0.04999_05';
+our $VERSION = '0.04999_08';
__PACKAGE__->mk_ro_accessors(qw/
schema
result_namespace
resultset_namespace
default_resultset_class
+ schema_base_class
+ result_base_class
db_schema
_tables
As L</inflect_plural> above, but for singularizing relationship names.
Default behavior is to utilize L<Lingua::EN::Inflect::Number/to_S>.
+=head2 schema_base_class
+
+Base class for your schema classes. Defaults to 'DBIx::Class::Schema'.
+
+=head2 result_base_class
+
+Base class for your table classes (aka result classes). Defaults to 'DBIx::Class'.
+
=head2 additional_base_classes
List of additional base classes all of your table classes will use.
);
$self->{relbuilder} = DBIx::Class::Schema::Loader::RelBuilder->new(
- $self->schema_class, $self->inflect_plural, $self->inflect_singular
+ $self->schema, $self->inflect_plural, $self->inflect_singular
) if !$self->{skip_relationships};
$self;
my ($self, $schema) = @_;
$self->{schema} = $schema;
+ $self->{relbuilder}{schema} = $schema;
my @created;
my @current = $self->_tables_list;
my ($self, @tables) = @_;
$self->_dump_to_dir(map { $self->classes->{$_} } @tables);
+
+ unshift @INC, $self->dump_directory;
+ my @to_register;
+ my %have_source = map { $_ => $self->schema->source($_) }
+ $self->schema->sources;
+
for my $table (@tables) {
my $moniker = $self->monikers->{$table};
my $class = $self->classes->{$table};
local *Class::C3::reinitialize = sub {};
use warnings;
- if ( Class::Unload->unload( $class ) ) {
- my $resultset_class = ref $self->schema->resultset($moniker);
- Class::Unload->unload( $resultset_class )
- if $resultset_class ne 'DBIx::Class::ResultSet';
+ Class::Unload->unload($class);
+ my ($source, $resultset_class);
+ if (
+ ($source = $have_source{$moniker})
+ && ($resultset_class = $source->resultset_class)
+ && ($resultset_class ne 'DBIx::Class::ResultSet')
+ ) {
+ my $has_file = Class::Inspector->loaded_filename($resultset_class);
+ Class::Unload->unload($resultset_class);
+ $self->ensure_class_loaded($resultset_class) if $has_file;
}
- $class->require or die "Can't load $class: $@";
+ $self->ensure_class_loaded($class);
}
+ push @to_register, [$moniker, $class];
+ }
- $self->schema_class->register_class($moniker, $class);
- $self->schema->register_class($moniker, $class)
- if $self->schema ne $self->schema_class;
+ Class::C3->reinitialize;
+ for (@to_register) {
+ $self->schema->register_class(@$_);
}
}
sub _dump_to_dir {
my ($self, @classes) = @_;
- my $target_dir = $self->dump_directory;
-
my $schema_class = $self->schema_class;
+ my $schema_base_class = $self->schema_base_class || 'DBIx::Class::Schema';
+ my $target_dir = $self->dump_directory;
warn "Dumping manual schema for $schema_class to directory $target_dir ...\n"
unless $self->{dynamic} or $self->{quiet};
my $schema_text =
qq|package $schema_class;\n\n|
. qq|use strict;\nuse warnings;\n\n|
- . qq|use base 'DBIx::Class::Schema';\n\n|;
+ . qq|use base '$schema_base_class';\n\n|;
-
if ($self->use_namespaces) {
$schema_text .= qq|__PACKAGE__->load_namespaces|;
my $namespace_options;
}
else {
$schema_text .= qq|__PACKAGE__->load_classes;\n|;
-
}
$self->_write_classfile($schema_class, $schema_text);
+ my $result_base_class = $self->result_base_class || 'DBIx::Class';
+
foreach my $src_class (@classes) {
my $src_text =
qq|package $src_class;\n\n|
. qq|use strict;\nuse warnings;\n\n|
- . qq|use base 'DBIx::Class';\n\n|;
+ . qq|use base '$result_base_class';\n\n|;
$self->_write_classfile($src_class, $src_text);
}
warn "Schema dump completed.\n" unless $self->{dynamic} or $self->{quiet};
- unshift @INC, $target_dir;
}
sub _write_classfile {
}
my $custom_content = $self->_get_custom_content($class, $filename);
-
$custom_content ||= qq|\n\n# You can replace this text with custom|
. qq| content, and it will be preserved on regeneration|
. qq|\n1;\n|;
print $fh qq|$_\n|
for @{$self->{_ext_storage}->{$class} || []};
+ # Write out any custom content the user has added
print $fh $custom_content;
close($fh)
- or croak "Cannot close '$filename': $!";
+ or croak "Error closing '$filename': $!";
}
sub _get_custom_content {
my $table_class = $self->classes->{$table};
my $table_moniker = $self->monikers->{$table};
- $self->_dbic_stmt($table_class,'table',$table);
+ my $table_name = $table;
+ my $name_sep = $self->schema->storage->sql_maker->name_sep;
+
+ if ($name_sep && $table_name =~ /\Q$name_sep\E/) {
+ $table_name = \ $self->_quote_table_name($table_name);
+ }
+
+ $self->_dbic_stmt($table_class,'table',$table_name);
my $cols = $self->_table_columns($table);
my $col_info;
$self->_dbic_stmt($table_class,'add_columns',@$cols);
}
else {
- my %col_info_lc = map { lc($_), $col_info->{$_} } keys %$col_info;
+ if ($self->_is_case_sensitive) {
+ for my $col (keys %$col_info) {
+ $col_info->{$col}{accessor} = lc $col
+ if $col ne lc($col);
+ }
+ } else {
+ $col_info = { map { lc($_), $col_info->{$_} } keys %$col_info };
+ }
+
my $fks = $self->_table_fk_info($table);
+
for my $fkdef (@$fks) {
for my $col (@{ $fkdef->{local_columns} }) {
- $col_info_lc{$col}->{is_foreign_key} = 1;
+ $col_info->{$col}{is_foreign_key} = 1;
}
}
$self->_dbic_stmt(
$table_class,
'add_columns',
- map { $_, ($col_info_lc{$_}||{}) } @$cols
+ map { $_, ($col_info->{$_}||{}) } @$cols
);
}
+ my %uniq_tag; # used to eliminate duplicate uniqs
+
my $pks = $self->_table_pk_info($table) || [];
@$pks ? $self->_dbic_stmt($table_class,'set_primary_key',@$pks)
: carp("$table has no primary key");
+ $uniq_tag{ join("\0", @$pks) }++ if @$pks; # pk is a uniq
my $uniqs = $self->_table_uniq_info($table) || [];
- $self->_dbic_stmt($table_class,'add_unique_constraint',@$_) for (@$uniqs);
+ for (@$uniqs) {
+ my ($name, $cols) = @$_;
+ next if $uniq_tag{ join("\0", @$cols) }++; # skip duplicates
+ $self->_dbic_stmt($table_class,'add_unique_constraint', $name, $cols);
+ }
+
}
=head2 tables
}
# Make a moniker from a table
+sub _default_table2moniker {
+ my ($self, $table) = @_;
+
+ return join '', map ucfirst, split /[\W_]+/,
+ Lingua::EN::Inflect::Number::to_S(lc $table);
+}
+
sub _table2moniker {
my ( $self, $table ) = @_;
$moniker = $self->moniker_map->($table);
}
- $moniker ||= join '', map ucfirst, split /[\W_]+/,
- Lingua::EN::Inflect::Number::to_S(lc $table);
+ $moniker ||= $self->_default_table2moniker($table);
return $moniker;
}
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 _is_case_sensitive { 0 }
+
=head2 monikers
Returns a hashref of loaded table to moniker mappings. There will
projects / dbsrgits/DBIx-Class-Schema-Loader.git / blobdiff