X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FDBIx%2FClass%2FAdmin.pm;h=7052fbfea36aa5487d4575b4630de1760947c79b;hb=ccebe1f11c68b097a0446853b9c39a5af9cf8403;hp=b43e23b394bf69fb2b73b04da11ac4d01a8b230f;hpb=fb50ae66893dadd76a192a53e65d5d9ba171d1f3;p=dbsrgits%2FDBIx-Class.git diff --git a/lib/DBIx/Class/Admin.pm b/lib/DBIx/Class/Admin.pm index b43e23b..7052fbf 100644 --- a/lib/DBIx/Class/Admin.pm +++ b/lib/DBIx/Class/Admin.pm @@ -87,30 +87,13 @@ has 'schema' => ( sub _build_schema { my ($self) = @_; + require Class::MOP; - { - my @include_dirs = @{$self->include_dirs}; - $self->_debug("Adding to \@INC:\n".join "\n",@include_dirs) - if $self->debug; - local @INC = (@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 @@ -296,20 +279,6 @@ has quiet => ( isa => Bool, ); -=head2 debug - -Print debug information - -=cut - -has debug => ( - is => 'rw', - isa => Bool, - default => 0 -); - -sub _debug { shift; print @_ } - has '_confirm' => ( is => 'bare', isa => Bool, @@ -326,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. @@ -364,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; } @@ -396,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"; @@ -557,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 {