Carp::Clan = 0
aliased = 0
DBIx::Class::Schema::Loader = 0.07017
+
+[Prereqs / TestRequires]
+Test::Requires = 0
with 'DBIx::Class::DeploymentHandler::HandlesDeploy';
with 'DBIx::Class::DeploymentHandler::WithApplicatorDumple' => {
- interface_role => 'DBIx::Class::DeploymentHandler::HandlesProvideSchema',
- class_name => 'DBIx::Class::DeploymentHandler::ProvideSchema::SchemaLoader',
+ interface_role => 'DBIx::Class::DeploymentHandler::HandlesMigrationSchema',
+ class_name => 'DBIx::Class::DeploymentHandler::MigrationSchema::SchemaLoader',
delegate_name => 'schema_provider',
attributes_to_assume => ['schema'],
attributes_to_copy => [qw( schema )],
-package DBIx::Class::DeploymentHandler::HandlesProvideSchema;
+package DBIx::Class::DeploymentHandler::HandlesMigrationSchema;
use Moose::Role;
# ABSTRACT: Interface for providing a $schema to the deployment scripts
__END__
-=method schema_for_run_files
+=method migration_schema
- my $schema = $dh->schema_for_run_files;
+ my $schema = $dh->migration_schema;
Provides a L<DBIx::Class::Schema> object that we can pass to the Perl deploy
scripts.
=item *
-L<DBIx::Class::DeploymentHandler::ProvideSchema::FromCurrent>
+L<DBIx::Class::DeploymentHandler::MigrationSchema::FromCurrent>
=item *
-L<DBIx::Class::DeploymentHandler::ProvideSchema::SQL::SchemaLoader>
+L<DBIx::Class::DeploymentHandler::MigrationSchema::SQL::SchemaLoader>
=back
-package DBIx::Class::DeploymentHandler::ProvideSchema::SQL::FromCurrent;
+package DBIx::Class::DeploymentHandler::MigrationSchema::FromCurrent;
use Moose;
-with 'DBIx::Class::DeploymentHandler::HandlesProvideSchema';
+with 'DBIx::Class::DeploymentHandler::HandlesMigrationSchema';
has schema => (is=>'ro', required=>1);
__END__
-=method schema_for_run_files
+=method migration_schema
- my $schema = $dh->schema_for_run_files;
+ my $schema = $dh->migration_schema;
Provides a L<DBIx::Class::Schema> object that we can pass to the Perl deploy
scripts. We just return whatever C<$schema> you passed when you instantiated
-package DBIx::Class::DeploymentHandler::ProvideSchema::SchemaLoader;
+package DBIx::Class::DeploymentHandler::MigrationSchema::SchemaLoader;
use Moose;
use DBIx::Class::Schema::Loader;
-with 'DBIx::Class::DeploymentHandler::HandlesProvideSchema';
+with 'DBIx::Class::DeploymentHandler::HandlesMigrationSchema';
has schema => (is=>'ro', required=>1);
__END__
-=method schema_for_run_files
+=method migration_schema
- my $schema = $dh->schema_for_run_files;
+ my $schema = $dh->migration_schema;
Provides a L<DBIx::Class::Schema> object that we can pass to the Perl deploy
scripts. We reverse engineer a C<$schema> from whatever is currently deployed
--- /dev/null
+#!/usr/bin/env perl
+
+use warnings;
+use strict;
+use lib 't/lib';
+
+use Test::More;
+use Test::Requires qw(Test::postgresql);
+use Test::Requires qw(Test::mysqld);
+use File::Spec::Functions 'catdir', 'catfile';
+use File::Path 'remove_tree';
+use DBIx::Class::DeploymentHandler;
+use DBICDHTest;
+
+
+VERSION1: {
+ ok my $testdb = build_test_mysql(),
+ 'good test db';
+
+ my $dbh = DBI->connect("DBI:mysql:test;mysql_socket=${\$testdb->base_dir}/tmp/mysql.sock",'root','');
+
+ use_ok 'DBICVersion_v1';
+ $DBICVersion::Schema::VERSION = 1;
+ ok my $schema = DBICVersion::Schema->connect(sub { $dbh }),
+ 'got schema';
+
+ ok my $dbic_dh = build_dh($schema),
+ 'got dbicdh';
+
+ $dbic_dh->prepare_install;
+ $dbic_dh->install;
+
+ is $dbic_dh->database_version, 1, 'correct db version';
+}
+
+VERSION2: {
+ ok my $testdb = build_test_mysql(),
+ 'good test db';
+
+ my $dbh = DBI->connect("DBI:mysql:test;mysql_socket=${\$testdb->base_dir}/tmp/mysql.sock",'root','');
+
+ use_ok 'DBICVersion_v2';
+ $DBICVersion::Schema::VERSION = 2;
+ ok my $schema = DBICVersion::Schema->connect(sub { $dbh }),
+ 'got schema';
+
+ ok my $dbic_dh = build_dh($schema,1),
+ 'got dbicdh';
+
+ $dbic_dh->prepare_install();
+ $dbic_dh->prepare_upgrade();
+ $dbic_dh->prepare_downgrade();
+ $dbic_dh->upgrade;
+
+ is $dbic_dh->database_version, 2, 'correct db version';
+
+}
+
+ok -d catdir('t','share','var','mysql-deploy','MySQL','downgrade','2-1'),
+ 'reasonable defaults properly creates a downgrade';
+
+VERSION1FORCE: {
+
+ remove_tree catdir('t','share','var','mysql');
+
+ ok my $testdb = build_test_mysql(),
+ 'good test db';
+
+ my $dbh = DBI->connect("DBI:mysql:test;mysql_socket=${\$testdb->base_dir}/tmp/mysql.sock",'root','');
+
+ use_ok 'DBICVersion_v2';
+ $DBICVersion::Schema::VERSION = 2;
+ ok my $schema = DBICVersion::Schema->connect(sub { $dbh }),
+ 'got schema';
+
+ my $dbic_dh = DBIx::Class::DeploymentHandler->new({
+ script_directory => catdir('t','share','var','mysql-deploy'),
+ to_version => 1,
+ schema => $schema,
+ databases => ['MySQL']});
+
+ $dbic_dh->install;
+
+ is $dbic_dh->database_version, 1, 'correct db version';
+}
+
+done_testing();
+
+sub build_dh {
+ DBIx::Class::DeploymentHandler->new({
+ script_directory => catdir('t','share','var','mysql-deploy'),
+ schema => shift,
+ databases => ['MySQL']});
+}
+
+sub build_test_mysql {
+ my $base_dir = catdir('t','share','var','mysql');
+ my $auto_start = -d $base_dir ? 1:2;
+ my %config = (
+ base_dir => $base_dir,
+ auto_start => $auto_start);
+
+ return Test::mysqld->new(
+ auto_start => $auto_start,
+ base_dir => $base_dir);
+
+
+ if(my $testdb = Test::mysqld->new(%config)) {
+ return $testdb;
+ } else {
+ die $Test::mysqld::errstr;
+ }
+}
+
+END {
+ remove_tree catdir('t','share','var','mysql');
+ remove_tree catdir('t','share','var','mysql-deploy');
+}
+
--- /dev/null
+#!/usr/bin/env perl
+
+use warnings;
+use strict;
+use lib 't/lib';
+
+use Test::More;
+use Test::Requires qw(Test::postgresql);
+use Test::Requires qw(POSIX);
+use File::Spec::Functions 'catdir', 'catfile';
+use File::Path 'remove_tree';
+use DBIx::Class::DeploymentHandler;
+use DBICDHTest;
+
+ok my $testdb = build_test_postgresql(),
+ 'good test db';
+
+my $dbh = DBI->connect("DBI:Pg:dbname=test;host=127.0.0.1;port=${\$testdb->port}",'postgres','');
+
+VERSION1: {
+ use_ok 'DBICVersion_v1';
+ $DBICVersion::Schema::VERSION = 1;
+ ok my $schema = DBICVersion::Schema->connect(sub { $dbh }),
+ 'got schema';
+
+ ok my $dbic_dh = build_dh($schema),
+ 'got dbicdh';
+
+ $dbic_dh->prepare_install;
+ make_perl_runfile();
+ $dbic_dh->install;
+
+ is $dbic_dh->database_version, 1, 'correct db version';
+}
+
+VERSION2: {
+ use_ok 'DBICVersion_v2';
+ $DBICVersion::Schema::VERSION = 2;
+ ok my $schema = DBICVersion::Schema->connect(sub { $dbh }),
+ 'got schema';
+
+ ok my $dbic_dh = build_dh($schema,1),
+ 'got dbicdh';
+
+ $dbic_dh->prepare_install();
+ $dbic_dh->prepare_upgrade();
+ $dbic_dh->prepare_downgrade();
+}
+
+ok -d catdir('t','share','var','pg-deploy','PostgreSQL','downgrade','2-1'),
+ 'reasonable defaults properly creates a downgrade';
+
+$testdb->stop(POSIX::SIGINT); ## We need this to stop Pg
+done_testing();
+
+sub build_dh {
+ DBIx::Class::DeploymentHandler->new({
+ script_directory => catdir('t','share','var','pg-deploy'),
+ schema => shift,
+ databases => ['PostgreSQL']});
+}
+
+sub build_test_postgresql {
+ my %config = (
+ base_dir => catdir('t','share','var','pg'),
+ initdb_args => $Test::postgresql::Defaults{initdb_args},
+ postmaster_args => $Test::postgresql::Defaults{postmaster_args});
+
+ if(my $testdb = Test::postgresql->new(%config)) {
+ return $testdb;
+ } else {
+ die $Test::postgresql::errstr;
+ }
+}
+
+sub make_perl_runfile {
+ open(
+ my $perl_run,
+ ">",
+ catfile('t','share','var','pg-deploy','PostgreSQL', 'deploy', '1', '002-test.pl')
+ ) || die "Cannot open: $!";
+
+ print $perl_run <<'END';
+ sub {
+ my $schema = shift;
+ };
+END
+
+ close $perl_run;
+}
+
+END {
+ remove_tree catdir('t','share','var','pg');
+ remove_tree catdir('t','share','var','pg-deploy');
+}
projects / dbsrgits/DBIx-Class-DeploymentHandler.git / commitdiff