File Coverage

blib/lib/DBIx/Schema/Migration.pm
Criterion Covered Total %
statement 123 140 87.8
branch 24 40 60.0
condition 2 21 9.5
subroutine 22 23 95.6
pod 2 3 66.6
total 173 227 76.2


line stmt bran cond sub pod time code
1             package DBIx::Schema::Migration;
2              
3 1     1   16888 use 5.24.0;
  1         3  
4              
5 1     1   5 use strict;
  1         2  
  1         17  
6 1     1   4 use warnings;
  1         1  
  1         22  
7              
8 1     1   4 use feature 'say';
  1         2  
  1         133  
9 1     1   503 use English;
  1         4534  
  1         5  
10 1     1   348 use Exporter 'import';
  1         1  
  1         23  
11              
12 1     1   491 use Moo;
  1         10656  
  1         5  
13 1     1   1867 use Term::ANSIColor 'colored';
  1         6767  
  1         588  
14 1     1   438 use File::Slurper 'read_text';
  1         11616  
  1         51  
15 1     1   8 use File::Basename;
  1         2  
  1         96  
16 1     1   6 use Scalar::Util 'blessed';
  1         2  
  1         75  
17              
18             use constant {
19 1         1688 UP => 'up',
20             DOWN => 'down',
21 1     1   6 };
  1         2  
