use warnings;
use base qw/Class::Accessor::Fast/;
use Class::C3;
-use Carp;
+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//;
require DBIx::Class;
__PACKAGE__->mk_ro_accessors(qw/
inflect_plural
debug
dump_directory
+ dump_overwrite
legacy_default_inflections
If set to true, each constructive L<DBIx::Class> statement the loader
decides to execute will be C<warn>-ed before execution.
+=head2 db_schema
+
+Set the name of the schema to load (schema in the sense that your database
+vendor means it). Does not currently support loading more than one schema
+name.
+
=head2 constraint
Only load tables matching regex. Best specified as a qr// regex.
don't wish to go around updating all your relationship names to the new
defaults.
+This option will continue to be supported until at least version 0.05xxx,
+but may dissappear sometime thereafter. It is recommended that you update
+your code to use the newer-style inflections when you have the time.
+
=head2 dump_directory
This option is designed to be a tool to help you transition from this
See L<DBIx::Class::Schema::Loader/dump_to_dir> for examples of the
recommended way to access this functionality.
+=head2 dump_overwrite
+
+If set to a true value, the dumping code will overwrite existing files.
+The default is false, which means the dumping code will skip the already
+existing files.
+
=head1 DEPRECATED CONSTRUCTOR OPTIONS
+B<These will be removed in version 0.04000 !!!>
+
=head2 inflect_map
Equivalent to L</inflect_plural>.
You connect these schemas the same way you would any L<DBIx::Class::Schema>,
which is by calling either C<connect> or C<connection> on a schema class
or object. These options are only supported via the deprecated
-C<load_from_connection> interface, which will be removed in the future.
+C<load_from_connection> interface, which is also being removed in 0.04000.
=head1 METHODS
# Support deprecated arguments
for(qw/inflect_map inflect/) {
warn "Argument $_ is deprecated in favor of 'inflect_plural'"
- if $self->{$_};
+ . ", and will be removed in 0.04000"
+ if $self->{$_};
}
$self->{inflect_plural} ||= $self->{inflect_map} || $self->{inflect};
sub _load_external {
my $self = shift;
+ my $abs_dump_dir;
+
+ $abs_dump_dir = File::Spec->rel2abs($self->dump_directory)
+ if $self->dump_directory;
+
foreach my $table_class (values %{$self->classes}) {
$table_class->require;
if($@ && $@ !~ /^Can't locate /) {
warn qq/# Loaded external class definition for '$table_class'\n/
if $self->debug;
- if($self->dump_directory) {
+ if($abs_dump_dir) {
my $class_path = $table_class;
$class_path =~ s{::}{/}g;
- my $filename = $INC{$class_path};
+ $class_path .= '.pm';
+ my $filename = File::Spec->rel2abs($INC{$class_path});
croak 'Failed to locate actual external module file for '
. "'$table_class'"
if !$filename;
+ next if($filename =~ /^$abs_dump_dir/);
open(my $fh, '<', $filename)
or croak "Failed to open $filename for reading: $!";
$self->_raw_stmt($table_class,
my ($self, $class) = (@_);
my @name_parts = split(/::/, $class);
- pop @name_parts;
+ pop @name_parts; # we don't care about the very last element,
+ # which is a filename
+
my $dir = $self->dump_directory;
foreach (@name_parts) {
- $dir .= q{/} . $_;
+ $dir = File::Spec->catdir($dir,$_);
if(! -d $dir) {
- mkdir($dir) or die "mkdir('$dir') failed: $!";
+ mkdir($dir) or croak "mkdir('$dir') failed: $!";
}
}
}
my ($self) = @_;
my $target_dir = $self->dump_directory;
+
my $schema_class = $self->schema_class;
- die "Must specify target directory for dumping!" if ! $target_dir;
+ croak "Must specify target directory for dumping!" if ! $target_dir;
warn "Dumping manual schema for $schema_class to directory $target_dir ...\n";
if(! -d $target_dir) {
- mkdir($target_dir) or die "mkdir('$target_dir') failed: $!";
+ mkdir($target_dir) or croak "mkdir('$target_dir') failed: $!";
}
my $verstr = $DBIx::Class::Schema::Loader::VERSION;
$self->_ensure_dump_subdirs($schema_class);
my $schema_fn = $self->_get_dump_filename($schema_class);
- open(my $schema_fh, '>', $schema_fn)
- or die "Cannot open $schema_fn for writing: $!";
- print $schema_fh qq|package $schema_class;\n\n$tagline\n\n|;
- print $schema_fh qq|use strict;\nuse warnings;\n\n|;
- print $schema_fh qq|use base 'DBIx::Class::Schema';\n\n|;
- print $schema_fh qq|__PACKAGE__->load_classes;\n|;
- print $schema_fh qq|\n1;\n\n|;
- close($schema_fh)
- or die "Cannot close $schema_fn: $!";
+ if (-f $schema_fn && !$self->dump_overwrite) {
+ warn "$schema_fn exists, will not overwrite\n";
+ }
+ else {
+ open(my $schema_fh, '>', $schema_fn)
+ or croak "Cannot open $schema_fn for writing: $!";
+ print $schema_fh qq|package $schema_class;\n\n$tagline\n\n|;
+ print $schema_fh qq|use strict;\nuse warnings;\n\n|;
+ print $schema_fh qq|use base 'DBIx::Class::Schema';\n\n|;
+ print $schema_fh qq|__PACKAGE__->load_classes;\n|;
+ print $schema_fh qq|\n1;\n\n|;
+ close($schema_fh)
+ or croak "Cannot close $schema_fn: $!";
+ }
foreach my $src_class (sort keys %{$self->{_dump_storage}}) {
$self->_ensure_dump_subdirs($src_class);
my $src_fn = $self->_get_dump_filename($src_class);
+ if (-f $src_fn && !$self->dump_overwrite) {
+ warn "$src_fn exists, will not overwrite\n";
+ next;
+ }
open(my $src_fh, '>', $src_fn)
- or die "Cannot open $src_fn for writing: $!";
+ or croak "Cannot open $src_fn for writing: $!";
print $src_fh qq|package $src_class;\n\n$tagline\n\n|;
print $src_fh qq|use strict;\nuse warnings;\n\n|;
print $src_fh qq|use base 'DBIx::Class';\n\n|;
for @{$self->{_dump_storage}->{$src_class}};
print $src_fh qq|\n1;\n\n|;
close($src_fh)
- or die "Cannot close $src_fn: $!";
+ or croak "Cannot close $src_fn: $!";
}
warn "Schema dump completed.\n";
sub _use {
my $self = shift;
my $target = shift;
+ my $evalstr;
foreach (@_) {
- $_->require or croak ($_ . "->require: $@");
+ warn "$target: use $_;" if $self->debug;
$self->_raw_stmt($target, "use $_;");
- warn "$target: use $_" if $self->debug;
- eval "package $target; use $_;";
- croak "use $_: $@" if $@;
+ $_->require or croak ($_ . "->require: $@");
+ $evalstr .= "package $target; use $_;";
}
+ eval $evalstr if $evalstr;
+ croak $@ if $@;
}
sub _inject {
my $schema_class = $self->schema_class;
my $blist = join(q{ }, @_);
+ warn "$target: use base qw/ $blist /;" if $self->debug && @_;
$self->_raw_stmt($target, "use base qw/ $blist /;") if @_;
- warn "$target: use base qw/ $blist /" if $self->debug;
foreach (@_) {
$_->require or croak ($_ . "->require: $@");
$schema_class->inject_base($target, $_);
sub _load_classes {
my $self = shift;
- my $schema = $self->schema;
- my $schema_class = $self->schema_class;
-
- my $constraint = $self->constraint;
- my $exclude = $self->exclude;
- my @tables = sort $self->_tables_list;
+ 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;
local *Class::C3::reinitialize = sub { };
use warnings;
- { no strict 'refs';
- @{"${table_class}::ISA"} = qw/DBIx::Class/;
- }
+ { 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->_dbic_stmt($table_class,'table',$table);
my $cols = $self->_table_columns($table);
- $self->_dbic_stmt($table_class,'add_columns',@$cols);
+ my $col_info;
+ eval { $col_info = $schema->storage->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
+ );
+ }
my $pks = $self->_table_pk_info($table) || [];
@$pks ? $self->_dbic_stmt($table_class,'set_primary_key',@$pks)
projects / dbsrgits/DBIx-Class-Schema-Loader.git / blobdiff