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 File::Spec qw//;
use Cwd qw//;
use Digest::MD5 qw//;
+use Lingua::EN::Inflect::Number qw//;
+use File::Temp qw//;
+use Class::Unload;
require DBIx::Class;
-our $VERSION = '0.03999_01';
+our $VERSION = '0.04999_10';
__PACKAGE__->mk_ro_accessors(qw/
schema
moniker_map
inflect_singular
inflect_plural
+ naming
debug
dump_directory
dump_overwrite
+ really_erase_my_files
+ use_namespaces
+ result_namespace
+ resultset_namespace
+ default_resultset_class
+ schema_base_class
+ result_base_class
db_schema
_tables
=head1 CONSTRUCTOR OPTIONS
These constructor options are the base options for
-L<DBIx::Class::Schema::Loader/loader_opts>. Available constructor options are:
+L<DBIx::Class::Schema::Loader/loader_options>. Available constructor options are:
=head2 skip_relationships
Skip setting up relationships. The default is to attempt the loading
of relationships.
+=head2 naming
+
+Static schemas (ones dumped to disk) will, by default, use the new-style 0.05XXX
+relationship names and singularized Results, unless you're overwriting an
+existing dump made by a 0.04XXX version of L<DBIx::Class::Schema::Loader>, in
+which case the backward compatible RelBuilder will be activated, and
+singularization will be turned off.
+
+Specifying
+
+ naming => 'v5'
+
+will disable the backward-compatible RelBuilder and use
+the new-style relationship names along with singularized Results, even when
+overwriting a dump made with an earlier version.
+
+The option also takes a hashref:
+
+ naming => { relationships => 'v5', results => 'v4' }
+
+The values can be:
+
+=over 4
+
+=item current
+
+Latest default style, whatever that happens to be.
+
+=item v5
+
+Version 0.05XXX style.
+
+=item v4
+
+Version 0.04XXX style.
+
+=back
+
+Dynamic schemas will always default to the 0.04XXX relationship names and won't
+singularize Results for backward compatibility, to activate the new RelBuilder
+and singularization put this in your C<Schema.pm> file:
+
+ __PACKAGE__->naming('current');
+
+Or if you prefer to use 0.05XXX features but insure that nothing breaks in the
+next major version upgrade:
+
+ __PACKAGE__->naming('v5');
+
=head2 debug
If set to true, each constructive L<DBIx::Class> statement the loader
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.
C<ResultSetManager> will be automatically added to the above
C<components> list if this option is set.
+=head2 use_namespaces
+
+Generate result class names suitable for
+L<DBIx::Class::Schema/load_namespaces> and call that instead of
+L<DBIx::Class::Schema/load_classes>. When using this option you can also
+specify any of the options for C<load_namespaces> (i.e. C<result_namespace>,
+C<resultset_namespace>, C<default_resultset_class>), and they will be added
+to the call (and the generated result class names adjusted appropriately).
+
=head2 dump_directory
This option is designed to be a tool to help you transition from this
=head2 dump_overwrite
+Deprecated. See L</really_erase_my_files> below, which does *not* mean
+the same thing as the old C<dump_overwrite> setting from previous releases.
+
+=head2 really_erase_my_files
+
Default false. If true, Loader will unconditionally delete any existing
files before creating the new ones from scratch when dumping a schema to disk.
C<# DO NOT MODIFY THIS OR ANYTHING ABOVE!>
leaving any customizations you placed after that as they were.
-When C<dump_overwrite> is not set, if the output file already exists,
+When C<really_erase_my_files> is not set, if the output file already exists,
but the aforementioned final stanza is not found, or the checksum
contained there does not match the generated contents, Loader will
croak and not touch the file.
+You should really be using version control on your schema classes (and all
+of the rest of your code for that matter). Don't blame me if a bug in this
+code wipes something out when it shouldn't have, you've been warned.
+
=head1 METHODS
None of these methods are intended for direct invocation by regular
bless $self => $class;
- $self->{db_schema} ||= '';
$self->_ensure_arrayref(qw/additional_classes
additional_base_classes
left_base_classes
$self->{schema_class} ||= ( ref $self->{schema} || $self->{schema} );
$self->{schema} ||= $self->{schema_class};
+ croak "dump_overwrite is deprecated. Please read the"
+ . " DBIx::Class::Schema::Loader::Base documentation"
+ if $self->{dump_overwrite};
+
+ $self->{dynamic} = ! $self->{dump_directory};
+ $self->{temp_directory} ||= File::Temp::tempdir( 'dbicXXXX',
+ TMPDIR => 1,
+ CLEANUP => 1,
+ );
+
+ $self->{dump_directory} ||= $self->{temp_directory};
+
+ $self->_check_back_compat;
+
$self;
}
+sub _check_back_compat {
+ my ($self) = @_;
+
+ my $filename = $self->_get_dump_filename($self->schema_class);
+ return unless -e $filename;
+
+ open(my $fh, '<', $filename)
+ or croak "Cannot open '$filename' for reading: $!";
+
+ while (<$fh>) {
+ if (/^# Created by DBIx::Class::Schema::Loader (v\d+)\.(\d+)/) {
+ my $ver = "${1}_${2}";
+ while (1) {
+ my $compat_class = "DBIx::Class::Schema::Loader::Compat::${ver}";
+ if ($self->load_optional_class($compat_class)) {
+ no strict 'refs';
+ my $class = ref $self || $self;
+ unshift @{"${class}::ISA"}, $compat_class;
+ last;
+ }
+ $ver =~ s/\d\z// or last;
+ }
+ last;
+ }
+ }
+ close $fh;
+}
+
sub _find_file_in_inc {
my ($self, $file) = @_;
foreach my $prefix (@INC) {
- my $fullpath = $prefix . '/' . $file;
- return $fullpath if -f $fullpath;
+ my $fullpath = File::Spec->catfile($prefix, $file);
+ return $fullpath if -f $fullpath
+ and Cwd::abs_path($fullpath) ne
+ Cwd::abs_path(File::Spec->catfile($self->dump_directory, $file)) || '';
}
return;
}
sub _load_external {
- my $self = shift;
-
- foreach my $class ($self->schema_class, values %{$self->classes}) {
- my $class_path = $class;
- $class_path =~ s{::}{/}g;
- $class_path .= '.pm';
-
- my $inc_path = $self->_find_file_in_inc($class_path);
-
- next if !$inc_path;
-
- my $real_dump_path = $self->dump_directory
- ? Cwd::abs_path(
- File::Spec->catfile($self->dump_directory, $class_path)
- )
- : '';
- my $real_inc_path = Cwd::abs_path($inc_path);
- next if $real_inc_path eq $real_dump_path;
-
- $class->require;
- croak "Failed to load external class definition"
- . " for '$class': $@"
- if $@;
-
- # If we make it to here, we loaded an external definition
- warn qq/# Loaded external class definition for '$class'\n/
- if $self->debug;
-
- # The rest is only relevant when dumping
- next if !$self->dump_directory;
-
- croak 'Failed to locate actual external module file for '
- . "'$class'"
- if !$real_inc_path;
- open(my $fh, '<', $real_inc_path)
- or croak "Failed to open '$real_inc_path' for reading: $!";
- $self->_ext_stmt($class,
- qq|# These lines were loaded from '$real_inc_path' found in \@INC.|
- .q|# They are now part of the custom portion of this file|
- .q|# for you to hand-edit. If you do not either delete|
- .q|# this section or remove that file from @INC, this section|
- .q|# will be repeated redundantly when you re-create this|
- .q|# file again via Loader!|
- );
- while(<$fh>) {
- chomp;
- $self->_ext_stmt($class, $_);
- }
- $self->_ext_stmt($class,
- q|# End of lines loaded from '$real_inc_path' |
- );
- close($fh)
- or croak "Failed to close $real_inc_path: $!";
+ my ($self, $class) = @_;
+
+ my $class_path = $class;
+ $class_path =~ s{::}{/}g;
+ $class_path .= '.pm';
+
+ my $real_inc_path = $self->_find_file_in_inc($class_path);
+
+ return if !$real_inc_path;
+
+ # If we make it to here, we loaded an external definition
+ warn qq/# Loaded external class definition for '$class'\n/
+ if $self->debug;
+
+ croak 'Failed to locate actual external module file for '
+ . "'$class'"
+ if !$real_inc_path;
+ open(my $fh, '<', $real_inc_path)
+ or croak "Failed to open '$real_inc_path' for reading: $!";
+ $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!\n|
+ );
+ while(<$fh>) {
+ chomp;
+ $self->_ext_stmt($class, $_);
}
+ $self->_ext_stmt($class,
+ qq|# End of lines loaded from '$real_inc_path' |
+ );
+ close($fh)
+ or croak "Failed to close $real_inc_path: $!";
}
=head2 load
sub load {
my $self = shift;
- $self->_load_classes;
- $self->_load_relationships if ! $self->skip_relationships;
- $self->_load_external;
- $self->_dump_to_dir if $self->dump_directory;
+ $self->_load_tables($self->_tables_list);
+}
+
+=head2 rescan
+
+Arguments: schema
+
+Rescan the database for newly added tables. Does
+not process drops or changes. Returns a list of
+the newly added table monikers.
+
+The schema argument should be the schema class
+or object to be affected. It should probably
+be derived from the original schema_class used
+during L</load>.
+
+=cut
+
+sub rescan {
+ my ($self, $schema) = @_;
+
+ $self->{schema} = $schema;
+ $self->_relbuilder->{schema} = $schema;
+
+ my @created;
+ my @current = $self->_tables_list;
+ foreach my $table ($self->_tables_list) {
+ if(!exists $self->{_tables}->{$table}) {
+ push(@created, $table);
+ }
+ }
+
+ my $loaded = $self->_load_tables(@created);
+
+ return map { $self->monikers->{$_} } @$loaded;
+}
+
+sub _relbuilder {
+ my ($self) = @_;
+
+ return if $self->{skip_relationships};
+
+ $self->{relbuilder} ||= DBIx::Class::Schema::Loader::RelBuilder->new(
+ $self->schema, $self->inflect_plural, $self->inflect_singular
+ );
+}
+
+sub _load_tables {
+ my ($self, @tables) = @_;
+
+ # First, use _tables_list with constraint and exclude
+ # to get a list of tables to operate on
+
+ my $constraint = $self->constraint;
+ my $exclude = $self->exclude;
+
+ @tables = grep { /$constraint/ } @tables if $constraint;
+ @tables = grep { ! /$exclude/ } @tables if $exclude;
+
+ # Save the new tables to the tables list
+ foreach (@tables) {
+ $self->{_tables}->{$_} = 1;
+ }
+
+ $self->_make_src_class($_) for @tables;
+ $self->_setup_src_meta($_) for @tables;
+
+ if(!$self->skip_relationships) {
+ # The relationship loader needs a working schema
+ $self->{quiet} = 1;
+ local $self->{dump_directory} = $self->{temp_directory};
+ $self->_reload_classes(@tables);
+ $self->_load_relationships($_) for @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_external($_)
+ for map { $self->classes->{$_} } @tables;
+
+ $self->_reload_classes(@tables);
# Drop temporary cache
delete $self->{_cache};
- 1;
+ return \@tables;
+}
+
+sub _reload_classes {
+ 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};
+
+ {
+ no warnings 'redefine';
+ local *Class::C3::reinitialize = sub {};
+ use warnings;
+
+ 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;
+ }
+ $self->ensure_class_loaded($class);
+ }
+ push @to_register, [$moniker, $class];
+ }
+
+ Class::C3->reinitialize;
+ for (@to_register) {
+ $self->schema->register_class(@$_);
+ }
}
sub _get_dump_filename {
}
sub _dump_to_dir {
- my ($self) = @_;
-
- my $target_dir = $self->dump_directory;
+ my ($self, @classes) = @_;
my $schema_class = $self->schema_class;
+ my $schema_base_class = $self->schema_base_class || 'DBIx::Class::Schema';
- croak "Must specify target directory for dumping!" if ! $target_dir;
-
- warn "Dumping manual schema for $schema_class to directory $target_dir ...\n";
+ 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|# Created by DBIx::Class::Schema::Loader\n|
+ . qq|# DO NOT MODIFY THE FIRST PART OF THIS FILE\n\n|
. qq|use strict;\nuse warnings;\n\n|
- . qq|use base 'DBIx::Class::Schema';\n\n|
- . qq|__PACKAGE__->load_classes;\n|;
+ . qq|use base '$schema_base_class';\n\n|;
+
+ if ($self->use_namespaces) {
+ $schema_text .= qq|__PACKAGE__->load_namespaces|;
+ my $namespace_options;
+ for my $attr (qw(result_namespace
+ resultset_namespace
+ default_resultset_class)) {
+ if ($self->$attr) {
+ $namespace_options .= qq| $attr => '| . $self->$attr . qq|',\n|
+ }
+ }
+ $schema_text .= qq|(\n$namespace_options)| if $namespace_options;
+ $schema_text .= qq|;\n|;
+ }
+ else {
+ $schema_text .= qq|__PACKAGE__->load_classes;\n|;
+ }
$self->_write_classfile($schema_class, $schema_text);
- foreach my $src_class (sort keys %{$self->{_dump_storage}}) {
+ 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|# Created by DBIx::Class::Schema::Loader\n|
+ . qq|# DO NOT MODIFY THE FIRST PART OF THIS FILE\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";
+ warn "Schema dump completed.\n" unless $self->{dynamic} or $self->{quiet};
+
+}
+
+sub _sig_comment {
+ my ($self, $version, $ts) = @_;
+ return qq|\n\n# Created by DBIx::Class::Schema::Loader|
+ . qq| v| . $version
+ . q| @ | . $ts
+ . qq|\n# DO NOT MODIFY THIS OR ANYTHING ABOVE! md5sum:|;
}
sub _write_classfile {
my $filename = $self->_get_dump_filename($class);
$self->_ensure_dump_subdirs($class);
- if (-f $filename && $self->dump_overwrite) {
+ if (-f $filename && $self->really_erase_my_files) {
warn "Deleting existing file '$filename' due to "
- . "'dump_overwrite' setting\n";
+ . "'really_erase_my_files' setting\n" unless $self->{quiet};
unlink($filename);
}
- my $custom_content = $self->_get_custom_content($class, $filename);
-
- $custom_content ||= qq|\n# You can replace this text with custom|
- . qq| content, and it will be preserved on regeneration|
- . qq|\n1;\n|;
+ my ($custom_content, $old_md5, $old_ver, $old_ts) = $self->_get_custom_content($class, $filename);
$text .= qq|$_\n|
for @{$self->{_dump_storage}->{$class} || []};
- $text .= qq|\n\n# Created by DBIx::Class::Schema::Loader|
- . qq| v| . $DBIx::Class::Schema::Loader::VERSION
- . q| @ | . POSIX::strftime('%Y-%m-%d %H:%M:%S', localtime)
- . qq|\n# DO NOT MODIFY THIS OR ANYTHING ABOVE! md5sum:|;
+ # Check and see if the dump is infact differnt
+
+ 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) {
+ return;
+ }
+ }
+
+ $text .= $self->_sig_comment(
+ $DBIx::Class::Schema::Loader::VERSION,
+ POSIX::strftime('%Y-%m-%d %H:%M:%S', localtime)
+ );
open(my $fh, '>', $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\n";
+ print $fh $text . Digest::MD5::md5_base64($text) . "\n";
# Write out anything loaded via external partial class file in @INC
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 _default_custom_content {
+ return qq|\n\n# You can replace this text with custom|
+ . qq| content, and it will be preserved on regeneration|
+ . qq|\n1;\n|;
}
sub _get_custom_content {
my ($self, $class, $filename) = @_;
- return if ! -f $filename;
+ return ($self->_default_custom_content) if ! -f $filename;
+
open(my $fh, '<', $filename)
or croak "Cannot open '$filename' for reading: $!";
my $mark_re =
qr{^(# DO NOT MODIFY THIS OR ANYTHING ABOVE! md5sum:)([A-Za-z0-9/+]{22})\n};
- my $found = 0;
my $buffer = '';
+ my ($md5, $ts, $ver);
while(<$fh>) {
- if(!$found && /$mark_re/) {
- $found = 1;
- $buffer .= $1;
+ if(!$md5 && /$mark_re/) {
+ $md5 = $2;
+ my $line = $1;
+
+ # Pull out the previous version and timestamp
+ ($ver, $ts) = $buffer =~ m/# Created by DBIx::Class::Schema::Loader v(.*?) @ (.*?)$/s;
+
+ $buffer .= $line;
croak "Checksum mismatch in '$filename'"
- if Digest::MD5::md5_base64($buffer) ne $2;
+ if Digest::MD5::md5_base64($buffer) ne $md5;
$buffer = '';
}
}
}
- croak "Cannot not overwrite '$filename' without 'dump_overwrite',"
+ croak "Cannot not overwrite '$filename' without 'really_erase_my_files',"
. " it does not appear to have been generated by Loader"
- if !$found;
+ if !$md5;
- return $buffer;
+ # Default custom content:
+ $buffer ||= $self->_default_custom_content;
+
+ return ($buffer, $md5, $ver, $ts);
}
sub _use {
my $self = shift;
my $target = shift;
- my $evalstr;
foreach (@_) {
warn "$target: use $_;" if $self->debug;
$self->_raw_stmt($target, "use $_;");
- $_->require or croak ($_ . "->require: $@");
- $evalstr .= "package $target; use $_;";
}
- eval $evalstr if $evalstr;
- croak $@ if $@;
}
sub _inject {
my $blist = join(q{ }, @_);
warn "$target: use base qw/ $blist /;" if $self->debug && @_;
$self->_raw_stmt($target, "use base qw/ $blist /;") if @_;
- foreach (@_) {
- $_->require or croak ($_ . "->require: $@");
- $schema_class->inject_base($target, $_);
- }
}
-# Load and setup classes
-sub _load_classes {
- my $self = shift;
+# Create class with applicable bases, setup monikers, etc
+sub _make_src_class {
+ my ($self, $table) = @_;
my $schema = $self->schema;
my $schema_class = $self->schema_class;
- my $constraint = $self->constraint;
- my $exclude = $self->exclude;
- my @tables = sort $self->_tables_list;
-
- warn "No tables found in database, nothing to load" if !@tables;
-
- if(@tables) {
- @tables = grep { /$constraint/ } @tables if $constraint;
- @tables = grep { ! /$exclude/ } @tables if $exclude;
- warn "All tables excluded by constraint/exclude, nothing to load"
- if !@tables;
+ my $table_moniker = $self->_table2moniker($table);
+ my @result_namespace = ($schema_class);
+ if ($self->use_namespaces) {
+ my $result_namespace = $self->result_namespace || 'Result';
+ if ($result_namespace =~ /^\+(.*)/) {
+ # Fully qualified namespace
+ @result_namespace = ($1)
+ }
+ else {
+ # Relative namespace
+ push @result_namespace, $result_namespace;
+ }
}
+ my $table_class = join(q{::}, @result_namespace, $table_moniker);
+
+ my $table_normalized = lc $table;
+ $self->classes->{$table} = $table_class;
+ $self->classes->{$table_normalized} = $table_class;
+ $self->monikers->{$table} = $table_moniker;
+ $self->monikers->{$table_normalized} = $table_moniker;
- $self->{_tables} = \@tables;
+ $self->_use ($table_class, @{$self->additional_classes});
+ $self->_inject($table_class, @{$self->left_base_classes});
- foreach my $table (@tables) {
- my $table_moniker = $self->_table2moniker($table);
- my $table_class = $schema_class . q{::} . $table_moniker;
+ $self->_dbic_stmt($table_class, 'load_components', @{$self->components}, 'Core');
- my $table_normalized = lc $table;
- $self->classes->{$table} = $table_class;
- $self->classes->{$table_normalized} = $table_class;
- $self->monikers->{$table} = $table_moniker;
- $self->monikers->{$table_normalized} = $table_moniker;
+ $self->_dbic_stmt($table_class, 'load_resultset_components', @{$self->resultset_components})
+ if @{$self->resultset_components};
+ $self->_inject($table_class, @{$self->additional_base_classes});
+}
- no warnings 'redefine';
- local *Class::C3::reinitialize = sub { };
- use warnings;
+# Set up metadata (cols, pks, etc)
+sub _setup_src_meta {
+ my ($self, $table) = @_;
- { no strict 'refs'; @{"${table_class}::ISA"} = qw/DBIx::Class/ }
+ my $schema = $self->schema;
+ my $schema_class = $self->schema_class;
- $self->_use ($table_class, @{$self->additional_classes});
- $self->_inject($table_class, @{$self->additional_base_classes});
+ my $table_class = $self->classes->{$table};
+ my $table_moniker = $self->monikers->{$table};
- $self->_dbic_stmt($table_class, 'load_components', @{$self->components}, qw/PK::Auto Core/);
+ my $table_name = $table;
+ my $name_sep = $self->schema->storage->sql_maker->name_sep;
- $self->_dbic_stmt($table_class, 'load_resultset_components', @{$self->resultset_components})
- if @{$self->resultset_components};
- $self->_inject($table_class, @{$self->left_base_classes});
+ if ($name_sep && $table_name =~ /\Q$name_sep\E/) {
+ $table_name = \ $self->_quote_table_name($table_name);
}
- Class::C3::reinitialize;
+ $self->_dbic_stmt($table_class,'table',$table_name);
- foreach my $table (@tables) {
- my $table_class = $self->classes->{$table};
- my $table_moniker = $self->monikers->{$table};
+ my $cols = $self->_table_columns($table);
+ my $col_info;
+ eval { $col_info = $self->_columns_info_for($table) };
+ if($@) {
+ $self->_dbic_stmt($table_class,'add_columns',@$cols);
+ }
+ else {
+ 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 };
+ }
- $self->_dbic_stmt($table_class,'table',$table);
+ my $fks = $self->_table_fk_info($table);
- my $cols = $self->_table_columns($table);
- my $col_info;
- eval { $col_info = $self->_columns_info_for($table) };
- if($@) {
- $self->_dbic_stmt($table_class,'add_columns',@$cols);
- }
- else {
- my %col_info_lc = map { lc($_), $col_info->{$_} } keys %$col_info;
- $self->_dbic_stmt(
- $table_class,
- 'add_columns',
- map { $_, ($col_info_lc{$_}||{}) } @$cols
- );
+ for my $fkdef (@$fks) {
+ for my $col (@{ $fkdef->{local_columns} }) {
+ $col_info->{$col}{is_foreign_key} = 1;
+ }
}
+ $self->_dbic_stmt(
+ $table_class,
+ 'add_columns',
+ map { $_, ($col_info->{$_}||{}) } @$cols
+ );
+ }
- my $pks = $self->_table_pk_info($table) || [];
- @$pks ? $self->_dbic_stmt($table_class,'set_primary_key',@$pks)
- : carp("$table has no primary key");
+ my %uniq_tag; # used to eliminate duplicate uniqs
- my $uniqs = $self->_table_uniq_info($table) || [];
- $self->_dbic_stmt($table_class,'add_unique_constraint',@$_) for (@$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
- $schema_class->register_class($table_moniker, $table_class);
- $schema->register_class($table_moniker, $table_class) if $schema ne $schema_class;
+ my $uniqs = $self->_table_uniq_info($table) || [];
+ 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
sub tables {
my $self = shift;
- return @{$self->_tables};
+ return keys %{$self->_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_]+/, lc $table;
+ $moniker ||= $self->_default_table2moniker($table);
return $moniker;
}
sub _load_relationships {
- my $self = shift;
+ my ($self, $table) = @_;
- # Construct the fk_info RelBuilder wants to see, by
- # translating table names to monikers in the _fk_info output
- my %fk_info;
- foreach my $table ($self->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 $moniker = $self->monikers->{$table};
- $fk_info{$moniker} = $tbl_fk_info;
+ 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 $relbuilder = DBIx::Class::Schema::Loader::RelBuilder->new(
- $self->schema_class, \%fk_info, $self->inflect_plural,
- $self->inflect_singular
- );
+ my $local_moniker = $self->monikers->{$table};
+ my $rel_stmts = $self->_relbuilder->generate_code($local_moniker, $tbl_fk_info, $tbl_uniq_info);
- my $rel_stmts = $relbuilder->generate_code;
foreach my $src_class (sort keys %$rel_stmts) {
my $src_stmts = $rel_stmts->{$src_class};
foreach my $stmt (@$src_stmts) {
my $class = shift;
my $method = shift;
- if(!$self->debug && !$self->dump_directory) {
- $class->$method(@_);
- return;
- }
-
my $args = dump(@_);
$args = '(' . $args . ')' if @_ < 2;
my $stmt = $method . $args . q{;};
warn qq|$class\->$stmt\n| if $self->debug;
- $class->$method(@_);
$self->_raw_stmt($class, '__PACKAGE__->' . $stmt);
}
# Store a raw source line for a class (for dumping purposes)
sub _raw_stmt {
my ($self, $class, $stmt) = @_;
- push(@{$self->{_dump_storage}->{$class}}, $stmt) if $self->dump_directory;
+ push(@{$self->{_dump_storage}->{$class}}, $stmt);
}
# Like above, but separately for the externally loaded stuff
sub _ext_stmt {
my ($self, $class, $stmt) = @_;
- push(@{$self->{_ext_storage}->{$class}}, $stmt) if $self->dump_directory;
+ 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