File Coverage

blib/lib/Mojo/MySQL5/Migrations.pm
Criterion Covered Total %
statement 18 93 19.3
branch 0 42 0.0
condition 1 59 1.6
subroutine 6 13 46.1
pod 6 6 100.0
total 31 213 14.5


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