File Coverage

blib/lib/App/Schema/Deploy.pm
Criterion Covered Total %
statement 35 53 66.0
branch 3 14 21.4
condition 6 6 100.0
subroutine 7 7 100.0
pod 2 2 100.0
total 53 82 64.6


line stmt bran cond sub pod time code
1             package App::Schema::Deploy;
2              
3 4     4   62348 use strict;
  4         22  
  4         95  
4 4     4   16 use warnings;
  4         7  
  4         77  
5              
6 4     4   1792 use English;
  4         12997  
  4         21  
7 4     4   3033 use Error::Pure qw(err);
  4         25404  
  4         85  
8 4     4   7122 use Getopt::Std;
  4         197  
  4         1875  
9              
10             our $VERSION = 0.02;
11              
12             # Constructor.
13             sub new {
14 5     5 1 4907 my ($class, @params) = @_;
15              
16             # Create object.
17 5         11 my $self = bless {}, $class;
18              
19             # Object.
20 5         20 return $self;
21             }
22              
23             # Run.
24             sub run {
25 4     4 1 5 my $self = shift;
26              
27             # Process arguments.
28 4         17 $self->{'_opts'} = {
29             'h' => 0,
30             'p' => '',
31             'u' => '',
32             'v' => undef,
33             };
34 4 100 100     10 if (! getopts('hp:u:v:', $self->{'_opts'})
      100        
35             || $self->{'_opts'}->{'h'}
36             || @ARGV < 2) {
37              
38 3         287 print STDERR "Usage: $0 [-h] [-p password] [-u user] [-v schema_version] ".
39             "[--version] dsn schema_module\n";
40 3         35 print STDERR "\t-h\t\t\tPrint help.\n";
41 3         26 print STDERR "\t-p password\t\tDatabase password.\n";
42 3         26 print STDERR "\t-u user\t\t\tDatabase user.\n";
43 3         26 print STDERR "\t-v schema_version\tSchema version (default is ".
44             "latest version).\n";
45 3         26 print STDERR "\t--version\t\tPrint version.\n";
46 3         26 print STDERR "\tdsn\t\t\tDatabase DSN. e.g. dbi:SQLite:dbname=ex1.db\n";
47 3         26 print STDERR "\tschema_module\t\tName of Schema module.\n";
48 3         12 return 1;
49             }
50 1         25 $self->{'_dsn'} = shift @ARGV;
51 1         10 $self->{'_schema_module'} = shift @ARGV;
52              
53 1         52 eval "require $self->{'_schema_module'}";
54 1 50       7 if ($EVAL_ERROR) {
55             err 'Cannot load Schema module.',
56 1         6 'Module name', $self->{'_schema_module'},
57             'Error', $EVAL_ERROR,
58             ;
59             }
60              
61 0           my $schema_module;
62             my $schema_version;
63 0 0         if ($self->{'_schema_module'}->can('new')) {
64             my $versioned_schema = $self->{'_schema_module'}->new(
65             $self->{'_opts'}->{'v'} ? (
66 0 0         'version' => $self->{'_opts'}->{'v'},
67             ) : (),
68             );
69 0           $schema_module = $versioned_schema->schema;
70 0           $schema_version = $versioned_schema->version;
71              
72             } else {
73 0           $schema_module = $self->{'_schema_module'};
74             }
75              
76 0           my $schema = eval {
77             $schema_module->connect($self->{'_dsn'},
78 0           $self->{'_opts'}->{'u'}, $self->{'_opts'}->{'p'}, {});
79             };
80 0 0         if ($EVAL_ERROR) {
81 0           err 'Cannot connect to Schema database.',
82             'Error', $EVAL_ERROR,
83             ;
84             }
85 0 0         if (! $schema->isa('DBIx::Class::Schema')) {
86 0           err "Instance of schema must be a 'DBIx::Class::Schema' object.",
87             'Reference', $schema->isa,
88             ;
89             }
90              
91             # Deploy.
92 0           $schema->deploy;
93              
94 0           my $print_version = '';
95 0 0         if (defined $schema_version) {
96 0           $print_version = '(v'.$schema_version.') ';
97             }
98 0           print "Schema ${print_version}from '$self->{'_schema_module'}' was ".
99             "deployed to '$self->{'_dsn'}'.\n";
100              
101 0           return 0;
102             }
103              
104             1;
105              
106              
107             __END__