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_02';
+our $VERSION = '0.04999_06';
__PACKAGE__->mk_ro_accessors(qw/
schema
debug
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
=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
$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->{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->_ext_stmt($class, $_);
}
$self->_ext_stmt($class,
- q|# End of lines loaded from '$real_inc_path' |
+ qq|# End of lines loaded from '$real_inc_path' |
);
close($fh)
or croak "Failed to close $real_inc_path: $!";
}
}
- $self->_load_tables(@created);
+ my $loaded = $self->_load_tables(@created);
- return map { $self->monikers->{$_} } @created;
+ return map { $self->monikers->{$_} } @$loaded;
}
sub _load_tables {
$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};
- 1;
+ 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 {
}
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 {
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|
+ $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|
}
}
- 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;
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