22              
23             our $VERSION = '1.00';
24              
25             has dbh => (
26             is => 'ro',
27             requires => 1,
28             isa => sub {
29             if ( not blessed $_[0]
30             and not $_[0]->isa('DBI::db') )
31             {
32             say colored( "$_[0] is not DBI::db", 'red' );
33             exit;
34             }
35             },
36             );
37              
38             has dir => (
39             is => 'ro',
40             required => 1,
41             );
42              
43             sub init {
44 1     1 0 17 my ($self) = @_;
45              
46 1         55 my @sql = ;
47 1         24 my $sql = join '', @sql;
48              
49 1 50       6 if ( $self->_is_applied_migrations_table_exists() ) {
50 0         0 say colored( 'Table applied_migrations already exists', 'yellow' );
51 0         0 return 1;
52             }
53              
54             else {
55 1 50 0     7 $self->dbh->do($sql)
56             or say colored( $self->dbh->errstr, 'red' )
57             and exit;
58              
59 1         248 say colored(
60             'Table applied_migrations successfully created',
61             'green'
62             );
63              
64 1         104 return 1;
65             }
66             }
67              
68             sub up {
69 1     1 1 770 my ( $self, $num ) = @_;
70              
71 1 50       4 if ( not $self->_is_applied_migrations_table_exists() ) {
72 0         0 say $self->_applied_migrations_not_exist_phrase();
73 0         0 exit;
74             }
75              
76 1         9 $self->dbh->{AutoCommit} = 0;
77              
78 1         5 my $dir = $self->_detect_dir;
79 1         5 my @dirs = sort $self->_dir_listing($dir);
80              
81 1   33     7 $num = $num || @dirs;
82 1         2 my $completed = 0;
83              
84 1         3 for (@dirs) {
85 2 50       10 if ( not $num ) {
    50          
86 0         0 last;
87             }
88              
89             elsif ( not $self->_is_migration_applied($_) ) {
90 2         8 $self->_run_migration( $dir, $_, UP );
91 2         3 $completed++;
92 2         5 $num--;
93             }
94             }
95              
96 1         15 my $rows = $self->dbh->commit;
97              
98 1 50       4 if ( $rows < 0 ) {
99 0 0       0 say colored( 'Could not run migrations', 'red' ) and exit;
100             }
101              
102 1         7 $self->dbh->{AutoCommit} = 1;
103              
104 1         6 say colored( "Migration up:$completed", 'green' );
105              
106 1         66 return 1;
107             }
108              
109             sub down {
110 2     2 1 990 my ( $self, $num ) = @_;
111              
112 2 50       5 if ( not $self->_is_applied_migrations_table_exists() ) {
113 0         0 say $self->_applied_migrations_not_exist_phrase();
114 0         0 exit;
115             }
116              
117 2         15 $self->dbh->{AutoCommit} = 0;
118              
119 2         6 my $dir = $self->_detect_dir;
120 2         7 my @dirs = sort { $b cmp $a } $self->_dir_listing($dir);
  2         7  
121              
122 2   33     7 $num = $num || @dirs;
123 2         4 my $completed = 0;
124              
125 2         5 for (@dirs) {
126 4 100       12 if ( not $num ) {
    100          
127 1         2 last;
128             }
129              
130             elsif ( $self->_is_migration_applied($_) ) {
131 2         7 $self->_run_migration( $dir, $_, DOWN );
132 2         2 $completed++;
133 2         4 $num--;
134             }
135             }
136              
137 2         22 my $rows = $self->dbh->commit;
138 2 50       7 if ( $rows < 0 ) {
139 0         0 say colored( 'Could not rollback migrations', 'red' );
140 0         0 exit;
141             }
142              
143 2         12 $self->dbh->{AutoCommit} = 1;
144              
145 2         11 say colored( "Migration down:$completed", 'green' );
146              
147 2         130 return 1;
148             }
149              
150             sub _is_applied_migrations_table_exists {
151 4     4   18 my ($self) = @_;
152              
153 4         38 my $sth =
154             $self->dbh->table_info( '%', '%', 'applied_migrations', 'TABLE' );
155 4         1574 my @row = $sth->fetchrow_array;
156              
157 4         16 $sth->finish;
158              
159 4 100       61 return @row ? 1 : 0;
160             }
161              
162             sub _applied_migrations_not_exist_phrase {
163 0     0   0 return colored(
164             'Table applied_migrations does not exists. You should run init first',
165             'red'
166             );
167             }
168              
169             sub _detect_dir {
170 3     3   7 my ($self) = @_;
171              
172             my @dirs = (
173             $self->dir,
174             $ENV{PWD} . $self->dir,
175             $ENV{PWD} . '/' . $self->dir,
176 3         126 $ENV{PWD} . '/' . dirname($PROGRAM_NAME) . '/' . $self->dir,
177             );
178              
179 3         10 for (@dirs) {
180 12 100       164 if ( -d $_ ) {
181 3         15 return $_;
182             }
183             }
184              
185 0         0 say colored(
186             "Dir $self->{dir} does not exists, try to specify full path",
187             'red'
188             );
189 0         0 exit;
190             }
191              
192             sub _dir_listing {
193 3     3   5 my ( $self, $dir ) = @_;
194              
195 3 50 0     102 opendir my $dh, $dir
196             or say colored( "Couldn't open dir '$dir': $ERRNO", 'red' )
197             and exit;
198 3         68 my @dirs = readdir $dh;
199 3         34 closedir $dh;
200              
201 3         8 return grep { !/^\.|\.{2}$/m } @dirs;
  12         63  
202             }
203              
204             sub _is_migration_applied {
205 5     5   10 my ( $self, $migration ) = @_;
206              
207 5         7 my $sql = 'SELECT migration FROM applied_migrations WHERE migration = ?';
208 5 50 0     32 my $sth = $self->dbh->prepare($sql)
209             or say colored( $self->dbh->errstr, 'red' )
210             and exit;
211 5         340 my $rv = $sth->execute($migration);
212 5         26 my @row = $sth->fetchrow_array;
213              
214 5         23 $sth->finish;
215              
216 5 50       21 if ( $rv < 0 ) {
217 0         0 say colored( $sth->errstr );
218 0         0 exit;
219             }
220              
221 5         62 return @row;
222             }
223              
224             sub _run_migration {
225 4     4   9 my ( $self, $dir, $migration, $type ) = @_;
226              
227 4         10 my $filename = "${migration}_$type.sql";
228 4         17 my $sql = read_text "$dir/$migration/$filename";
229 4         410 my $rows = $self->dbh->do($sql);
230              
231 4 50       642 if ( $rows < 0 ) {
232 0         0 say colored( $self->db->errstr, 'red' );
233 0         0 exit;
234             }
235              
236 4 100       12 if ( $type eq UP ) {
237 2         7 $self->_save_migration($migration);
238             }
239             else {
240 2         7 $self->_delete_migration($migration);
241             }
242              
243 4         9 return 1;
244             }
245              
246             sub _save_migration {
247 2     2   5 my ( $self, $migration ) = @_;
248              
249 2         4 my $sql = 'INSERT INTO applied_migrations VALUES(?)';
250 2 50 0     14 my $sth = $self->dbh->prepare($sql)
251             or say colored( $self->dbh->errstr, 'red' )
252             and exit;
253 2         126 my $rv = $sth->execute($migration);
254              
255 2         9 $sth->finish;
256              
257 2         17 return $rv ne '0E0';
258             }
259              
260             sub _delete_migration {
261 2     2   5 my ( $self, $migration ) = @_;
262              
263 2         3 my $sql = 'DELETE FROM applied_migrations WHERE migration = ?';
264 2 50 0     11 my $sth = $self->dbh->prepare($sql)
265             or say colored( $self->dbh->errstr, 'red' )
266             and exit;
267 2         121 my $rv = $sth->execute($migration);
268              
269 2         8 $sth->finish;
270              
271 2         15 return $rv ne '0E0';
272             }
273              
274             1;
275              
276             __DATA__