Line 0
Link Here
|
|
|
1 |
package C4::Update::Database; |
2 |
|
3 |
use Modern::Perl; |
4 |
|
5 |
use C4::Context; |
6 |
use C4::Config::File::YAML; |
7 |
|
8 |
use File::Basename; |
9 |
use Digest::MD5; |
10 |
use List::MoreUtils qw/uniq/; |
11 |
|
12 |
my $config = C4::Config::File::YAML->new( C4::Context->config("installdir") . qq{/etc/update/database/config.yaml} ); |
13 |
my $VERSIONS_PATH = C4::Context->config('intranetdir') . '/' . $config->{versions_dir}; |
14 |
|
15 |
my $version; |
16 |
my $list; |
17 |
|
18 |
my $dbh = C4::Context->dbh; |
19 |
|
20 |
sub get_filepath { |
21 |
my ( $version ) = @_; |
22 |
my @files = <$VERSIONS_PATH/$version*>; |
23 |
if ( scalar @files != 1 ) { |
24 |
die "This version ($version) returned more than one file (or any) corresponding!"; |
25 |
} |
26 |
|
27 |
return $files[0]; |
28 |
} |
29 |
|
30 |
sub get_md5 { |
31 |
my ( $filepath ) = @_; |
32 |
open(FILE, $filepath); |
33 |
|
34 |
my $ctx = Digest::MD5->new; |
35 |
$ctx->addfile(*FILE); |
36 |
my $md5 = $ctx->hexdigest; |
37 |
close(FILE); |
38 |
return $md5; |
39 |
} |
40 |
|
41 |
sub execute_version { |
42 |
my ( $version ) = @_; |
43 |
my $report; |
44 |
|
45 |
my $filepath; |
46 |
eval { |
47 |
$filepath = get_filepath $version; |
48 |
}; |
49 |
if ( $@ ) { |
50 |
return { $version => $@ }; |
51 |
} |
52 |
|
53 |
my @file_infos = fileparse( $filepath, qr/\.[^.]*/ ); |
54 |
my $extension = $file_infos[2]; |
55 |
my $filename = $version . $extension; |
56 |
|
57 |
my $md5 = get_md5 $filepath; |
58 |
my $r = md5_already_exists( $md5 ); |
59 |
if ( scalar @$r ) { |
60 |
my $p = @$r[0]; |
61 |
$$report{$version} = "This file ( $filepath ) still already execute in version " . @$r[0]->{version} . " : same md5 (" . @$r[0]->{md5} . ")"; |
62 |
return $report; |
63 |
} |
64 |
|
65 |
my $queries; |
66 |
given ( $extension ) { |
67 |
when ( /.sql/ ) { |
68 |
$queries = get_queries ( $filepath ); |
69 |
} |
70 |
when ( /.pl/ ) { |
71 |
my $versions_dir = C4::Context->intranetdir . '/installer/data/mysql/versions/'; |
72 |
my $version_file = $versions_dir . $filename; |
73 |
if ( do $version_file ) { |
74 |
$queries = _get_queries(); |
75 |
} else { |
76 |
$$report{$version} = "Load functions in $filename failed"; |
77 |
} |
78 |
} |
79 |
default { |
80 |
$$report{$version} = "This extension ($extension) is not take into account (only .pl or .sql)"; |
81 |
} |
82 |
} |
83 |
|
84 |
return $report |
85 |
if ( defined $$report{$version} ); |
86 |
|
87 |
my $errors; |
88 |
for my $query ( @{$$queries{queries}} ) { |
89 |
eval { |
90 |
check_coherency( $query ); |
91 |
}; |
92 |
if ( $@ ) { |
93 |
push @$errors, $@ |
94 |
} |
95 |
} |
96 |
|
97 |
if ( $errors ) { |
98 |
$_ =~ s/at [^ ]* line \d*\.$// for @$errors; |
99 |
$$report{$version} = $errors; |
100 |
return $report; |
101 |
} |
102 |
|
103 |
$errors = execute ( $queries ); |
104 |
$$report{$version} = scalar( @$errors ) ? $errors : "OK"; |
105 |
set_infos ( $version, $queries, $errors, $md5 ); |
106 |
|
107 |
return $report; |
108 |
} |
109 |
|
110 |
sub list_versions_availables { |
111 |
my @versions; |
112 |
opendir DH, $VERSIONS_PATH or die "Cannot open directory ($!)"; |
113 |
my @files = grep { !/^\.\.?$/ and /^.*\.(sql|pl)$/ and !/^skeleton/ } readdir DH; |
114 |
for my $f ( @files ) { |
115 |
my @file_infos = fileparse( $f, qr/\.[^.]*/ ); |
116 |
push @versions, $file_infos[0]; |
117 |
} |
118 |
@versions = uniq @versions; |
119 |
closedir DH; |
120 |
return \@versions; |
121 |
} |
122 |
|
123 |
sub list_versions_already_knows { |
124 |
my $query = qq/ SELECT version, comment, status FROM updatedb_report /; |
125 |
my $sth = $dbh->prepare( $query ); |
126 |
$sth->execute; |
127 |
my $versions = $sth->fetchall_arrayref( {} ); |
128 |
map { |
129 |
my $version = $_; |
130 |
my @comments = defined $$_{comment} ? split '\\\n', $$_{comment} : ""; |
131 |
push @{ $$version{comments} }, { comment => $_ } for @comments; |
132 |
delete $$version{comment}; |
133 |
} @$versions; |
134 |
$sth->finish; |
135 |
for my $version ( @$versions ) { |
136 |
$query = qq/ SELECT query FROM updatedb_query WHERE version = ? /; |
137 |
$sth = $dbh->prepare( $query ); |
138 |
$sth->execute( $$version{version} ); |
139 |
$$version{queries} = $sth->fetchall_arrayref( {} ); |
140 |
$sth->finish; |
141 |
$query = qq/ SELECT error FROM updatedb_error WHERE version = ? /; |
142 |
$sth = $dbh->prepare( $query ); |
143 |
$sth->execute( $$version{version} ); |
144 |
$$version{errors} = $sth->fetchall_arrayref( {} ); |
145 |
$sth->finish; |
146 |
} |
147 |
return $versions; |
148 |
} |
149 |
|
150 |
sub execute { |
151 |
my ( $queries ) = @_; |
152 |
my @errors; |
153 |
for my $query ( @{$$queries{queries}} ) { |
154 |
eval { |
155 |
$dbh->do( $query ); |
156 |
}; |
157 |
push @errors, get_error(); |
158 |
} |
159 |
return \@errors; |
160 |
} |
161 |
|
162 |
sub get_tables_name { |
163 |
my $sth = $dbh->prepare("SHOW TABLES"); |
164 |
$sth->execute(); |
165 |
my @tables; |
166 |
while ( my ( $table ) = $sth->fetchrow_array ) { |
167 |
push @tables, $table; |
168 |
} |
169 |
return \@tables; |
170 |
} |
171 |
my $tables; |
172 |
sub check_coherency { |
173 |
my ( $query ) = @_; |
174 |
$tables = get_tables_name() if not $tables; |
175 |
|
176 |
given ( $query ) { |
177 |
when ( /CREATE TABLE(?:.*?)? `?(\w+)`?/ ) { |
178 |
my $table_name = $1; |
179 |
if ( grep { /$table_name/ } @$tables ) { |
180 |
die "COHERENCY: Table $table_name already exists"; |
181 |
} |
182 |
} |
183 |
|
184 |
when ( /ALTER TABLE *`?(\w+)`? *ADD *(?:COLUMN)? `?(\w+)`?/ ) { |
185 |
my $table_name = $1; |
186 |
my $column_name = $2; |
187 |
next if $column_name =~ /(UNIQUE|CONSTRAINT|INDEX|KEY|FOREIGN)/; |
188 |
if ( not grep { /$table_name/ } @$tables ) { |
189 |
return "COHERENCY: Table $table_name does not exist"; |
190 |
} else { |
191 |
my $sth = $dbh->prepare( "DESC $table_name $column_name" ); |
192 |
my $rv = $sth->execute; |
193 |
if ( $rv > 0 ) { |
194 |
die "COHERENCY: Field $table_name.$column_name already exists"; |
195 |
} |
196 |
} |
197 |
} |
198 |
|
199 |
when ( /INSERT INTO `?(\w+)`?.*?VALUES *\((.*?)\)/ ) { |
200 |
my $table_name = $1; |
201 |
my @values = split /,/, $2; |
202 |
s/^ *'// foreach @values; |
203 |
s/' *$// foreach @values; |
204 |
given ( $table_name ) { |
205 |
when ( /systempreferences/ ) { |
206 |
my $syspref = $values[0]; |
207 |
my $sth = $dbh->prepare( "SELECT COUNT(*) FROM systempreferences WHERE variable = ?" ); |
208 |
$sth->execute( $syspref ); |
209 |
if ( ( my $count = $sth->fetchrow_array ) > 0 ) { |
210 |
die "COHERENCY: Syspref $syspref already exists"; |
211 |
} |
212 |
} |
213 |
|
214 |
when ( /permissions/){ |
215 |
my $module_bit = $values[0]; |
216 |
my $code = $values[1]; |
217 |
my $sth = $dbh->prepare( "SELECT COUNT(*) FROM permissions WHERE module_bit = ? AND code = ?" ); |
218 |
$sth->execute($module_bit, $code); |
219 |
if ( ( my $count = $sth->fetchrow_array ) > 0 ) { |
220 |
die "COHERENCY: Permission $code already exists"; |
221 |
} |
222 |
} |
223 |
} |
224 |
} |
225 |
} |
226 |
return 1; |
227 |
} |
228 |
|
229 |
sub get_error { |
230 |
my @errors = $dbh->selectrow_array(qq{SHOW ERRORS}); # Get errors |
231 |
my @warnings = $dbh->selectrow_array(qq{SHOW WARNINGS}); # Get warnings |
232 |
if ( @errors ) { # Catch specifics errors |
233 |
return qq{$errors[0] : $errors[1] => $errors[2]}; |
234 |
} elsif ( @warnings ) { |
235 |
return qq{$warnings[0] : $warnings[1] => $warnings[2]} |
236 |
if $warnings[0] ne 'Note'; |
237 |
} |
238 |
return; |
239 |
} |
240 |
|
241 |
sub get_queries { |
242 |
my ( $filepath ) = @_; |
243 |
open my $fh, "<", $filepath; |
244 |
my @queries; |
245 |
my @comments; |
246 |
my $old_delimiter = $/; |
247 |
while ( <$fh> ) { |
248 |
my $line = $_; |
249 |
chomp $line; |
250 |
$line =~ s/^\s*//; |
251 |
if ( $line =~ s/^--(.*)$// ) { |
252 |
push @comments, $1; |
253 |
next; |
254 |
} |
255 |
if ( $line =~ /^delimiter (.*)$/i ) { |
256 |
$/ = $1; |
257 |
next; |
258 |
} |
259 |
$line =~ s#$/##; |
260 |
push @queries, $line if not $line =~ /^\s*$/; # Push if query is not empty |
261 |
} |
262 |
$/ = $old_delimiter; |
263 |
close $fh; |
264 |
|
265 |
return { queries => \@queries, comments => \@comments }; |
266 |
} |
267 |
|
268 |
sub md5_already_exists { |
269 |
my ( $md5 ) = @_; |
270 |
my $query = qq/SELECT version, md5 FROM updatedb_report WHERE md5 = ?/; |
271 |
my $sth = $dbh->prepare( $query ); |
272 |
$sth->execute( $md5 ); |
273 |
my @r; |
274 |
while ( my ( $version, $md5 ) = $sth->fetchrow ) { |
275 |
push @r, { version => $version, md5 => $md5 }; |
276 |
} |
277 |
$sth->finish; |
278 |
return \@r; |
279 |
} |
280 |
|
281 |
sub set_infos { |
282 |
my ( $version, $queries, $errors, $md5 ) = @_; |
283 |
#SetVersion($DBversion) if not -s $errors; |
284 |
for my $query ( @{ $$queries{queries} } ) { |
285 |
my $sth = $dbh->prepare("INSERT INTO updatedb_query(version, query) VALUES (?, ?)"); |
286 |
$sth->execute( $version, $query ); |
287 |
$sth->finish; |
288 |
} |
289 |
for my $error ( @$errors ) { |
290 |
my $sth = $dbh->prepare("INSERT INTO updatedb_error(version, error) VALUES (?, ?)"); |
291 |
$sth->execute( $version, $error ); |
292 |
} |
293 |
my $sth = $dbh->prepare("INSERT INTO updatedb_report(version, md5, comment, status) VALUES (?, ?, ?, ?)"); |
294 |
$sth->execute( |
295 |
$version, |
296 |
$md5, |
297 |
join ('\n', @{ $$queries{comments} }), |
298 |
( @$errors > 0 ) ? 0 : 1 |
299 |
); |
300 |
} |
301 |
|
302 |
sub mark_as_ok { |
303 |
my ( $version ) = @_; |
304 |
my $sth = $dbh->prepare( "UPDATE updatedb_report SET status = 2 WHERE version=?" ); |
305 |
my $affected = $sth->execute( $version ); |
306 |
if ( $affected < 1 ) { |
307 |
# For "Coherency" |
308 |
my $filepath = get_filepath $version; |
309 |
my $queries = get_queries $filepath; |
310 |
my $errors; |
311 |
for my $query ( @{$$queries{queries}} ) { |
312 |
eval { |
313 |
check_coherency( $query ); |
314 |
}; |
315 |
if ( $@ ) { |
316 |
push @$errors, $@ |
317 |
} |
318 |
} |
319 |
|
320 |
$_ =~ s/at [^ ]* line \d*\.$// for @$errors; |
321 |
my $md5 = get_md5 $filepath; |
322 |
set_infos $version, $queries, $errors, $md5; |
323 |
|
324 |
$sth->execute( $version ); |
325 |
} |
326 |
$sth->finish; |
327 |
} |
328 |
|
329 |
=item TransformToNum |
330 |
|
331 |
Transform the Koha version from a 4 parts string |
332 |
to a number, with just 1 . |
333 |
|
334 |
=cut |
335 |
|
336 |
sub TransformToNum { |
337 |
my $version = shift; |
338 |
|
339 |
# remove the 3 last . to have a Perl number |
340 |
$version =~ s/(.*\..*)\.(.*)\.(.*)/$1$2$3/; |
341 |
return $version; |
342 |
} |
343 |
|
344 |
sub SetVersion { |
345 |
my $kohaversion = TransformToNum(shift); |
346 |
if ( C4::Context->preference('Version') ) { |
347 |
my $finish = $dbh->prepare("UPDATE systempreferences SET value=? WHERE variable='Version'"); |
348 |
$finish->execute($kohaversion); |
349 |
} else { |
350 |
my $finish = $dbh->prepare( |
351 |
"INSERT IGNORE INTO systempreferences (variable,value,explanation) values ('Version',?,'The Koha database version. WARNING: Do not change this value manually, it is maintained by the webinstaller')" |
352 |
); |
353 |
$finish->execute($kohaversion); |
354 |
} |
355 |
} |
356 |
|
357 |
1; |