| line | stmt | bran | cond | sub | pod | time | code | 
| 1 |  |  |  |  |  |  | package App::Schema::Deploy; | 
| 2 |  |  |  |  |  |  |  | 
| 3 | 4 |  |  | 4 |  | 64009 | use strict; | 
|  | 4 |  |  |  |  | 20 |  | 
|  | 4 |  |  |  |  | 94 |  | 
| 4 | 4 |  |  | 4 |  | 16 | use warnings; | 
|  | 4 |  |  |  |  | 7 |  | 
|  | 4 |  |  |  |  | 78 |  | 
| 5 |  |  |  |  |  |  |  | 
| 6 | 4 |  |  | 4 |  | 1772 | use English; | 
|  | 4 |  |  |  |  | 13260 |  | 
|  | 4 |  |  |  |  | 22 |  | 
| 7 | 4 |  |  | 4 |  | 3101 | use Error::Pure qw(err); | 
|  | 4 |  |  |  |  | 25310 |  | 
|  | 4 |  |  |  |  | 97 |  | 
| 8 | 4 |  |  | 4 |  | 7188 | use Getopt::Std; | 
|  | 4 |  |  |  |  | 203 |  | 
|  | 4 |  |  |  |  | 1871 |  | 
| 9 |  |  |  |  |  |  |  | 
| 10 |  |  |  |  |  |  | our $VERSION = 0.01; | 
| 11 |  |  |  |  |  |  |  | 
| 12 |  |  |  |  |  |  | # Constructor. | 
| 13 |  |  |  |  |  |  | sub new { | 
| 14 | 5 |  |  | 5 | 1 | 4915 | my ($class, @params) = @_; | 
| 15 |  |  |  |  |  |  |  | 
| 16 |  |  |  |  |  |  | # Create object. | 
| 17 | 5 |  |  |  |  | 12 | my $self = bless {}, $class; | 
| 18 |  |  |  |  |  |  |  | 
| 19 |  |  |  |  |  |  | # Object. | 
| 20 | 5 |  |  |  |  | 18 | return $self; | 
| 21 |  |  |  |  |  |  | } | 
| 22 |  |  |  |  |  |  |  | 
| 23 |  |  |  |  |  |  | # Run. | 
| 24 |  |  |  |  |  |  | sub run { | 
| 25 | 4 |  |  | 4 | 1 | 7 | my $self = shift; | 
| 26 |  |  |  |  |  |  |  | 
| 27 |  |  |  |  |  |  | # Process arguments. | 
| 28 | 4 |  |  |  |  | 18 | $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 |  |  |  |  | 308 | print STDERR "Usage: $0 [-h] [-p password] [-u user] [-v schema_version] ". | 
| 39 |  |  |  |  |  |  | "[--version] dsn schema_module\n"; | 
| 40 | 3 |  |  |  |  | 32 | print STDERR "\t-h\t\t\tPrint help.\n"; | 
| 41 | 3 |  |  |  |  | 27 | 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 |  |  |  |  | 24 | print STDERR "\t--version\t\tPrint version.\n"; | 
| 46 | 3 |  |  |  |  | 25 | print STDERR "\tdsn\t\t\tDatabase DSN. e.g. dbi:SQLite:dbname=ex1.db\n"; | 
| 47 | 3 |  |  |  |  | 25 | print STDERR "\tschema_module\t\tName of Schema module.\n"; | 
| 48 | 3 |  |  |  |  | 13 | return 1; | 
| 49 |  |  |  |  |  |  | } | 
| 50 | 1 |  |  |  |  | 24 | $self->{'_dsn'} = shift @ARGV; | 
| 51 | 1 |  |  |  |  | 9 | $self->{'_schema_module'} = shift @ARGV; | 
| 52 |  |  |  |  |  |  |  | 
| 53 | 1 |  |  |  |  | 55 | 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__ |