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.04002';
+our $VERSION = '0.04999_06';
__PACKAGE__->mk_ro_accessors(qw/
schema
dump_directory
dump_overwrite
really_erase_my_files
+ use_namespaces
+ result_namespace
+ resultset_namespace
+ default_resultset_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
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
. " DBIx::Class::Schema::Loader::Base documentation"
if $self->{dump_overwrite};
+ $self->{dynamic} = ! $self->{dump_directory};
+ $self->{dump_directory} ||= File::Temp::tempdir( 'dbicXXXX',
+ TMPDIR => 1,
+ CLEANUP => 1,
+ );
+
$self->{relbuilder} = DBIx::Class::Schema::Loader::RelBuilder->new(
$self->schema_class, $self->inflect_plural, $self->inflect_singular
) if !$self->{skip_relationships};
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;
$class_path =~ s{::}{/}g;
$class_path .= '.pm';
- my $inc_path = $self->_find_file_in_inc($class_path);
-
- return 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);
- return if $real_inc_path eq $real_dump_path;
+ my $real_inc_path = $self->_find_file_in_inc($class_path);
- $class->require;
- croak "Failed to load external class definition"
- . " for '$class': $@"
- if $@;
+ 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;
- # The rest is only relevant when dumping
- return 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!|
+ 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->{_tables}->{$_} = 1;
}
- # Set up classes/monikers
- {
- no warnings 'redefine';
- local *Class::C3::reinitialize = sub { };
- use warnings;
-
- $self->_make_src_class($_) for @tables;
- }
-
- Class::C3::reinitialize;
-
+ $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;
+ $self->_reload_classes(@tables);
$self->_load_relationships($_) for @tables;
+ $self->{quiet} = 0;
}
$self->_load_external($_)
for map { $self->classes->{$_} } @tables;
- $self->_dump_to_dir if $self->dump_directory;
+ $self->_reload_classes(@tables);
# Drop temporary cache
delete $self->{_cache};
return \@tables;
}
+sub _reload_classes {
+ my ($self, @tables) = @_;
+
+ $self->_dump_to_dir(map { $self->classes->{$_} } @tables);
+
+ for my $table (@tables) {
+ my $moniker = $self->monikers->{$table};
+ my $class = $self->classes->{$table};
+
+ {
+ no warnings 'redefine';
+ 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->require or die "Can't load $class: $@";
+ }
+
+ $self->schema_class->register_class($moniker, $class);
+ $self->schema->register_class($moniker, $class)
+ if $self->schema ne $self->schema_class;
+ }
+}
+
sub _get_dump_filename {
my ($self, $class) = (@_);
}
sub _dump_to_dir {
- my ($self) = @_;
+ my ($self, @classes) = @_;
my $target_dir = $self->dump_directory;
my $schema_class = $self->schema_class;
- croak "Must specify target directory for dumping!" if ! $target_dir;
-
- warn "Dumping manual schema for $schema_class to directory $target_dir ...\n";
+ 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|__PACKAGE__->load_classes;\n|;
+ . qq|use base 'DBIx::Class::Schema';\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}}) {
+ foreach my $src_class (@classes) {
my $src_text =
qq|package $src_class;\n\n|
. qq|use strict;\nuse warnings;\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};
+
+ unshift @INC, $target_dir;
}
sub _write_classfile {
if (-f $filename && $self->really_erase_my_files) {
warn "Deleting existing file '$filename' due to "
- . "'really_erase_my_files' 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|
+ $custom_content ||= qq|\n\n# You can replace this text with custom|
. qq| content, and it will be preserved on regeneration|
. qq|\n1;\n|;
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|
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, $_);
- }
}
# Create class with applicable bases, setup monikers, etc
my $schema_class = $self->schema_class;
my $table_moniker = $self->_table2moniker($table);
- my $table_class = $schema_class . q{::} . $table_moniker;
+ 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->monikers->{$table} = $table_moniker;
$self->monikers->{$table_normalized} = $table_moniker;
- { no strict 'refs'; @{"${table_class}::ISA"} = qw/DBIx::Class/ }
-
$self->_use ($table_class, @{$self->additional_classes});
- $self->_inject($table_class, @{$self->additional_base_classes});
+ $self->_inject($table_class, @{$self->left_base_classes});
$self->_dbic_stmt($table_class, 'load_components', @{$self->components}, 'Core');
$self->_dbic_stmt($table_class, 'load_resultset_components', @{$self->resultset_components})
if @{$self->resultset_components};
- $self->_inject($table_class, @{$self->left_base_classes});
+ $self->_inject($table_class, @{$self->additional_base_classes});
}
-# Set up metadata (cols, pks, etc) and register the class with the schema
+# Set up metadata (cols, pks, etc)
sub _setup_src_meta {
my ($self, $table) = @_;
}
else {
my %col_info_lc = 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;
+ }
+ }
$self->_dbic_stmt(
$table_class,
'add_columns',
my $uniqs = $self->_table_uniq_info($table) || [];
$self->_dbic_stmt($table_class,'add_unique_constraint',@$_) for (@$uniqs);
-
- $schema_class->register_class($table_moniker, $table_class);
- $schema->register_class($table_moniker, $table_class) if $schema ne $schema_class;
}
=head2 tables
$moniker = $self->moniker_map->($table);
}
- $moniker ||= join '', map ucfirst, split /[\W_]+/, lc $table;
+ $moniker ||= join '', map ucfirst, split /[\W_]+/,
+ Lingua::EN::Inflect::Number::to_S(lc $table);
return $moniker;
}
$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 $rel_stmts = $self->{relbuilder}->generate_code($local_moniker, $tbl_fk_info);
+ my $rel_stmts = $self->{relbuilder}->generate_code($local_moniker, $tbl_fk_info, $tbl_uniq_info);
foreach my $src_class (sort keys %$rel_stmts) {
my $src_stmts = $rel_stmts->{$src_class};
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);
}
=head2 monikers