line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package SQL::Schema::Versioned; |
2
|
|
|
|
|
|
|
|
3
|
|
|
|
|
|
|
our $DATE = '2019-01-13'; # DATE |
4
|
|
|
|
|
|
|
our $VERSION = '0.237'; # VERSION |
5
|
|
|
|
|
|
|
|
6
|
3
|
|
|
3
|
|
397503
|
use 5.010001; |
|
3
|
|
|
|
|
37
|
|
7
|
3
|
|
|
3
|
|
16
|
use strict; |
|
3
|
|
|
|
|
6
|
|
|
3
|
|
|
|
|
77
|
|
8
|
3
|
|
|
3
|
|
17
|
use warnings; |
|
3
|
|
|
|
|
5
|
|
|
3
|
|
|
|
|
95
|
|
9
|
3
|
|
|
3
|
|
5472
|
use Log::ger; |
|
3
|
|
|
|
|
160
|
|
|
3
|
|
|
|
|
15
|
|
10
|
|
|
|
|
|
|
|
11
|
3
|
|
|
3
|
|
722
|
use Exporter qw(import); |
|
3
|
|
|
|
|
6
|
|
|
3
|
|
|
|
|
1933
|
|
12
|
|
|
|
|
|
|
our @EXPORT_OK = qw( |
13
|
|
|
|
|
|
|
create_or_update_db_schema |
14
|
|
|
|
|
|
|
); |
15
|
|
|
|
|
|
|
|
16
|
|
|
|
|
|
|
our %SPEC; |
17
|
|
|
|
|
|
|
|
18
|
|
|
|
|
|
|
sub _sv_key { |
19
|
24
|
|
50
|
24
|
|
83
|
my $comp = $_[0] // 'main'; |
20
|
24
|
50
|
|
|
|
198
|
$comp =~ /\A\w+\z/ |
21
|
|
|
|
|
|
|
or die "Invalid component '$comp', please stick to ". |
22
|
|
|
|
|
|
|
"letters/numbers/underscores"; |
23
|
24
|
100
|
|
|
|
127
|
"schema_version" . ($comp eq 'main' ? '' : ".$comp"); |
24
|
|
|
|
|
|
|
} |
25
|
|
|
|
|
|
|
|
26
|
|
|
|
|
|
|
sub _extract_created_tables_from_sql_statements { |
27
|
18
|
|
|
18
|
|
173
|
my @sql = @_; |
28
|
|
|
|
|
|
|
|
29
|
18
|
|
|
|
|
38
|
my @res; |
30
|
18
|
|
|
|
|
53
|
for my $sql (@sql) { |
31
|
31
|
100
|
|
|
|
222
|
if ($sql =~ /\A\s* |
32
|
|
|
|
|
|
|
create\s+table(?:\s+if\s+not\s+exists)?\s+ |
33
|
|
|
|
|
|
|
(?: |
34
|
|
|
|
|
|
|
`([^`]+)` | |
35
|
|
|
|
|
|
|
"([^"]+)" | |
36
|
|
|
|
|
|
|
(\S+) |
37
|
|
|
|
|
|
|
) |
38
|
|
|
|
|
|
|
/isx) { |
39
|
29
|
|
100
|
|
|
236
|
push @res, ($1 // $2 // $3); |
|
|
|
66
|
|
|
|
|
40
|
|
|
|
|
|
|
} |
41
|
|
|
|
|
|
|
} |
42
|
18
|
|
|
|
|
81
|
@res; |
43
|
|
|
|
|
|
|
} |
44
|
|
|
|
|
|
|
|
45
|
|
|
|
|
|
|
sub _get_provides_from_db { |
46
|
12
|
|
|
12
|
|
2347
|
my ($dbh) = @_; |
47
|
|
|
|
|
|
|
|
48
|
12
|
|
|
|
|
21
|
my %provides; |
49
|
|
|
|
|
|
|
|
50
|
12
|
|
|
|
|
65
|
my $sth = $dbh->prepare( |
51
|
|
|
|
|
|
|
"SELECT name, value FROM meta WHERE name LIKE 'table.%'"); |
52
|
12
|
|
|
|
|
1564
|
$sth->execute; |
53
|
12
|
|
|
|
|
227
|
while (my @row = $sth->fetchrow_array) { |
54
|
16
|
|
|
|
|
129
|
my ($table) = $row[0] =~ /table\.(.+)/; |
55
|
16
|
50
|
|
|
|
110
|
my ($provcomp, $provver) = $row[1] =~ /\A(\w+):(\d*)\z/ |
56
|
|
|
|
|
|
|
or return [500, "Corrupt information in `meta` table: $row[0] -> $row[1]"]; |
57
|
16
|
|
|
|
|
216
|
$provides{$table} = [$provcomp, $provver]; |
58
|
|
|
|
|
|
|
} |
59
|
12
|
|
|
|
|
183
|
%provides; |
60
|
|
|
|
|
|
|
} |
61
|
|
|
|
|
|
|
|
62
|
|
|
|
|
|
|
$SPEC{create_or_update_db_schema} = { |
63
|
|
|
|
|
|
|
v => 1.1, |
64
|
|
|
|
|
|
|
summary => 'Routine and convention to create/update '. |
65
|
|
|
|
|
|
|
'your application\'s DB schema', |
66
|
|
|
|
|
|
|
description => <<'_', |
67
|
|
|
|
|
|
|
|
68
|
|
|
|
|
|
|
With this routine (and some convention) you can easily create and update |
69
|
|
|
|
|
|
|
database schema for your application in a simple way using pure SQL. |
70
|
|
|
|
|
|
|
|
71
|
|
|
|
|
|
|
*Version*: version is an integer and starts from 1. Each software release with |
72
|
|
|
|
|
|
|
schema change will bump the version number by 1. Version information is stored |
73
|
|
|
|
|
|
|
in a special table called `meta` (SELECT value FROM meta WHERE |
74
|
|
|
|
|
|
|
name='schema_version'). |
75
|
|
|
|
|
|
|
|
76
|
|
|
|
|
|
|
You supply the SQL statements in `spec`. `spec` is a hash which at least must |
77
|
|
|
|
|
|
|
contain the key `latest_v` (an integer) and `install` (a series of SQL |
78
|
|
|
|
|
|
|
statements to create the schema from nothing to the latest version). |
79
|
|
|
|
|
|
|
|
80
|
|
|
|
|
|
|
There should also be zero or more `upgrade_to_v$VERSION` keys, the value of each |
81
|
|
|
|
|
|
|
is a series of SQL statements to upgrade from ($VERSION-1) to $VERSION. So there |
82
|
|
|
|
|
|
|
could be `upgrade_to_v2`, `upgrade_to_v3`, and so on up the latest version. This |
83
|
|
|
|
|
|
|
is used to upgrade an existing database from earlier version to the latest. |
84
|
|
|
|
|
|
|
|
85
|
|
|
|
|
|
|
For testing purposes, you can also add one or more `install_v<VERSION>` key, |
86
|
|
|
|
|
|
|
where `XXX` is an integer, the lowest version number that you still want to |
87
|
|
|
|
|
|
|
support. So, for example, if `latest_v` is 5 and you still want to support from |
88
|
|
|
|
|
|
|
version 2, you can have an `install_v2` key containing a series of SQL |
89
|
|
|
|
|
|
|
statements to create the schema at version 2, and `upgrade_to_v3`, |
90
|
|
|
|
|
|
|
`upgrade_to_v4`, `upgrade_to_v5` keys. This way migrations from v2 to v3, v3 to |
91
|
|
|
|
|
|
|
v4, and v4 to v5 can be tested. |
92
|
|
|
|
|
|
|
|
93
|
|
|
|
|
|
|
You can name `install_v1` key as `upgrade_to_v1` (to upgrade from 'nothing' |
94
|
|
|
|
|
|
|
a.k.a. v0 to v1), which is basically the same thing. |
95
|
|
|
|
|
|
|
|
96
|
|
|
|
|
|
|
This routine will check the existence of the `meta` table and the current schema |
97
|
|
|
|
|
|
|
version. If `meta` table does not exist yet, the SQL statements in `install` |
98
|
|
|
|
|
|
|
will be executed. The `meta` table will also be created and a row |
99
|
|
|
|
|
|
|
`('schema_version', 1)` is added. The (`schema_summary`, <SUMMARY>) row will |
100
|
|
|
|
|
|
|
also be added if your spec specifies a `summary`. |
101
|
|
|
|
|
|
|
|
102
|
|
|
|
|
|
|
If `meta` table already exists, schema version will be read from it and one or |
103
|
|
|
|
|
|
|
more series of SQL statements from `upgrade_to_v$VERSION` will be executed to |
104
|
|
|
|
|
|
|
bring the schema to the latest version. |
105
|
|
|
|
|
|
|
|
106
|
|
|
|
|
|
|
Aside from SQL statement, the series can also contain coderefs for more complex |
107
|
|
|
|
|
|
|
upgrade process. Each coderef will be called with `$dbh` as argument and must |
108
|
|
|
|
|
|
|
not die (so to signify failure, you can die from inside the coderef). |
109
|
|
|
|
|
|
|
|
110
|
|
|
|
|
|
|
Currently only tested on MySQL, Postgres, and SQLite. Postgres is recommended |
111
|
|
|
|
|
|
|
because it can do transactional DDL (a failed upgrade in the middle will not |
112
|
|
|
|
|
|
|
cause the database schema state to be inconsistent, e.g. in-between two |
113
|
|
|
|
|
|
|
versions). |
114
|
|
|
|
|
|
|
|
115
|
|
|
|
|
|
|
### Modular schema (components) |
116
|
|
|
|
|
|
|
|
117
|
|
|
|
|
|
|
This routine supports so-called modular schema, where you can separate your |
118
|
|
|
|
|
|
|
database schema into several *components* (sets of tables) and then declare |
119
|
|
|
|
|
|
|
dependencies among them. |
120
|
|
|
|
|
|
|
|
121
|
|
|
|
|
|
|
For example, say you are writing a stock management application. You divide your |
122
|
|
|
|
|
|
|
application into several components: `quote` (component that deals with |
123
|
|
|
|
|
|
|
importing stock quotes and querying stock prices), `portfolio` (component that |
124
|
|
|
|
|
|
|
deals with computing the market value of your portfolio, calculating |
125
|
|
|
|
|
|
|
gains/losses), `trade` (component that connects to your broker API and perform |
126
|
|
|
|
|
|
|
trading by submitting buy/sell orders). |
127
|
|
|
|
|
|
|
|
128
|
|
|
|
|
|
|
The `quote` application component manages these tables: `daily_price`, |
129
|
|
|
|
|
|
|
`spot_price`. The `portfolio` application component manages these tables: |
130
|
|
|
|
|
|
|
`account` (list of accounts in stock brokerages), `balance` (list of balances), |
131
|
|
|
|
|
|
|
`tx` (list of transactions). The `trade` application component manages these |
132
|
|
|
|
|
|
|
tables: `order` (list of buy/sell orders). |
133
|
|
|
|
|
|
|
|
134
|
|
|
|
|
|
|
The `portfolio` application component requires price information to be able to |
135
|
|
|
|
|
|
|
calculate unrealized gains/losses. The `trade` component also needs information |
136
|
|
|
|
|
|
|
from the `daily_price` e.g. to calculate 52-week momentum, and writes to the |
137
|
|
|
|
|
|
|
`spot_price` to record intraday prices, and reads/writes from the `account` and |
138
|
|
|
|
|
|
|
`balance` tables. Here are the `spec`s for each component: |
139
|
|
|
|
|
|
|
|
140
|
|
|
|
|
|
|
# spec for the price application component |
141
|
|
|
|
|
|
|
{ |
142
|
|
|
|
|
|
|
component_name => 'price', |
143
|
|
|
|
|
|
|
summary => "Price application component", |
144
|
|
|
|
|
|
|
latest_v => 1, |
145
|
|
|
|
|
|
|
provides => ['daily_price', 'spot_price'], |
146
|
|
|
|
|
|
|
install => [...], |
147
|
|
|
|
|
|
|
... |
148
|
|
|
|
|
|
|
} |
149
|
|
|
|
|
|
|
|
150
|
|
|
|
|
|
|
# spec for the portfolio application component |
151
|
|
|
|
|
|
|
{ |
152
|
|
|
|
|
|
|
component_name => 'portfolio', |
153
|
|
|
|
|
|
|
summary => "Portfolio application component", |
154
|
|
|
|
|
|
|
latest_v => 1, |
155
|
|
|
|
|
|
|
provides => ['account', 'balance', 'tx'], |
156
|
|
|
|
|
|
|
deps => { |
157
|
|
|
|
|
|
|
'daily_price' => 1, |
158
|
|
|
|
|
|
|
'spot_price' => 1, |
159
|
|
|
|
|
|
|
}, |
160
|
|
|
|
|
|
|
install => [...], |
161
|
|
|
|
|
|
|
... |
162
|
|
|
|
|
|
|
} |
163
|
|
|
|
|
|
|
|
164
|
|
|
|
|
|
|
# spec for the trade application component |
165
|
|
|
|
|
|
|
{ |
166
|
|
|
|
|
|
|
component_name => 'trade', |
167
|
|
|
|
|
|
|
summary => "Trade application component", |
168
|
|
|
|
|
|
|
latest_v => 1, |
169
|
|
|
|
|
|
|
provides => ['order'], |
170
|
|
|
|
|
|
|
deps => { |
171
|
|
|
|
|
|
|
'daily_price' => 1, |
172
|
|
|
|
|
|
|
'spot_price' => 1, |
173
|
|
|
|
|
|
|
'account' => 1, |
174
|
|
|
|
|
|
|
'balance' => 1, |
175
|
|
|
|
|
|
|
}, |
176
|
|
|
|
|
|
|
install => [...], |
177
|
|
|
|
|
|
|
... |
178
|
|
|
|
|
|
|
} |
179
|
|
|
|
|
|
|
|
180
|
|
|
|
|
|
|
You'll notice that the three keys new here are the `component_name`, `provides`, |
181
|
|
|
|
|
|
|
and `deps`. |
182
|
|
|
|
|
|
|
|
183
|
|
|
|
|
|
|
When `component_name` is set, then instead of the `schema_version` key in the |
184
|
|
|
|
|
|
|
`meta` table, your component will use the `schema_version.<COMPONENT_NAME>` key. |
185
|
|
|
|
|
|
|
When `component_name` is not set, it is assumed to be `main` and the |
186
|
|
|
|
|
|
|
`schema_version` key is used in the `meta` table. The component `summary`, if |
187
|
|
|
|
|
|
|
specified, will also be written to `schema_summary.<COMPONENT_NAME>` key. |
188
|
|
|
|
|
|
|
|
189
|
|
|
|
|
|
|
`provides` is an array of tables to help this routine know which table(s) your |
190
|
|
|
|
|
|
|
component create and maintain. If unset, this routine will try to guess from |
191
|
|
|
|
|
|
|
looking at "CREATE TABLE" SQL statements. |
192
|
|
|
|
|
|
|
|
193
|
|
|
|
|
|
|
This routine will create `table.<TABLE_NAME>` keys in the `meta` table to record |
194
|
|
|
|
|
|
|
which components currently maintain which tables. The value of the key is |
195
|
|
|
|
|
|
|
`<COMPONENT_NAME>:<VERSION>`. When a component no longer maintain a table in the |
196
|
|
|
|
|
|
|
newest version, the corresponding `table.<TABLE_NAME>` row in the `meta` will |
197
|
|
|
|
|
|
|
also be removed. |
198
|
|
|
|
|
|
|
|
199
|
|
|
|
|
|
|
`deps` is a hash. The keys are table names that your component requires. The |
200
|
|
|
|
|
|
|
values are integers, meaning the minimum version of the required table (= |
201
|
|
|
|
|
|
|
component version). In the future, more complex dependency relationship and |
202
|
|
|
|
|
|
|
version requirement will be supported. |
203
|
|
|
|
|
|
|
|
204
|
|
|
|
|
|
|
_ |
205
|
|
|
|
|
|
|
args => { |
206
|
|
|
|
|
|
|
spec => { |
207
|
|
|
|
|
|
|
schema => ['hash*'], # XXX require 'install' & 'latest_v' keys |
208
|
|
|
|
|
|
|
summary => 'Schema specification, e.g. SQL statements '. |
209
|
|
|
|
|
|
|
'to create and update the schema', |
210
|
|
|
|
|
|
|
req => 1, |
211
|
|
|
|
|
|
|
description => <<'_', |
212
|
|
|
|
|
|
|
|
213
|
|
|
|
|
|
|
Example: |
214
|
|
|
|
|
|
|
|
215
|
|
|
|
|
|
|
{ |
216
|
|
|
|
|
|
|
latest_v => 3, |
217
|
|
|
|
|
|
|
|
218
|
|
|
|
|
|
|
# will install version 3 (latest) |
219
|
|
|
|
|
|
|
install => [ |
220
|
|
|
|
|
|
|
'CREATE TABLE IF NOT EXISTS t1 (...)', |
221
|
|
|
|
|
|
|
'CREATE TABLE IF NOT EXISTS t2 (...)', |
222
|
|
|
|
|
|
|
'CREATE TABLE t3 (...)', |
223
|
|
|
|
|
|
|
], |
224
|
|
|
|
|
|
|
|
225
|
|
|
|
|
|
|
upgrade_to_v2 => [ |
226
|
|
|
|
|
|
|
'ALTER TABLE t1 ADD COLUMN c5 INT NOT NULL', |
227
|
|
|
|
|
|
|
sub { |
228
|
|
|
|
|
|
|
# this subroutine sets the values of c5 for the whole table |
229
|
|
|
|
|
|
|
my $dbh = shift; |
230
|
|
|
|
|
|
|
my $sth_sel = $dbh->prepare("SELECT c1 FROM t1"); |
231
|
|
|
|
|
|
|
my $sth_upd = $dbh->prepare("UPDATE t1 SET c5=? WHERE c1=?"); |
232
|
|
|
|
|
|
|
$sth_sel->execute; |
233
|
|
|
|
|
|
|
while (my ($c1) = $sth_sel->fetchrow_array) { |
234
|
|
|
|
|
|
|
my $c5 = ...; # calculate c5 value for the row |
235
|
|
|
|
|
|
|
$sth_upd->execute($c5, $c1); |
236
|
|
|
|
|
|
|
} |
237
|
|
|
|
|
|
|
}, |
238
|
|
|
|
|
|
|
'CREATE UNIQUE INDEX i1 ON t2(c1)', |
239
|
|
|
|
|
|
|
], |
240
|
|
|
|
|
|
|
|
241
|
|
|
|
|
|
|
upgrade_to_v3 => [ |
242
|
|
|
|
|
|
|
'ALTER TABLE t2 DROP COLUMN c2', |
243
|
|
|
|
|
|
|
'CREATE TABLE t3 (...)', |
244
|
|
|
|
|
|
|
], |
245
|
|
|
|
|
|
|
|
246
|
|
|
|
|
|
|
# provided for testing, so we can test migration from v1->v2, v2->v3 |
247
|
|
|
|
|
|
|
install_v1 => [ |
248
|
|
|
|
|
|
|
'CREATE TABLE IF NOT EXISTS t1 (...)', |
249
|
|
|
|
|
|
|
'CREATE TABLE IF NOT EXISTS t2 (...)', |
250
|
|
|
|
|
|
|
], |
251
|
|
|
|
|
|
|
} |
252
|
|
|
|
|
|
|
|
253
|
|
|
|
|
|
|
_ |
254
|
|
|
|
|
|
|
}, |
255
|
|
|
|
|
|
|
dbh => { |
256
|
|
|
|
|
|
|
schema => ['obj*'], |
257
|
|
|
|
|
|
|
summary => 'DBI database handle', |
258
|
|
|
|
|
|
|
req => 1, |
259
|
|
|
|
|
|
|
}, |
260
|
|
|
|
|
|
|
create_from_version => { |
261
|
|
|
|
|
|
|
schema => ['int*'], |
262
|
|
|
|
|
|
|
summary => 'Instead of the latest, create from this version', |
263
|
|
|
|
|
|
|
description => <<'_', |
264
|
|
|
|
|
|
|
|
265
|
|
|
|
|
|
|
This can be useful during testing. By default, if given an empty database, this |
266
|
|
|
|
|
|
|
function will use the `install` key of the spec to create the schema from |
267
|
|
|
|
|
|
|
nothing to the latest version. However, if this option is given, function wil |
268
|
|
|
|
|
|
|
use the corresponding `install_v<VERSION>` key in the spec (which must exist) |
269
|
|
|
|
|
|
|
and then upgrade using the `upgrade_to_v<VERSION>` keys to upgrade to the latest |
270
|
|
|
|
|
|
|
version. |
271
|
|
|
|
|
|
|
|
272
|
|
|
|
|
|
|
_ |
273
|
|
|
|
|
|
|
}, |
274
|
|
|
|
|
|
|
}, |
275
|
|
|
|
|
|
|
"x.perinci.sub.wrapper.disable_validate_args" => 1, |
276
|
|
|
|
|
|
|
}; |
277
|
|
|
|
|
|
|
sub create_or_update_db_schema { |
278
|
3
|
50
|
0
|
3
|
1
|
25
|
my %args = @_; no warnings ('void');require Scalar::Util::Numeric;my $arg_err; if (exists($args{'create_from_version'})) { ((defined($args{'create_from_version'})) ? 1 : (($arg_err //= "Required but not specified"),0)) && ((Scalar::Util::Numeric::isint($args{'create_from_version'})) ? 1 : (($arg_err //= "Not of type integer"),0)); if ($arg_err) { return [400, "Invalid argument value for create_from_version: $arg_err"] } }no warnings ('void');require Scalar::Util;if (exists($args{'dbh'})) { ((defined($args{'dbh'})) ? 1 : (($arg_err //= "Required but not specified"),0)) && ((Scalar::Util::blessed($args{'dbh'})) ? 1 : (($arg_err //= "Not of type object"),0)); if ($arg_err) { return [400, "Invalid argument value for dbh: $arg_err"] } }if (!exists($args{'dbh'})) { return [400, "Missing argument: dbh"] } no warnings ('void');if (exists($args{'spec'})) { ((defined($args{'spec'})) ? 1 : (($arg_err //= "Required but not specified"),0)) && ((ref($args{'spec'}) eq 'HASH') ? 1 : (($arg_err //= "Not of type hash"),0)); if ($arg_err) { return [400, "Invalid argument value for spec: $arg_err"] } }if (!exists($args{'spec'})) { return [400, "Missing argument: spec"] } # VALIDATE_ARGS |
|
3
|
50
|
0
|
3
|
|
6
|
|
|
3
|
50
|
0
|
3
|
|
428
|
|
|
3
|
50
|
0
|
24
|
|
25
|
|
|
3
|
100
|
0
|
|
|
7
|
|
|
3
|
50
|
0
|
|
|
366
|
|
|
3
|
50
|
|
|
|
27
|
|
|
3
|
50
|
|
|
|
8
|
|
|
3
|
50
|
|
|
|
6242
|
|
|
24
|
50
|
|
|
|
284683
|
|
|
24
|
50
|
|
|
|
1373
|
|
|
24
|
50
|
|
|
|
2183
|
|
|
24
|
50
|
|
|
|
111
|
|
|
1
|
50
|
|
|
|
17
|
|
|
1
|
50
|
|
|
|
28
|
|
|
0
|
50
|
|
|
|
0
|
|
|
24
|
50
|
|
|
|
121
|
|
|
24
|
|
|
|
|
78
|
|
|
24
|
|
|
|
|
242
|
|
|
24
|
|
|
|
|
99
|
|
|
0
|
|
|
|
|
0
|
|
|
24
|
|
|
|
|
80
|
|
|
0
|
|
|
|
|
0
|
|
|
24
|
|
|
|
|
62
|
|
|
24
|
|
|
|
|
140
|
|
|
24
|
|
|
|
|
247
|
|
|
0
|
|
|
|
|
0
|
|
|
24
|
|
|
|
|
63
|
|
|
0
|
|
|
|
|
0
|
|
279
|
|
|
|
|
|
|
|
280
|
24
|
|
|
|
|
58
|
my $spec = $args{spec}; |
281
|
24
|
|
|
|
|
43
|
my $dbh = $args{dbh}; |
282
|
24
|
|
|
|
|
46
|
my $from_v = $args{create_from_version}; |
283
|
|
|
|
|
|
|
|
284
|
24
|
|
100
|
|
|
108
|
my $comp = $spec->{component_name} // 'main'; |
285
|
24
|
|
|
|
|
67
|
my $sv_key = _sv_key($comp); |
286
|
|
|
|
|
|
|
|
287
|
24
|
|
|
|
|
321
|
local $dbh->{RaiseError}; |
288
|
|
|
|
|
|
|
|
289
|
|
|
|
|
|
|
# first, check current schema version |
290
|
|
|
|
|
|
|
|
291
|
|
|
|
|
|
|
# XXX check spec: latest_v and upgrade_to_v$V must synchronize |
292
|
|
|
|
|
|
|
|
293
|
24
|
|
|
|
|
463
|
my $current_v; |
294
|
24
|
|
|
|
|
139
|
my @has_meta_table = $dbh->tables("", undef, "meta"); |
295
|
24
|
100
|
|
|
|
16855
|
if (@has_meta_table) { |
296
|
9
|
|
|
|
|
95
|
($current_v) = $dbh->selectrow_array( |
297
|
|
|
|
|
|
|
"SELECT value FROM meta WHERE name='$sv_key'"); |
298
|
|
|
|
|
|
|
} |
299
|
24
|
|
100
|
|
|
1332
|
$current_v //= 0; |
300
|
|
|
|
|
|
|
|
301
|
24
|
|
|
|
|
44
|
my %provides; # list of tables provided by all components |
302
|
24
|
100
|
|
|
|
66
|
if (@has_meta_table) { |
303
|
9
|
|
|
|
|
43
|
%provides = _get_provides_from_db($dbh); |
304
|
|
|
|
|
|
|
} |
305
|
|
|
|
|
|
|
|
306
|
|
|
|
|
|
|
# list of tables provided by this component |
307
|
24
|
|
|
|
|
59
|
my @provides; |
308
|
|
|
|
|
|
|
GET_PROVIDES: |
309
|
|
|
|
|
|
|
{ |
310
|
24
|
100
|
|
|
|
42
|
if ($spec->{provides}) { |
|
24
|
100
|
|
|
|
95
|
|
311
|
2
|
|
|
|
|
6
|
@provides = @{ $spec->{provides} }; |
|
2
|
|
|
|
|
6
|
|
312
|
|
|
|
|
|
|
} elsif ($spec->{install}) { |
313
|
|
|
|
|
|
|
@provides = _extract_created_tables_from_sql_statements( |
314
|
17
|
|
|
|
|
33
|
@{ $spec->{install} }); |
|
17
|
|
|
|
|
62
|
|
315
|
|
|
|
|
|
|
} else { |
316
|
5
|
100
|
|
|
|
21
|
if ($comp ne 'main') { |
317
|
|
|
|
|
|
|
return [ |
318
|
1
|
|
|
|
|
13
|
412, "Both `provides` and `install` spec are not ". |
319
|
|
|
|
|
|
|
"specified, can't get list of tables managed by ". |
320
|
|
|
|
|
|
|
"this component"]; |
321
|
|
|
|
|
|
|
} |
322
|
|
|
|
|
|
|
} |
323
|
|
|
|
|
|
|
} |
324
|
|
|
|
|
|
|
|
325
|
|
|
|
|
|
|
CHECK_DEPS: |
326
|
|
|
|
|
|
|
{ |
327
|
23
|
100
|
|
|
|
41
|
my $deps = $spec->{deps} or last; |
|
23
|
|
|
|
|
81
|
|
328
|
|
|
|
|
|
|
|
329
|
3
|
|
|
|
|
18
|
for my $table (sort keys %$deps) { |
330
|
3
|
|
|
|
|
7
|
my $reqver = $deps->{$table}; |
331
|
3
|
|
|
|
|
7
|
my $prov = $provides{$table}; |
332
|
3
|
100
|
|
|
|
28
|
defined $prov or return [ |
333
|
|
|
|
|
|
|
412, |
334
|
|
|
|
|
|
|
"Dependency fails: ". |
335
|
|
|
|
|
|
|
"This component ('$comp') requires table '$table' ". |
336
|
|
|
|
|
|
|
"(version $reqver) which has not been provided by ". |
337
|
|
|
|
|
|
|
"any other component. Perhaps you should install the ". |
338
|
|
|
|
|
|
|
"missing component first." |
339
|
|
|
|
|
|
|
]; |
340
|
2
|
|
|
|
|
6
|
my ($provcomp, $provver) = @$prov; |
341
|
2
|
100
|
|
|
|
30
|
$provver >= $reqver or return [ |
342
|
|
|
|
|
|
|
412, |
343
|
|
|
|
|
|
|
"Dependency fails: ". |
344
|
|
|
|
|
|
|
"This component ('$comp') requires table '$table' ". |
345
|
|
|
|
|
|
|
"version $reqver but the database currently only has ". |
346
|
|
|
|
|
|
|
"version $provver (from component '$provcomp'). Perhaps ". |
347
|
|
|
|
|
|
|
"you should upgrade the '$provcomp' component first." |
348
|
|
|
|
|
|
|
]; |
349
|
|
|
|
|
|
|
} |
350
|
|
|
|
|
|
|
} # CHECK_DEPS |
351
|
|
|
|
|
|
|
|
352
|
|
|
|
|
|
|
CHECK_PROVIDES: |
353
|
|
|
|
|
|
|
{ |
354
|
21
|
|
|
|
|
37
|
for my $t (@provides) { |
|
21
|
|
|
|
|
46
|
|
355
|
25
|
|
|
|
|
50
|
my $prov = $provides{$t}; |
356
|
25
|
100
|
|
|
|
61
|
next unless $prov; |
357
|
7
|
|
|
|
|
18
|
my ($provcomp, $provver) = @$prov; |
358
|
7
|
100
|
|
|
|
41
|
$provcomp eq $comp or return [ |
359
|
|
|
|
|
|
|
412, |
360
|
|
|
|
|
|
|
"Component conflict: ". |
361
|
|
|
|
|
|
|
"This component ('$comp') provides table '$t' ". |
362
|
|
|
|
|
|
|
"but another component ($provcomp version $provver) also ". |
363
|
|
|
|
|
|
|
"provides this table. Perhaps you should update ". |
364
|
|
|
|
|
|
|
"either one or both components first?" |
365
|
|
|
|
|
|
|
]; |
366
|
|
|
|
|
|
|
} |
367
|
|
|
|
|
|
|
} # CHECK_PROVIDES |
368
|
|
|
|
|
|
|
|
369
|
20
|
|
|
|
|
35
|
my $orig_v = $current_v; |
370
|
|
|
|
|
|
|
|
371
|
|
|
|
|
|
|
# perform schema upgrade atomically per version (at least for db that |
372
|
|
|
|
|
|
|
# supports atomic DDL like postgres) |
373
|
|
|
|
|
|
|
|
374
|
20
|
|
|
|
|
35
|
my $latest_v = $spec->{latest_v}; |
375
|
20
|
50
|
|
|
|
55
|
if (!defined($latest_v)) { |
376
|
0
|
|
|
|
|
0
|
$latest_v = 1; |
377
|
0
|
|
|
|
|
0
|
for (keys %$spec) { |
378
|
0
|
0
|
|
|
|
0
|
next unless /^upgrade_to_v(\d+)$/; |
379
|
0
|
0
|
|
|
|
0
|
$latest_v = $1 if $1 > $latest_v; |
380
|
|
|
|
|
|
|
} |
381
|
|
|
|
|
|
|
} |
382
|
|
|
|
|
|
|
|
383
|
20
|
100
|
|
|
|
62
|
if ($current_v > $latest_v) { |
384
|
1
|
|
|
|
|
36
|
die "Database schema version ($current_v) is newer than the spec's ". |
385
|
|
|
|
|
|
|
"latest version ($latest_v), you probably need to upgrade ". |
386
|
|
|
|
|
|
|
"the application first\n"; |
387
|
|
|
|
|
|
|
} |
388
|
|
|
|
|
|
|
|
389
|
|
|
|
|
|
|
my $code_update_provides = sub { |
390
|
16
|
|
|
16
|
|
42
|
my @k; |
391
|
16
|
|
|
|
|
72
|
for my $t (sort keys %provides) { |
392
|
6
|
|
|
|
|
14
|
my $prov = $provides{$t}; |
393
|
6
|
100
|
|
|
|
18
|
next unless $prov->[0] eq $comp; |
394
|
5
|
|
|
|
|
9
|
delete $provides{$t}; |
395
|
5
|
|
|
|
|
23
|
push @k, "table.$t"; |
396
|
|
|
|
|
|
|
} |
397
|
16
|
100
|
|
|
|
48
|
if (@k) { |
398
|
|
|
|
|
|
|
$dbh->do("DELETE FROM meta WHERE name IN (". |
399
|
3
|
50
|
|
|
|
8
|
join(",", map { $dbh->quote($_) } @k).")") |
|
5
|
|
|
|
|
65
|
|
400
|
|
|
|
|
|
|
or return $dbh->errstr; |
401
|
|
|
|
|
|
|
} |
402
|
16
|
|
|
|
|
543
|
for my $t (@provides) { |
403
|
22
|
|
|
|
|
1077
|
$provides{$t} = [$comp, $latest_v]; |
404
|
22
|
50
|
|
|
|
172
|
$dbh->do("INSERT INTO meta (name, value) VALUES (?, ?)", |
405
|
|
|
|
|
|
|
{}, |
406
|
|
|
|
|
|
|
"table.$t", |
407
|
|
|
|
|
|
|
"$comp:$latest_v", |
408
|
|
|
|
|
|
|
) or return $dbh->errstr; |
409
|
|
|
|
|
|
|
} |
410
|
|
|
|
|
|
|
# success |
411
|
16
|
|
|
|
|
1637
|
""; |
412
|
19
|
|
|
|
|
137
|
}; |
413
|
|
|
|
|
|
|
|
414
|
|
|
|
|
|
|
my $code_update_summary = sub { |
415
|
6
|
100
|
|
6
|
|
29
|
my $key = "schema_summary".($comp eq 'main' ? '' : ".$comp"); |
416
|
6
|
|
|
|
|
47
|
my ($cur_summary) = $dbh->selectrow_array( |
417
|
|
|
|
|
|
|
"SELECT value FROM meta WHERE name=?", {}, $key); |
418
|
6
|
|
50
|
|
|
483
|
$cur_summary //= ""; |
419
|
6
|
|
50
|
|
|
30
|
my $new_summary = $spec->{summary} // ""; |
420
|
6
|
50
|
|
|
|
51
|
return "" if $cur_summary eq $new_summary; |
421
|
0
|
0
|
|
|
|
0
|
$dbh->do("REPLACE INTO meta (name, value) VALUES (?, ?)", |
422
|
|
|
|
|
|
|
{}, |
423
|
|
|
|
|
|
|
$key, |
424
|
|
|
|
|
|
|
$new_summary, |
425
|
|
|
|
|
|
|
) or return $dbh->errstr; |
426
|
|
|
|
|
|
|
# success |
427
|
0
|
|
|
|
|
0
|
""; |
428
|
19
|
|
|
|
|
90
|
}; |
429
|
|
|
|
|
|
|
|
430
|
19
|
|
|
|
|
42
|
my $begun; |
431
|
|
|
|
|
|
|
my $res; |
432
|
|
|
|
|
|
|
|
433
|
19
|
|
|
|
|
43
|
my $db_state = 'committed'; |
434
|
|
|
|
|
|
|
|
435
|
|
|
|
|
|
|
SETUP: |
436
|
19
|
|
|
|
|
29
|
while (1) { |
437
|
31
|
100
|
|
|
|
94
|
last if $current_v >= $latest_v; |
438
|
|
|
|
|
|
|
|
439
|
|
|
|
|
|
|
# we should only begin writing to the database from this step, because |
440
|
|
|
|
|
|
|
# we want to do things atomically (when the database supports it). when |
441
|
|
|
|
|
|
|
# we want to bail out, we don't return() directly but set $res and last |
442
|
|
|
|
|
|
|
# SETUP so we can rollback. |
443
|
25
|
|
|
|
|
153
|
$dbh->begin_work; |
444
|
25
|
|
|
|
|
455
|
$db_state = 'begun'; |
445
|
|
|
|
|
|
|
|
446
|
|
|
|
|
|
|
# install |
447
|
25
|
100
|
|
|
|
73
|
if ($current_v == 0) { |
448
|
|
|
|
|
|
|
# create 'meta' table if not exists |
449
|
15
|
100
|
|
|
|
38
|
unless (@has_meta_table) { |
450
|
|
|
|
|
|
|
$dbh->do("CREATE TABLE meta (name VARCHAR(64) NOT NULL PRIMARY KEY, value VARCHAR(255))") |
451
|
14
|
50
|
|
|
|
59
|
or do { $res = [500, "Couldn't create meta table: ".$dbh->errstr]; last SETUP }; |
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
452
|
|
|
|
|
|
|
} |
453
|
15
|
|
|
|
|
5100
|
my $sv_row = $dbh->selectrow_hashref("SELECT * FROM meta WHERE name='$sv_key'"); |
454
|
15
|
50
|
|
|
|
1749
|
unless ($sv_row) { |
455
|
|
|
|
|
|
|
$dbh->do("INSERT INTO meta (name,value) VALUES ('$sv_key',0)") |
456
|
15
|
50
|
|
|
|
94
|
or do { $res = [500, "Couldn't insert to meta table: ".$dbh->errstr]; last SETUP }; |
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
457
|
|
|
|
|
|
|
} |
458
|
|
|
|
|
|
|
|
459
|
15
|
100
|
|
|
|
775
|
if ($from_v) { |
460
|
|
|
|
|
|
|
# install from a specific version |
461
|
1
|
50
|
|
|
|
7
|
if ($spec->{"install_v$from_v"}) { |
462
|
1
|
|
|
|
|
23
|
log_debug("Creating version $from_v of database schema (component $comp) ..."); |
463
|
1
|
|
|
|
|
3
|
my $i = 0; |
464
|
1
|
|
|
|
|
2
|
for my $step (@{ $spec->{"install_v$from_v"} }) { |
|
1
|
|
|
|
|
5
|
|
465
|
3
|
|
|
|
|
190
|
$i++; |
466
|
3
|
50
|
|
|
|
9
|
if (ref($step) eq 'CODE') { |
467
|
0
|
0
|
|
|
|
0
|
eval { $step->($dbh) }; if ($@) { $res = [500, "Died when executing code from install_v$from_v\'s step #$i: $@"]; last SETUP } |
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
468
|
|
|
|
|
|
|
} else { |
469
|
3
|
50
|
|
|
|
14
|
$dbh->do($step) or do { $res = [500, "Failed executing SQL statement from install_v$from_v\'s step #$i: ".$dbh->errstr." (SQL statement: $step)"]; last SETUP }; |
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
470
|
|
|
|
|
|
|
} |
471
|
|
|
|
|
|
|
} |
472
|
1
|
|
|
|
|
87
|
$current_v = $from_v; |
473
|
|
|
|
|
|
|
$dbh->do("UPDATE meta SET value=$from_v WHERE name='$sv_key'") |
474
|
1
|
50
|
|
|
|
39
|
or do { $res = [500, "Couldn't set $sv_key in meta table: ".$dbh->errstr]; last SETUP }; |
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
475
|
|
|
|
|
|
|
|
476
|
1
|
50
|
|
|
|
57
|
if ($current_v == $latest_v) { |
477
|
0
|
0
|
|
|
|
0
|
if (my $up_res = $code_update_provides->()) { $res = [500, "Couldn't update provides information: $up_res"]; last SETUP } |
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
478
|
|
|
|
|
|
|
} |
479
|
|
|
|
|
|
|
|
480
|
1
|
50
|
|
|
|
7125
|
$dbh->commit or do { $res = [500, "Couldn't commit: ".$dbh->errstr]; last SETUP }; |
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
481
|
1
|
|
|
|
|
7
|
$db_state = 'committed'; |
482
|
|
|
|
|
|
|
|
483
|
1
|
|
|
|
|
5
|
next SETUP; |
484
|
|
|
|
|
|
|
} else { |
485
|
0
|
|
|
|
|
0
|
$res = [400, "Error in spec: Can't find 'install_v$from_v' key in spec"]; |
486
|
0
|
|
|
|
|
0
|
last SETUP; |
487
|
|
|
|
|
|
|
} |
488
|
|
|
|
|
|
|
} else { |
489
|
|
|
|
|
|
|
# install directly the latest version |
490
|
14
|
100
|
|
|
|
57
|
if ($spec->{install}) { |
|
|
50
|
|
|
|
|
|
491
|
10
|
|
|
|
|
64
|
log_debug("Creating latest version of database schema (component $comp) ..."); |
492
|
10
|
|
|
|
|
35
|
my $i = 0; |
493
|
10
|
|
|
|
|
28
|
for my $step (@{ $spec->{install} }) { |
|
10
|
|
|
|
|
34
|
|
494
|
15
|
|
|
|
|
561
|
$i++; |
495
|
15
|
100
|
|
|
|
41
|
if (ref($step) eq 'CODE') { |
496
|
1
|
50
|
|
|
|
4
|
eval { $step->($dbh) }; if ($@) { $res = [500, "Died when executing code from install's step #$i: $@"]; last SETUP } |
|
1
|
|
|
|
|
5
|
|
|
1
|
|
|
|
|
24
|
|
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
497
|
|
|
|
|
|
|
} else { |
498
|
14
|
50
|
|
|
|
66
|
$dbh->do($step) or do { $res = [500, "Failed executing SQL statement from install's step #$i: ".$dbh->errstr." (SQL statement: $step)"]; last SETUP }; |
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
499
|
|
|
|
|
|
|
} |
500
|
|
|
|
|
|
|
} |
501
|
|
|
|
|
|
|
$dbh->do("UPDATE meta SET value=$latest_v WHERE name='$sv_key'") |
502
|
10
|
50
|
|
|
|
1063
|
or do { $res = [500, "Couldn't update $sv_key in meta table: ".$dbh->errstr]; last SETUP }; |
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
503
|
|
|
|
|
|
|
|
504
|
10
|
50
|
|
|
|
420
|
if (my $up_res = $code_update_provides->()) { $res = [500, "Couldn't update provides information: $up_res"]; last SETUP } |
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
505
|
|
|
|
|
|
|
|
506
|
10
|
50
|
|
|
|
115839
|
$dbh->commit or do { $res = [500, "Couldn't commit: ".$dbh->errstr]; last SETUP }; |
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
507
|
10
|
|
|
|
|
73
|
$db_state = 'committed'; |
508
|
|
|
|
|
|
|
|
509
|
10
|
|
|
|
|
41
|
last SETUP; |
510
|
|
|
|
|
|
|
} elsif ($spec->{upgrade_to_v1}) { |
511
|
|
|
|
|
|
|
# there is no 'install' but 'upgrade_to_v1', so we upgrade |
512
|
|
|
|
|
|
|
# from v1 to latest |
513
|
4
|
|
|
|
|
159
|
goto UPGRADE; |
514
|
|
|
|
|
|
|
} else { |
515
|
0
|
|
|
|
|
0
|
$res = [400, "Error in spec: Can't find 'install' key in spec"]; |
516
|
0
|
|
|
|
|
0
|
last SETUP; |
517
|
|
|
|
|
|
|
} |
518
|
|
|
|
|
|
|
} |
519
|
|
|
|
|
|
|
} # install |
520
|
|
|
|
|
|
|
|
521
|
|
|
|
|
|
|
UPGRADE: |
522
|
14
|
|
|
|
|
33
|
my $next_v = $current_v + 1; |
523
|
14
|
|
|
|
|
105
|
log_debug("Updating database schema (component $comp) from version $current_v to $next_v ..."); |
524
|
|
|
|
|
|
|
$spec->{"upgrade_to_v$next_v"} |
525
|
14
|
50
|
|
|
|
89
|
or do { $res = [400, "Error in spec: upgrade_to_v$next_v not specified"]; last SETUP }; |
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
526
|
14
|
|
|
|
|
27
|
my $i = 0; |
527
|
14
|
|
|
|
|
27
|
for my $step (@{ $spec->{"upgrade_to_v$next_v"} }) { |
|
14
|
|
|
|
|
61
|
|
528
|
25
|
|
|
|
|
1846
|
$i++; |
529
|
25
|
100
|
|
|
|
73
|
if (ref($step) eq 'CODE') { |
530
|
1
|
50
|
|
|
|
6
|
eval { $step->($dbh) }; if ($@) { $res = [500, "Died when executing code from upgrade_to_v$next_v\'s step #$i: $@"]; last SETUP } |
|
1
|
|
|
|
|
5
|
|
|
1
|
|
|
|
|
16
|
|
|
1
|
|
|
|
|
5
|
|
|
1
|
|
|
|
|
4
|
|
531
|
|
|
|
|
|
|
} else { |
532
|
24
|
100
|
|
|
|
135
|
$dbh->do($step) or do { $res = [500, "Failed executing SQL statement from upgrade_to_v$next_v\'s step #$i: ".$dbh->errstr." (SQL statement: $step)"]; last SETUP }; |
|
2
|
|
|
|
|
371
|
|
|
2
|
|
|
|
|
9
|
|
533
|
|
|
|
|
|
|
} |
534
|
|
|
|
|
|
|
} |
535
|
11
|
|
|
|
|
2022
|
$current_v = $next_v; |
536
|
|
|
|
|
|
|
$dbh->do("UPDATE meta SET value=$next_v WHERE name='$sv_key'") |
537
|
11
|
50
|
|
|
|
88
|
or do { $res = [500, "Couldn't set $sv_key in meta table: ".$dbh->errstr]; last SETUP }; |
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
538
|
|
|
|
|
|
|
|
539
|
11
|
100
|
|
|
|
779
|
if ($current_v == $latest_v) { |
540
|
6
|
50
|
|
|
|
29
|
if (my $up_res = $code_update_provides->()) { $res = [500, "Couldn't update provides information: $up_res"]; last SETUP } |
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
541
|
6
|
50
|
|
|
|
18
|
if (my $us_res = $code_update_summary->()) { $res = [500, "Couldn't update summary: $us_res"]; last SETUP } |
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
542
|
|
|
|
|
|
|
} |
543
|
|
|
|
|
|
|
|
544
|
11
|
50
|
|
|
|
81736
|
$dbh->commit or do { $res = [500, "Couldn't commit: ".$dbh->errstr]; last SETUP }; |
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
545
|
11
|
|
|
|
|
86
|
$db_state = 'committed'; |
546
|
|
|
|
|
|
|
|
547
|
|
|
|
|
|
|
} # SETUP |
548
|
|
|
|
|
|
|
|
549
|
19
|
|
100
|
|
|
249
|
$res //= [200, "OK (upgraded from version $orig_v to $latest_v)", {version=>$latest_v}]; |
550
|
|
|
|
|
|
|
|
551
|
19
|
100
|
|
|
|
84
|
if ($res->[0] != 200) { |
552
|
3
|
|
|
|
|
13
|
log_error("Failed creating/upgrading schema: %s", $res); |
553
|
3
|
50
|
|
|
|
81
|
$dbh->rollback unless $db_state eq 'committed'; |
554
|
|
|
|
|
|
|
} else { |
555
|
16
|
50
|
|
|
|
51
|
$dbh->commit unless $db_state eq 'committed'; |
556
|
|
|
|
|
|
|
} |
557
|
|
|
|
|
|
|
|
558
|
19
|
|
|
|
|
707
|
$res; |
559
|
|
|
|
|
|
|
} |
560
|
|
|
|
|
|
|
|
561
|
|
|
|
|
|
|
1; |
562
|
|
|
|
|
|
|
# ABSTRACT: Routine and convention to create/update your application's DB schema |
563
|
|
|
|
|
|
|
|
564
|
|
|
|
|
|
|
__END__ |
565
|
|
|
|
|
|
|
|
566
|
|
|
|
|
|
|
=pod |
567
|
|
|
|
|
|
|
|
568
|
|
|
|
|
|
|
=encoding UTF-8 |
569
|
|
|
|
|
|
|
|
570
|
|
|
|
|
|
|
=head1 NAME |
571
|
|
|
|
|
|
|
|
572
|
|
|
|
|
|
|
SQL::Schema::Versioned - Routine and convention to create/update your application's DB schema |
573
|
|
|
|
|
|
|
|
574
|
|
|
|
|
|
|
=head1 VERSION |
575
|
|
|
|
|
|
|
|
576
|
|
|
|
|
|
|
This document describes version 0.237 of SQL::Schema::Versioned (from Perl distribution SQL-Schema-Versioned), released on 2019-01-13. |
577
|
|
|
|
|
|
|
|
578
|
|
|
|
|
|
|
=head1 DESCRIPTION |
579
|
|
|
|
|
|
|
|
580
|
|
|
|
|
|
|
To use this module, you typically run the L</"create_or_update_db_schema">() |
581
|
|
|
|
|
|
|
routine at the start of your program/script, e.g.: |
582
|
|
|
|
|
|
|
|
583
|
|
|
|
|
|
|
use DBI; |
584
|
|
|
|
|
|
|
use SQL::Schema::Versioned qw(create_or_update_db_schema); |
585
|
|
|
|
|
|
|
my $spec = {...}; # the schema specification |
586
|
|
|
|
|
|
|
my $dbh = DBI->connect(...); |
587
|
|
|
|
|
|
|
my $res = create_or_update_db_schema(dbh=>$dbh, spec=>$spec); |
588
|
|
|
|
|
|
|
die "Cannot run the application: cannot create/upgrade database schema: $res->[1]" |
589
|
|
|
|
|
|
|
unless $res->[0] == 200; |
590
|
|
|
|
|
|
|
|
591
|
|
|
|
|
|
|
This way, your program automatically creates/updates database schema when run. |
592
|
|
|
|
|
|
|
Users need not know anything. |
593
|
|
|
|
|
|
|
|
594
|
|
|
|
|
|
|
=head1 BEST PRACTICES |
595
|
|
|
|
|
|
|
|
596
|
|
|
|
|
|
|
It is recommended that after you create the second and subsequent version |
597
|
|
|
|
|
|
|
(C<upgrade_to_v2>, C<upgrade_to_v3>, and so on) you create and keep |
598
|
|
|
|
|
|
|
C<install_v1> so you can test migration from v1->v2, v2->v3, and so on. |
599
|
|
|
|
|
|
|
|
600
|
|
|
|
|
|
|
=head1 FUNCTIONS |
601
|
|
|
|
|
|
|
|
602
|
|
|
|
|
|
|
|
603
|
|
|
|
|
|
|
=head2 create_or_update_db_schema |
604
|
|
|
|
|
|
|
|
605
|
|
|
|
|
|
|
Usage: |
606
|
|
|
|
|
|
|
|
607
|
|
|
|
|
|
|
create_or_update_db_schema(%args) -> [status, msg, payload, meta] |
608
|
|
|
|
|
|
|
|
609
|
|
|
|
|
|
|
Routine and convention to create/update your application's DB schema. |
610
|
|
|
|
|
|
|
|
611
|
|
|
|
|
|
|
With this routine (and some convention) you can easily create and update |
612
|
|
|
|
|
|
|
database schema for your application in a simple way using pure SQL. |
613
|
|
|
|
|
|
|
|
614
|
|
|
|
|
|
|
I<Version>: version is an integer and starts from 1. Each software release with |
615
|
|
|
|
|
|
|
schema change will bump the version number by 1. Version information is stored |
616
|
|
|
|
|
|
|
in a special table called C<meta> (SELECT value FROM meta WHERE |
617
|
|
|
|
|
|
|
name='schema_version'). |
618
|
|
|
|
|
|
|
|
619
|
|
|
|
|
|
|
You supply the SQL statements in C<spec>. C<spec> is a hash which at least must |
620
|
|
|
|
|
|
|
contain the key C<latest_v> (an integer) and C<install> (a series of SQL |
621
|
|
|
|
|
|
|
statements to create the schema from nothing to the latest version). |
622
|
|
|
|
|
|
|
|
623
|
|
|
|
|
|
|
There should also be zero or more C<upgrade_to_v$VERSION> keys, the value of each |
624
|
|
|
|
|
|
|
is a series of SQL statements to upgrade from ($VERSION-1) to $VERSION. So there |
625
|
|
|
|
|
|
|
could be C<upgrade_to_v2>, C<upgrade_to_v3>, and so on up the latest version. This |
626
|
|
|
|
|
|
|
is used to upgrade an existing database from earlier version to the latest. |
627
|
|
|
|
|
|
|
|
628
|
|
|
|
|
|
|
For testing purposes, you can also add one or more C<< install_vE<lt>VERSIONE<gt> >> key, |
629
|
|
|
|
|
|
|
where C<XXX> is an integer, the lowest version number that you still want to |
630
|
|
|
|
|
|
|
support. So, for example, if C<latest_v> is 5 and you still want to support from |
631
|
|
|
|
|
|
|
version 2, you can have an C<install_v2> key containing a series of SQL |
632
|
|
|
|
|
|
|
statements to create the schema at version 2, and C<upgrade_to_v3>, |
633
|
|
|
|
|
|
|
C<upgrade_to_v4>, C<upgrade_to_v5> keys. This way migrations from v2 to v3, v3 to |
634
|
|
|
|
|
|
|
v4, and v4 to v5 can be tested. |
635
|
|
|
|
|
|
|
|
636
|
|
|
|
|
|
|
You can name C<install_v1> key as C<upgrade_to_v1> (to upgrade from 'nothing' |
637
|
|
|
|
|
|
|
a.k.a. v0 to v1), which is basically the same thing. |
638
|
|
|
|
|
|
|
|
639
|
|
|
|
|
|
|
This routine will check the existence of the C<meta> table and the current schema |
640
|
|
|
|
|
|
|
version. If C<meta> table does not exist yet, the SQL statements in C<install> |
641
|
|
|
|
|
|
|
will be executed. The C<meta> table will also be created and a row |
642
|
|
|
|
|
|
|
C<('schema_version', 1)> is added. The (C<schema_summary>, <SUMMARY>) row will |
643
|
|
|
|
|
|
|
also be added if your spec specifies a C<summary>. |
644
|
|
|
|
|
|
|
|
645
|
|
|
|
|
|
|
If C<meta> table already exists, schema version will be read from it and one or |
646
|
|
|
|
|
|
|
more series of SQL statements from C<upgrade_to_v$VERSION> will be executed to |
647
|
|
|
|
|
|
|
bring the schema to the latest version. |
648
|
|
|
|
|
|
|
|
649
|
|
|
|
|
|
|
Aside from SQL statement, the series can also contain coderefs for more complex |
650
|
|
|
|
|
|
|
upgrade process. Each coderef will be called with C<$dbh> as argument and must |
651
|
|
|
|
|
|
|
not die (so to signify failure, you can die from inside the coderef). |
652
|
|
|
|
|
|
|
|
653
|
|
|
|
|
|
|
Currently only tested on MySQL, Postgres, and SQLite. Postgres is recommended |
654
|
|
|
|
|
|
|
because it can do transactional DDL (a failed upgrade in the middle will not |
655
|
|
|
|
|
|
|
cause the database schema state to be inconsistent, e.g. in-between two |
656
|
|
|
|
|
|
|
versions). |
657
|
|
|
|
|
|
|
|
658
|
|
|
|
|
|
|
=head3 Modular schema (components) |
659
|
|
|
|
|
|
|
|
660
|
|
|
|
|
|
|
This routine supports so-called modular schema, where you can separate your |
661
|
|
|
|
|
|
|
database schema into several I<components> (sets of tables) and then declare |
662
|
|
|
|
|
|
|
dependencies among them. |
663
|
|
|
|
|
|
|
|
664
|
|
|
|
|
|
|
For example, say you are writing a stock management application. You divide your |
665
|
|
|
|
|
|
|
application into several components: C<quote> (component that deals with |
666
|
|
|
|
|
|
|
importing stock quotes and querying stock prices), C<portfolio> (component that |
667
|
|
|
|
|
|
|
deals with computing the market value of your portfolio, calculating |
668
|
|
|
|
|
|
|
gains/losses), C<trade> (component that connects to your broker API and perform |
669
|
|
|
|
|
|
|
trading by submitting buy/sell orders). |
670
|
|
|
|
|
|
|
|
671
|
|
|
|
|
|
|
The C<quote> application component manages these tables: C<daily_price>, |
672
|
|
|
|
|
|
|
C<spot_price>. The C<portfolio> application component manages these tables: |
673
|
|
|
|
|
|
|
C<account> (list of accounts in stock brokerages), C<balance> (list of balances), |
674
|
|
|
|
|
|
|
C<tx> (list of transactions). The C<trade> application component manages these |
675
|
|
|
|
|
|
|
tables: C<order> (list of buy/sell orders). |
676
|
|
|
|
|
|
|
|
677
|
|
|
|
|
|
|
The C<portfolio> application component requires price information to be able to |
678
|
|
|
|
|
|
|
calculate unrealized gains/losses. The C<trade> component also needs information |
679
|
|
|
|
|
|
|
from the C<daily_price> e.g. to calculate 52-week momentum, and writes to the |
680
|
|
|
|
|
|
|
C<spot_price> to record intraday prices, and reads/writes from the C<account> and |
681
|
|
|
|
|
|
|
C<balance> tables. Here are the C<spec>s for each component: |
682
|
|
|
|
|
|
|
|
683
|
|
|
|
|
|
|
# spec for the price application component |
684
|
|
|
|
|
|
|
{ |
685
|
|
|
|
|
|
|
component_name => 'price', |
686
|
|
|
|
|
|
|
summary => "Price application component", |
687
|
|
|
|
|
|
|
latest_v => 1, |
688
|
|
|
|
|
|
|
provides => ['daily_price', 'spot_price'], |
689
|
|
|
|
|
|
|
install => [...], |
690
|
|
|
|
|
|
|
... |
691
|
|
|
|
|
|
|
} |
692
|
|
|
|
|
|
|
|
693
|
|
|
|
|
|
|
# spec for the portfolio application component |
694
|
|
|
|
|
|
|
{ |
695
|
|
|
|
|
|
|
component_name => 'portfolio', |
696
|
|
|
|
|
|
|
summary => "Portfolio application component", |
697
|
|
|
|
|
|
|
latest_v => 1, |
698
|
|
|
|
|
|
|
provides => ['account', 'balance', 'tx'], |
699
|
|
|
|
|
|
|
deps => { |
700
|
|
|
|
|
|
|
'daily_price' => 1, |
701
|
|
|
|
|
|
|
'spot_price' => 1, |
702
|
|
|
|
|
|
|
}, |
703
|
|
|
|
|
|
|
install => [...], |
704
|
|
|
|
|
|
|
... |
705
|
|
|
|
|
|
|
} |
706
|
|
|
|
|
|
|
|
707
|
|
|
|
|
|
|
# spec for the trade application component |
708
|
|
|
|
|
|
|
{ |
709
|
|
|
|
|
|
|
component_name => 'trade', |
710
|
|
|
|
|
|
|
summary => "Trade application component", |
711
|
|
|
|
|
|
|
latest_v => 1, |
712
|
|
|
|
|
|
|
provides => ['order'], |
713
|
|
|
|
|
|
|
deps => { |
714
|
|
|
|
|
|
|
'daily_price' => 1, |
715
|
|
|
|
|
|
|
'spot_price' => 1, |
716
|
|
|
|
|
|
|
'account' => 1, |
717
|
|
|
|
|
|
|
'balance' => 1, |
718
|
|
|
|
|
|
|
}, |
719
|
|
|
|
|
|
|
install => [...], |
720
|
|
|
|
|
|
|
... |
721
|
|
|
|
|
|
|
} |
722
|
|
|
|
|
|
|
|
723
|
|
|
|
|
|
|
You'll notice that the three keys new here are the C<component_name>, C<provides>, |
724
|
|
|
|
|
|
|
and C<deps>. |
725
|
|
|
|
|
|
|
|
726
|
|
|
|
|
|
|
When C<component_name> is set, then instead of the C<schema_version> key in the |
727
|
|
|
|
|
|
|
C<meta> table, your component will use the C<< schema_version.E<lt>COMPONENT_NAMEE<gt> >> key. |
728
|
|
|
|
|
|
|
When C<component_name> is not set, it is assumed to be C<main> and the |
729
|
|
|
|
|
|
|
C<schema_version> key is used in the C<meta> table. The component C<summary>, if |
730
|
|
|
|
|
|
|
specified, will also be written to C<< schema_summary.E<lt>COMPONENT_NAMEE<gt> >> key. |
731
|
|
|
|
|
|
|
|
732
|
|
|
|
|
|
|
C<provides> is an array of tables to help this routine know which table(s) your |
733
|
|
|
|
|
|
|
component create and maintain. If unset, this routine will try to guess from |
734
|
|
|
|
|
|
|
looking at "CREATE TABLE" SQL statements. |
735
|
|
|
|
|
|
|
|
736
|
|
|
|
|
|
|
This routine will create C<< table.E<lt>TABLE_NAMEE<gt> >> keys in the C<meta> table to record |
737
|
|
|
|
|
|
|
which components currently maintain which tables. The value of the key is |
738
|
|
|
|
|
|
|
C<< E<lt>COMPONENT_NAMEE<gt>:E<lt>VERSIONE<gt> >>. When a component no longer maintain a table in the |
739
|
|
|
|
|
|
|
newest version, the corresponding C<< table.E<lt>TABLE_NAMEE<gt> >> row in the C<meta> will |
740
|
|
|
|
|
|
|
also be removed. |
741
|
|
|
|
|
|
|
|
742
|
|
|
|
|
|
|
C<deps> is a hash. The keys are table names that your component requires. The |
743
|
|
|
|
|
|
|
values are integers, meaning the minimum version of the required table (= |
744
|
|
|
|
|
|
|
component version). In the future, more complex dependency relationship and |
745
|
|
|
|
|
|
|
version requirement will be supported. |
746
|
|
|
|
|
|
|
|
747
|
|
|
|
|
|
|
This function is not exported by default, but exportable. |
748
|
|
|
|
|
|
|
|
749
|
|
|
|
|
|
|
Arguments ('*' denotes required arguments): |
750
|
|
|
|
|
|
|
|
751
|
|
|
|
|
|
|
=over 4 |
752
|
|
|
|
|
|
|
|
753
|
|
|
|
|
|
|
=item * B<create_from_version> => I<int> |
754
|
|
|
|
|
|
|
|
755
|
|
|
|
|
|
|
Instead of the latest, create from this version. |
756
|
|
|
|
|
|
|
|
757
|
|
|
|
|
|
|
This can be useful during testing. By default, if given an empty database, this |
758
|
|
|
|
|
|
|
function will use the C<install> key of the spec to create the schema from |
759
|
|
|
|
|
|
|
nothing to the latest version. However, if this option is given, function wil |
760
|
|
|
|
|
|
|
use the corresponding C<< install_vE<lt>VERSIONE<gt> >> key in the spec (which must exist) |
761
|
|
|
|
|
|
|
and then upgrade using the C<< upgrade_to_vE<lt>VERSIONE<gt> >> keys to upgrade to the latest |
762
|
|
|
|
|
|
|
version. |
763
|
|
|
|
|
|
|
|
764
|
|
|
|
|
|
|
=item * B<dbh>* => I<obj> |
765
|
|
|
|
|
|
|
|
766
|
|
|
|
|
|
|
DBI database handle. |
767
|
|
|
|
|
|
|
|
768
|
|
|
|
|
|
|
=item * B<spec>* => I<hash> |
769
|
|
|
|
|
|
|
|
770
|
|
|
|
|
|
|
Schema specification, e.g. SQL statements to create and update the schema. |
771
|
|
|
|
|
|
|
|
772
|
|
|
|
|
|
|
Example: |
773
|
|
|
|
|
|
|
|
774
|
|
|
|
|
|
|
{ |
775
|
|
|
|
|
|
|
latest_v => 3, |
776
|
|
|
|
|
|
|
|
777
|
|
|
|
|
|
|
# will install version 3 (latest) |
778
|
|
|
|
|
|
|
install => [ |
779
|
|
|
|
|
|
|
'CREATE TABLE IF NOT EXISTS t1 (...)', |
780
|
|
|
|
|
|
|
'CREATE TABLE IF NOT EXISTS t2 (...)', |
781
|
|
|
|
|
|
|
'CREATE TABLE t3 (...)', |
782
|
|
|
|
|
|
|
], |
783
|
|
|
|
|
|
|
|
784
|
|
|
|
|
|
|
upgrade_to_v2 => [ |
785
|
|
|
|
|
|
|
'ALTER TABLE t1 ADD COLUMN c5 INT NOT NULL', |
786
|
|
|
|
|
|
|
sub { |
787
|
|
|
|
|
|
|
# this subroutine sets the values of c5 for the whole table |
788
|
|
|
|
|
|
|
my $dbh = shift; |
789
|
|
|
|
|
|
|
my $sth_sel = $dbh->prepare("SELECT c1 FROM t1"); |
790
|
|
|
|
|
|
|
my $sth_upd = $dbh->prepare("UPDATE t1 SET c5=? WHERE c1=?"); |
791
|
|
|
|
|
|
|
$sth_sel->execute; |
792
|
|
|
|
|
|
|
while (my ($c1) = $sth_sel->fetchrow_array) { |
793
|
|
|
|
|
|
|
my $c5 = ...; # calculate c5 value for the row |
794
|
|
|
|
|
|
|
$sth_upd->execute($c5, $c1); |
795
|
|
|
|
|
|
|
} |
796
|
|
|
|
|
|
|
}, |
797
|
|
|
|
|
|
|
'CREATE UNIQUE INDEX i1 ON t2(c1)', |
798
|
|
|
|
|
|
|
], |
799
|
|
|
|
|
|
|
|
800
|
|
|
|
|
|
|
upgrade_to_v3 => [ |
801
|
|
|
|
|
|
|
'ALTER TABLE t2 DROP COLUMN c2', |
802
|
|
|
|
|
|
|
'CREATE TABLE t3 (...)', |
803
|
|
|
|
|
|
|
], |
804
|
|
|
|
|
|
|
|
805
|
|
|
|
|
|
|
# provided for testing, so we can test migration from v1->v2, v2->v3 |
806
|
|
|
|
|
|
|
install_v1 => [ |
807
|
|
|
|
|
|
|
'CREATE TABLE IF NOT EXISTS t1 (...)', |
808
|
|
|
|
|
|
|
'CREATE TABLE IF NOT EXISTS t2 (...)', |
809
|
|
|
|
|
|
|
], |
810
|
|
|
|
|
|
|
} |
811
|
|
|
|
|
|
|
|
812
|
|
|
|
|
|
|
=back |
813
|
|
|
|
|
|
|
|
814
|
|
|
|
|
|
|
Returns an enveloped result (an array). |
815
|
|
|
|
|
|
|
|
816
|
|
|
|
|
|
|
First element (status) is an integer containing HTTP status code |
817
|
|
|
|
|
|
|
(200 means OK, 4xx caller error, 5xx function error). Second element |
818
|
|
|
|
|
|
|
(msg) is a string containing error message, or 'OK' if status is |
819
|
|
|
|
|
|
|
200. Third element (payload) is optional, the actual result. Fourth |
820
|
|
|
|
|
|
|
element (meta) is called result metadata and is optional, a hash |
821
|
|
|
|
|
|
|
that contains extra information. |
822
|
|
|
|
|
|
|
|
823
|
|
|
|
|
|
|
Return value: (any) |
824
|
|
|
|
|
|
|
|
825
|
|
|
|
|
|
|
=head1 FAQ |
826
|
|
|
|
|
|
|
|
827
|
|
|
|
|
|
|
=head2 Why use this module instead of other similar solution? |
828
|
|
|
|
|
|
|
|
829
|
|
|
|
|
|
|
Mainly simplicity. I write simple application which is often self-contained in a |
830
|
|
|
|
|
|
|
single module/script. This module works with embedded SQL statements instead of |
831
|
|
|
|
|
|
|
having to put SQL in separate files/subdirectory. |
832
|
|
|
|
|
|
|
|
833
|
|
|
|
|
|
|
=head2 How do I see each SQL statement as it is being executed? |
834
|
|
|
|
|
|
|
|
835
|
|
|
|
|
|
|
Try using L<Log::ger::DBI::Query>, e.g.: |
836
|
|
|
|
|
|
|
|
837
|
|
|
|
|
|
|
% perl -MLog::ger::DBI::Query -MLog::ger::Output=Screen -MLog::ger::Level::trace yourapp.pl ... |
838
|
|
|
|
|
|
|
|
839
|
|
|
|
|
|
|
=head1 HOMEPAGE |
840
|
|
|
|
|
|
|
|
841
|
|
|
|
|
|
|
Please visit the project's homepage at L<https://metacpan.org/release/SQL-Schema-Versioned>. |
842
|
|
|
|
|
|
|
|
843
|
|
|
|
|
|
|
=head1 SOURCE |
844
|
|
|
|
|
|
|
|
845
|
|
|
|
|
|
|
Source repository is at L<https://github.com/perlancar/perl-SQL-Schema-Versioned>. |
846
|
|
|
|
|
|
|
|
847
|
|
|
|
|
|
|
=head1 BUGS |
848
|
|
|
|
|
|
|
|
849
|
|
|
|
|
|
|
Please report any bugs or feature requests on the bugtracker website L<https://rt.cpan.org/Public/Dist/Display.html?Name=SQL-Schema-Versioned> |
850
|
|
|
|
|
|
|
|
851
|
|
|
|
|
|
|
When submitting a bug or request, please include a test-file or a |
852
|
|
|
|
|
|
|
patch to an existing test-file that illustrates the bug or desired |
853
|
|
|
|
|
|
|
feature. |
854
|
|
|
|
|
|
|
|
855
|
|
|
|
|
|
|
=head1 SEE ALSO |
856
|
|
|
|
|
|
|
|
857
|
|
|
|
|
|
|
Some other database migration tools on CPAN: |
858
|
|
|
|
|
|
|
|
859
|
|
|
|
|
|
|
=over |
860
|
|
|
|
|
|
|
|
861
|
|
|
|
|
|
|
=item * L<DBIx::Migration> |
862
|
|
|
|
|
|
|
|
863
|
|
|
|
|
|
|
Pretty much similar to this module, with support for downgrades. OO style, SQL |
864
|
|
|
|
|
|
|
in separate files/subdirectory. |
865
|
|
|
|
|
|
|
|
866
|
|
|
|
|
|
|
=item * L<Database::Migrator> |
867
|
|
|
|
|
|
|
|
868
|
|
|
|
|
|
|
Pretty much similar. OO style, SQL in separate files/subdirectory. Perl scripts |
869
|
|
|
|
|
|
|
can also be executed for each version upgrade. Meta table is configurable |
870
|
|
|
|
|
|
|
(default recommended is 'AppliedMigrations'). |
871
|
|
|
|
|
|
|
|
872
|
|
|
|
|
|
|
=item * L<sqitch> |
873
|
|
|
|
|
|
|
|
874
|
|
|
|
|
|
|
A more proper database change management tool with dependency resolution and VCS |
875
|
|
|
|
|
|
|
awareness. No numbering. Command-line script and Perl library provided. Looks |
876
|
|
|
|
|
|
|
pretty awesome and something which I hope to use for more complex applications. |
877
|
|
|
|
|
|
|
|
878
|
|
|
|
|
|
|
=back |
879
|
|
|
|
|
|
|
|
880
|
|
|
|
|
|
|
=head1 AUTHOR |
881
|
|
|
|
|
|
|
|
882
|
|
|
|
|
|
|
perlancar <perlancar@cpan.org> |
883
|
|
|
|
|
|
|
|
884
|
|
|
|
|
|
|
=head1 COPYRIGHT AND LICENSE |
885
|
|
|
|
|
|
|
|
886
|
|
|
|
|
|
|
This software is copyright (c) 2019, 2018, 2017, 2015, 2014, 2013 by perlancar@cpan.org. |
887
|
|
|
|
|
|
|
|
888
|
|
|
|
|
|
|
This is free software; you can redistribute it and/or modify it under |
889
|
|
|
|
|
|
|
the same terms as the Perl 5 programming language system itself. |
890
|
|
|
|
|
|
|
|
891
|
|
|
|
|
|
|
=cut |