run arbitrary perl in upgrade/downgrade/schema
[dbsrgits/DBIx-Class-DeploymentHandler.git] / lib / DBIx / Class / DeploymentHandler / VersionHandler / ExplicitVersions.pm
1 package DBIx::Class::DeploymentHandler::VersionHandler::ExplicitVersions;
2 use Moose;
3 use Carp 'croak';
4
5 with 'DBIx::Class::DeploymentHandler::HandlesVersioning';
6
7 has schema_version => (
8   isa      => 'Str',
9   is       => 'ro',
10   required => 1,
11 );
12
13 has database_version => (
14   isa      => 'Str',
15   is       => 'ro',
16   required => 1,
17 );
18
19 has to_version => (
20   is         => 'ro',
21   lazy_build => 1,
22 );
23
24 sub _build_to_version { $_[0]->schema_version }
25
26 has ordered_versions => (
27   is       => 'ro',
28   isa      => 'ArrayRef',
29   required => 1,
30   trigger  => sub {
31     my $to_version = $_[0]->to_version;
32     my $db_version = $_[0]->database_version;
33
34     croak 'to_version not in ordered_versions'
35       unless grep { $to_version eq $_ } @{ $_[1] };
36
37     croak 'database_version not in ordered_versions'
38       unless grep { $db_version eq $_ } @{ $_[1] };
39
40     for (@{ $_[1] }) {
41       return if $_ eq $db_version;
42       croak 'to_version is before database version in ordered_versions'
43         if $_ eq $to_version;
44     }
45   },
46 );
47
48 has _version_idx => (
49   is         => 'rw',
50   isa        => 'Int',
51   lazy_build => 1,
52 );
53
54 sub _inc_version_idx { $_[0]->_version_idx($_[0]->_version_idx + 1 ) }
55 sub _dec_version_idx { $_[0]->_version_idx($_[0]->_version_idx - 1 ) }
56
57 sub _build__version_idx {
58   my $self = shift;
59   my $start = $self->database_version;
60   my $idx = 0;
61   for (@{$self->ordered_versions}) {
62     return $idx
63       if $_ eq $self->database_version;
64     $idx++;
65   }
66 }
67
68 sub next_version_set {
69   my $self = shift;
70   return undef
71     if $self->ordered_versions->[$self->_version_idx] eq $self->to_version;
72
73   # this should never get in infinite loops because we ensure
74   # that the database version is in the list in the version_idx
75   # builder
76   my $next_idx = $self->_inc_version_idx;
77   return [
78     $self->ordered_versions->[$next_idx - 1],
79     $self->ordered_versions->[$next_idx    ],
80   ];
81 }
82
83 sub previous_version_set {
84   my $self = shift;
85   return undef
86     if $self->ordered_versions->[$self->_version_idx] eq $self->database_version;
87
88   # this should never get in infinite loops because we ensure
89   # that the database version is in the list in the version_idx
90   # builder
91   my $next_idx = $self->_dec_version_idx;
92   return [
93     $self->ordered_versions->[$next_idx - 1],
94     $self->ordered_versions->[$next_idx    ],
95   ];
96 }
97
98 __PACKAGE__->meta->make_immutable;
99
100 1;
101
102 __END__
103
104 vim: ts=2 sw=2 expandtab