File Coverage

blib/lib/Mojo/mysql/Migrations.pm
Criterion Covered Total %
statement 18 94 19.1
branch 0 44 0.0
condition 1 59 1.6
subroutine 6 13 46.1
pod 6 6 100.0
total 31 216 14.3


line stmt bran cond sub pod time code
1             package Mojo::mysql::Migrations;
2 18     18   112 use Mojo::Base -base;
  18         29  
  18         106  
3              
4 18     18   2830 use Carp 'croak';
  18         37  
  18         834  
5 18     18   105 use Mojo::File;
  18         31  
  18         687  
6 18     18   94 use Mojo::Loader 'data_section';
  18         29  
  18         801  
7 18     18   95 use Mojo::Util 'decode';
  18         45  
  18         975  
8              
9 18   50 18   105 use constant DEBUG => $ENV{MOJO_MIGRATIONS_DEBUG} || 0;
  18         39  
  18         28474  
10              
11             has name => 'migrations';
12             has 'mysql';
13              
14 0     0 1   sub active { $_[0]->_active($_[0]->mysql->db) }
15              
16             sub from_data {
17 0     0 1   my ($self, $class, $name) = @_;
18 0   0       return $self->from_string(data_section($class //= caller, $name // $self->name));
      0        
19             }
20              
21 0     0 1   sub from_file { shift->from_string(decode 'UTF-8', Mojo::File->new(pop)->slurp) }
22              
23             sub from_string {
24 0     0 1   my ($self, $sql) = @_;
25 0 0         return $self unless defined $sql;
26 0           my ($version, $way);
27 0           my ($new, $last, $delimiter) = (1, '', ';');
28 0           my $migrations = $self->{migrations} = {up => {}, down => {}};
29              
30 0           while (length($sql) > 0) {
31 0           my $token;
32              
33 0 0 0       if ($sql =~ /^$delimiter/x) {
    0 0        
    0 0        
    0 0        
      0        
      0        
34 0           ($new, $token) = (1, $delimiter);
35             }
36             elsif ($sql =~ /^delimiter\s+(\S+)\s*(?:\n|\z)/ip) {
37 0           ($new, $token, $delimiter) = (1, ${^MATCH}, $1);
38             }
39             elsif (
40             $sql =~ /^(\s+)/s # whitespace
41             or $sql =~ /^(\w+)/ # general name
42             )
43             {
44 0           $token = $1;
45             }
46             elsif (
47             $sql =~ /^--.*(?:\n|\z)/p # double-dash comment
48             or $sql =~ /^\#.*(?:\n|\z)/p # hash comment
49             or $sql =~ /^\/\*(?:[^\*]|\*[^\/])*(?:\*\/|\*\z|\z)/p # C-style comment
50             or $sql =~ /^'(?:[^'\\]*|\\(?:.|\n)|'')*(?:'|\z)/p # single-quoted literal text
51             or $sql =~ /^"(?:[^"\\]*|\\(?:.|\n)|"")*(?:"|\z)/p # double-quoted literal text
52             or $sql =~ /^`(?:[^`]*|``)*(?:`|\z)/p
53             )
54             { # schema-quoted literal text
55 0           $token = ${^MATCH};
56             }
57             else {
58 0           $token = substr($sql, 0, 1);
59             }
60              
61             # chew token
62 0           substr($sql, 0, length($token), '');
63              
64 0 0         if ($token =~ /^--\s+(\d+)\s*(up|down)/i) {
65 0           my ($new_version, $new_way) = ($1, lc $2);
66 0 0 0       push @{$migrations->{$way}{$version} //= []}, $last if $version and $last !~ /^\s*$/s;
  0   0        
67 0           ($version, $way) = ($new_version, $new_way);
68 0           ($new, $last, $delimiter) = (0, '', ';');
69             }
70              
71 0 0         if ($new) {
72 0 0 0       push @{$migrations->{$way}{$version} //= []}, $last if $version and $last !~ /^\s*$/s;
  0   0        
73 0           ($new, $last) = (0, '');
74             }
75             else {
76 0           $last .= $token;
77             }
78             }
79 0 0 0       push @{$migrations->{$way}{$version} //= []}, $last if $version and $last !~ /^\s*$/s;
  0   0        
80              
81 0           return $self;
82             }
83              
84             sub latest {
85 0 0   0 1   (sort { $a <=> $b } keys %{shift->{migrations}{up}})[-1] || 0;
  0            
  0            
86             }
87              
88             sub migrate {
89 0     0 1   my ($self, $target) = @_;
90 0           my $latest = $self->latest;
91 0   0       $target //= $latest;
92              
93             # Unknown version
94 0           my ($up, $down) = @{$self->{migrations}}{qw(up down)};
  0            
95 0 0 0       croak "Version $target has no migration" if $target != 0 && !$up->{$target};
96              
97             # Already the right version (make sure migrations table exists)
98 0           my $db = $self->mysql->db;
99 0 0         return $self if $self->_active($db, 1) == $target;
100              
101             # Check version again
102 0           my $tx = $db->begin;
103 0 0         return $self if (my $active = $self->_active($db, 1)) == $target;
104              
105             # Newer version
106 0 0         croak "Active version $active is greater than the latest version $latest" if $active > $latest;
107              
108             # Up
109 0           my @sql;
110 0 0         if ($active < $target) {
111 0           foreach (sort { $a <=> $b } keys %$up) {
  0            
112 0 0 0       push @sql, @{$up->{$_}} if $_ <= $target && $_ > $active;
  0            
113             }
114             }
115              
116             # Down
117             else {
118 0           foreach (reverse sort { $a <=> $b } keys %$down) {
  0            
119 0 0 0       push @sql, @{$down->{$_}} if $_ > $target && $_ <= $active;
  0            
120             }
121             }
122              
123 0           warn "-- Migrate ($active -> $target)\n", join("\n", @sql), "\n" if DEBUG;
124 0           eval {
125 0           $db->query($_) for @sql;
126 0           $db->query("update mojo_migrations set version = ? where name = ?", $target, $self->name);
127             };
128 0 0         if (my $error = $@) {
129 0           undef $tx;
130 0           die $error;
131             }
132 0           $tx->commit;
133 0           return $self;
134             }
135              
136             sub _active {
137 0     0     my ($self, $db, $create) = @_;
138              
139 0           my $name = $self->name;
140 0           my $results = eval { $db->query('select version from mojo_migrations where name = ?', $name) };
  0            
141 0           my $error = $@;
142 0 0 0       return 0 if !$create and !$results;
143 0 0 0       if ($results and my $next = $results->array) { return $next->[0] }
  0            
144              
145             $db->query(
146 0 0         'create table if not exists mojo_migrations (
147             name varchar(128) unique not null,
148             version bigint not null
149             )'
150             ) if $error;
151 0           $db->query('insert into mojo_migrations values (?, ?)', $name, 0);
152              
153 0           return 0;
154             }
155              
156             1;
157              
158             =encoding utf8
159              
160             =head1 NAME
161              
162             Mojo::mysql::Migrations - Migrations
163              
164             =head1 SYNOPSIS
165              
166             use Mojo::mysql::Migrations;
167              
168             my $migrations = Mojo::mysql::Migrations->new(mysql => $mysql);
169             $migrations->from_file('/home/sri/migrations.sql')->migrate;
170              
171             =head1 DESCRIPTION
172              
173             L is used by L to allow database schemas to
174             evolve easily over time. A migration file is just a collection of sql blocks,
175             with one or more statements, separated by comments of the form
176             C<-- VERSION UP/DOWN>.
177              
178             -- 1 up
179             create table messages (message text);
180             insert into messages values ('I ♥ Mojolicious!');
181             delimiter //
182             create procedure mojo_test()
183             begin
184             select text from messages;
185             end
186             //
187             -- 1 down
188             drop table messages;
189             drop procedure mojo_test;
190              
191             -- 2 up (...you can comment freely here...)
192             create table stuff (whatever int);
193             -- 2 down
194             drop table stuff;
195              
196             The idea is to let you migrate from any version, to any version, up and down.
197             Migrations are very safe, because they are performed in transactions and only
198             one can be performed at a time. If a single statement fails, the whole
199             migration will fail and get rolled back. Every set of migrations has a
200             L, which is stored together with the currently active version in an
201             automatically created table named C.
202              
203             =head1 ATTRIBUTES
204              
205             L implements the following attributes.
206              
207             =head2 name
208              
209             my $name = $migrations->name;
210             $migrations = $migrations->name('foo');
211              
212             Name for this set of migrations, defaults to C.
213              
214             =head2 mysql
215              
216             my $mysql = $migrations->mysql;
217             $migrations = $migrations->mysql(Mojo::mysql->new);
218              
219             L object these migrations belong to.
220              
221             =head1 METHODS
222              
223             L inherits all methods from L and implements
224             the following new ones.
225              
226             =head2 active
227              
228             my $version = $migrations->active;
229              
230             Currently active version.
231              
232             =head2 from_data
233              
234             $migrations = $migrations->from_data;
235             $migrations = $migrations->from_data('main');
236             $migrations = $migrations->from_data('main', 'file_name');
237              
238             Extract migrations from a file in the DATA section of a class with
239             L, defaults to using the caller class and
240             L.
241              
242             __DATA__
243             @@ migrations
244             -- 1 up
245             create table messages (message text);
246             insert into messages values ('I ♥ Mojolicious!');
247             -- 1 down
248             drop table messages;
249              
250             =head2 from_file
251              
252             $migrations = $migrations->from_file('/home/sri/migrations.sql');
253              
254             Extract migrations from a file.
255              
256             =head2 from_string
257              
258             $migrations = $migrations->from_string(
259             '-- 1 up
260             create table foo (bar int);
261             -- 1 down
262             drop table foo;'
263             );
264              
265             Extract migrations from string.
266              
267             =head2 latest
268              
269             my $version = $migrations->latest;
270              
271             Latest version available.
272              
273             =head2 migrate
274              
275             $migrations = $migrations->migrate;
276             $migrations = $migrations->migrate(3);
277              
278             Migrate from L to a different version, up or down, defaults to
279             using L. All version numbers need to be positive, with version C<0>
280             representing an empty database.
281              
282             # Reset database
283             $migrations->migrate(0)->migrate;
284              
285             =head1 DEBUGGING
286              
287             You can set the C environment variable to get some
288             advanced diagnostics information printed to C.
289              
290             MOJO_MIGRATIONS_DEBUG=1
291              
292             =head1 SEE ALSO
293              
294             L, L, L.
295              
296             =cut