X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FDBIx%2FClass%2FAdmin.pm;h=7052fbfea36aa5487d4575b4630de1760947c79b;hb=7fca91be5671c61be5c766bd93df741bc00d9c15;hp=ab8309dc621ee18ac538e8acbd92067ce69ef37a;hpb=b13aab4ff956894c2dcfdfb2c1e1d8aa04cf635d;p=dbsrgits%2FDBIx-Class-Historic.git diff --git a/lib/DBIx/Class/Admin.pm b/lib/DBIx/Class/Admin.pm index ab8309d..7052fbf 100644 --- a/lib/DBIx/Class/Admin.pm +++ b/lib/DBIx/Class/Admin.pm @@ -87,27 +87,13 @@ has 'schema' => ( sub _build_schema { my ($self) = @_; + require Class::MOP; - { - local @INC = (@{$self->include_dirs}, @INC); - Class::MOP::load_class($self->schema_class); - } - $self->connect_info->[3]->{ignore_version} =1; - return $self->schema_class->connect(@{$self->connect_info()} ); # , $self->connect_info->[3], { ignore_version => 1} ); + Class::MOP::load_class($self->schema_class); + $self->connect_info->[3]{ignore_version} = 1; + return $self->schema_class->connect(@{$self->connect_info}); } -=head2 include_dirs - -Extra include directories to look when loading C - -=cut - -has 'include_dirs' => ( - is => 'rw', - isa => 'ArrayRef', - default => sub {[]} -); - =head2 resultset a resultset from the schema to operate on @@ -222,8 +208,8 @@ has config => ( sub _build_config { my ($self) = @_; - eval { require Config::Any } - or die ("Config::Any is required to parse the config file.\n"); + try { require Config::Any } + catch { die ("Config::Any is required to parse the config file.\n") }; my $cfg = Config::Any->load_files ( {files => [$self->config_file], use_ext =>1, flatten_to_hash=>1}); @@ -309,8 +295,9 @@ has '_confirm' => ( =back -L will generate sql for the supplied schema_class in sql_dir. The flavour of sql to -generate can be controlled by suppling a sqlt_type which should be a L name. +L will generate sql for the supplied schema_class in sql_dir. The +flavour of sql to generate can be controlled by supplying a sqlt_type which +should be a L name. Arguments for L can be supplied in the sqlt_args hashref. @@ -347,10 +334,12 @@ B sub upgrade { my ($self) = @_; my $schema = $self->schema(); + if (!$schema->get_db_version()) { # schema is unversioned $schema->throw_exception ("Could not determin current schema version, please either install() or deploy().\n"); } else { + $schema->upgrade_directory ($self->sql_dir) if $self->sql_dir; # this will override whatever default the schema has my $ret = $schema->upgrade(); return $ret; } @@ -379,9 +368,9 @@ sub install { $version ||= $self->version(); if (!$schema->get_db_version() ) { # schema is unversioned - print "Going to install schema version\n"; + print "Going to install schema version\n" if (!$self->quiet); my $ret = $schema->install($version); - print "retun is $ret\n"; + print "return is $ret\n" if (!$self->quiet); } elsif ($schema->get_db_version() and $self->force ) { carp "Forcing install may not be a good idea"; @@ -540,12 +529,14 @@ sub select { sub _confirm { my ($self) = @_; - print "Are you sure you want to do this? (type YES to confirm) \n"; + # mainly here for testing return 1 if ($self->meta->get_attribute('_confirm')->get_value($self)); + + print "Are you sure you want to do this? (type YES to confirm) \n"; my $response = ; - return 1 if ($response=~/^YES/); - return; + + return ($response=~/^YES/); } sub _find_stanza {