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.04999_04';
+our $VERSION = '0.04999_06';
__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.
. " 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_inc_path = $self->_find_file_in_inc($class_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;
-
- $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);
+
+ unshift @INC, $self->dump_directory;
+
+ 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 $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|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);
- 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|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 _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\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 {
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
$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) = @_;
);
}
+ 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);
+ }
- $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;
}
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
projects / dbsrgits/DBIx-Class-Schema-Loader.git / blobdiff