use warnings;
use base qw/Class::Accessor::Fast/;
use Class::C3;
-use Carp::Clan qw/^DBIx::Class::Schema::Loader/;
+use Carp::Clan qw/^DBIx::Class/;
use UNIVERSAL::require;
use DBIx::Class::Schema::Loader::RelBuilder;
use Data::Dump qw/ dump /;
use POSIX qw//;
require DBIx::Class;
+our $VERSION = '0.03999_01';
+
__PACKAGE__->mk_ro_accessors(qw/
schema
schema_class
=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 die if it encounters
-an existing file.
+The default is false, which means the dumping code will skip the already
+existing files.
=head1 DEPRECATED CONSTRUCTOR OPTIONS
$self->_ensure_dump_subdirs($schema_class);
my $schema_fn = $self->_get_dump_filename($schema_class);
- croak "$schema_fn exists, will not overwrite"
- if -f $schema_fn && !$self->dump_overwrite;
- sysopen(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: $!";
+ 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);
- croak "$src_fn exists, will not overwrite"
- if -f $src_fn && !$self->dump_overwrite;
+ if (-f $src_fn && !$self->dump_overwrite) {
+ warn "$src_fn exists, will not overwrite\n";
+ next;
+ }
open(my $src_fh, '>', $src_fn)
or croak "Cannot open $src_fn for writing: $!";
print $src_fh qq|package $src_class;\n\n$tagline\n\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, $_);
$self->_dbic_stmt($table_class,'add_columns',@$cols);
}
else {
- my %cols_hash;
- foreach my $col (@$cols) {
- $cols_hash{$col} = \%{($col_info->{$col})};
- }
- $self->_dbic_stmt($table_class,'add_columns',%cols_hash);
+ 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) || [];