File Coverage

blib/lib/App/Schema/Deploy.pm

Criterion	Covered	Total	%
statement	53	65	81.5
branch	11	22	50.0
condition	6	6	100.0
subroutine	7	7	100.0
pod	2	2	100.0
total	79	102	77.4

package App::Schema::Deploy;

use strict;
use warnings;

use English;
use Error::Pure qw(err);
use Getopt::Std;

our $VERSION = 0.05;

# Constructor.
sub new {
	my ($class, @params) = @_;

	# Create object.
	my $self = bless {}, $class;

	# Object.
	return $self;
}

# Run.
sub run {
	my $self = shift;

	# Process arguments.
	$self->{'_opts'} = {
		'd' => 0,
		'h' => 0,
		'p' => '',
		'q' => 0,
		'u' => '',
		'v' => undef,
	};
	if (! getopts('dhp:qu:v:', $self->{'_opts'})
		|| $self->{'_opts'}->{'h'}
		|| @ARGV < 2) {

		print STDERR "Usage: $0 [-d] [-h] [-p password] [-q] [-u user] [-v schema_version] ".
			"[--version] dsn schema_module\n";
		print STDERR "\t-d\t\t\tDrop tables.\n";
		print STDERR "\t-h\t\t\tPrint help.\n";
		print STDERR "\t-p password\t\tDatabase password.\n";
		print STDERR "\t-q\t\t\tQuiet mode.\n";
		print STDERR "\t-u user\t\t\tDatabase user.\n";
		print STDERR "\t-v schema_version\tSchema version (default is ".
			"latest version).\n";
		print STDERR "\t--version\t\tPrint version.\n";
		print STDERR "\tdsn\t\t\tDatabase DSN. e.g. dbi:SQLite:dbname=ex1.db\n";
		print STDERR "\tschema_module\t\tName of Schema module.\n";
		return 1;
	}
	$self->{'_dsn'} = shift @ARGV;
	$self->{'_schema_module'} = shift @ARGV;

	eval "require $self->{'_schema_module'}";
	if ($EVAL_ERROR) {
		err 'Cannot load Schema module.',
			'Module name', $self->{'_schema_module'},
			'Error', $EVAL_ERROR,
		;
	}

	my $schema_module;
	my $schema_version;
	if ($self->{'_schema_module'}->can('new')) {
		my $versioned_schema = $self->{'_schema_module'}->new(
			$self->{'_opts'}->{'v'} ? (
				'version' => $self->{'_opts'}->{'v'},
			) : (),
		);
		$schema_module = $versioned_schema->schema;
		$schema_version = $versioned_schema->version;

	} else {
		$schema_module = $self->{'_schema_module'};
	}

	my $schema = eval {
		$schema_module->connect($self->{'_dsn'},
			$self->{'_opts'}->{'u'}, $self->{'_opts'}->{'p'}, {});
	};
	if ($EVAL_ERROR) {
		err 'Cannot connect to database.',
			'Error', $EVAL_ERROR,
		;
	}
	if (! $schema->isa('DBIx::Class::Schema')) {
		err "Instance of schema must be a 'DBIx::Class::Schema' object.",
			'Reference', $schema->isa,
		;
	}

	# Deploy.
	my $sqlt_args_hr = {};
	if ($self->{'_opts'}->{'d'}) {
		$sqlt_args_hr->{'add_drop_table'} = 1;
	}
	eval {
		$schema->deploy($sqlt_args_hr);
	};
	if ($EVAL_ERROR) {
		my %err = (
			'Error' => $EVAL_ERROR->{'msg'},
		);
		if ($EVAL_ERROR->{'msg'} =~ m/DBI Connection failed/) {
			err "Cannot connect to database.",
				%err,
			;
		} else {
			err 'Cannot deploy schema.',
				%err,
			;
		}
	}

	if (! $self->{'_opts'}->{'q'}) {
		my $print_version = '';
		if (defined $schema_version) {
			$print_version = '(v'.$schema_version.') ';
		}
		print "Schema ${print_version}from '$self->{'_schema_module'}' was ".
			"deployed to '$self->{'_dsn'}'.\n";
	}

	return 0;
}

1;


__END__