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.
=head2 moniker_map
-Overrides the default tablename -> moniker translation. Can be either
-a hashref of table => moniker names, or a coderef for a translator
+Overrides the default table name to moniker translation. Can be either
+a hashref of table keys and moniker values, or a coderef for a translator
function taking a single scalar table name argument and returning
a scalar moniker. If the hash entry does not exist, or the function
returns a false value, the code falls back to default behavior
=head2 resultset_components
-List of additional resultset components to be loaded into your table
+List of additional ResultSet components to be loaded into your table
classes. A good example would be C<AlwaysRS>. Component
C<ResultSetManager> will be automatically added to the above
C<components> list if this option is set.
=head2 legacy_default_inflections
Setting this option changes the default fallback for L</inflect_plural> to
-utilize L<Lingua::EN::Inflect/PL>, and L</inflect_singlular> to a no-op.
-Those choices produce substandard results, but might be neccesary to support
+utilize L<Lingua::EN::Inflect/PL>, and L</inflect_singular> to a no-op.
+Those choices produce substandard results, but might be necessary to support
your existing code if you started developing on a version prior to 0.03 and
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
manual version of itself. This might be a really good or bad thing
depending on your situation and perspective.
-Normally you wouldn't hardcode this setting in your schema class, as it
+Normally you wouldn't hard-code this setting in your schema class, as it
is meant for one-time manual usage.
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,
$self->_load_external;
$self->_dump_to_dir if $self->dump_directory;
+ # Drop temporary cache
+ delete $self->{_cache};
+
1;
}
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 $target_dir = $self->dump_directory;
- die "Must specify target directory for dumping!" if ! $target_dir;
+ my $schema_class = $self->schema_class;
+
+ croak "Must specify target directory for dumping!" if ! $target_dir;
- warn "Dumping manual schema to $target_dir ...\n";
+ 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;
my $datestr = POSIX::strftime('%Y-%m-%d %H:%M:%S', localtime);
my $tagline = qq|# Created by DBIx::Class::Schema::Loader v$verstr @ $datestr|;
- my $schema_class = $self->schema_class;
$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)
=head2 monikers
-Returns a hashref of loaded table-to-moniker mappings. There will
+Returns a hashref of loaded table to moniker mappings. There will
be two entries for each table, the original name and the "normalized"
name, in the case that the two are different (such as databases
that like uppercase table names, or preserve your original mixed-case
=head2 classes
-Returns a hashref of table-to-classname mappings. In some cases it will
+Returns a hashref of table to class mappings. In some cases it will
contain multiple entries per table for the original and normalized table
names, as above in L</monikers>.
projects / dbsrgits/DBIx-Class-Schema-Loader.git / blobdiff