Bug 13897: Use YAML files for installer data
[koha.git] / C4 / Installer.pm
blob6366cee04ed646f2db19dd5cbee46bb4e350ae21
1 package C4::Installer;
3 # Copyright (C) 2008 LibLime
5 # This file is part of Koha.
7 # Koha is free software; you can redistribute it and/or modify it
8 # under the terms of the GNU General Public License as published by
9 # the Free Software Foundation; either version 3 of the License, or
10 # (at your option) any later version.
12 # Koha is distributed in the hope that it will be useful, but
13 # WITHOUT ANY WARRANTY; without even the implied warranty of
14 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 # GNU General Public License for more details.
17 # You should have received a copy of the GNU General Public License
18 # along with Koha; if not, see <http://www.gnu.org/licenses>.
20 use Modern::Perl;
22 use Encode qw( encode is_utf8 );
23 use DBIx::RunSQL;
24 use YAML::Syck qw( LoadFile );
25 use C4::Context;
26 use DBI;
27 use Koha;
29 use vars qw(@ISA @EXPORT);
30 BEGIN {
31 require Exporter;
32 @ISA = qw( Exporter );
33 push @EXPORT, qw( foreign_key_exists index_exists column_exists TableExists);
36 =head1 NAME
38 C4::Installer
40 =head1 SYNOPSIS
42 use C4::Installer;
43 my $installer = C4::Installer->new();
44 my $all_languages = getAllLanguages();
45 my $error = $installer->load_db_schema();
46 my $list;
47 #fill $list with list of sql files
48 my ($fwk_language, $error_list) = $installer->load_sql_in_order($all_languages, @$list);
49 $installer->set_version_syspref();
50 $installer->set_marcflavour_syspref('MARC21');
52 =head1 DESCRIPTION
54 =cut
56 =head1 METHODS
58 =head2 new
60 my $installer = C4::Installer->new();
62 Creates a new installer.
64 =cut
66 sub new {
67 my $class = shift;
69 my $self = {};
71 # get basic information from context
72 $self->{'dbname'} = C4::Context->config("database");
73 $self->{'dbms'} = C4::Context->config("db_scheme") ? C4::Context->config("db_scheme") : "mysql";
74 $self->{'hostname'} = C4::Context->config("hostname");
75 $self->{'port'} = C4::Context->config("port");
76 $self->{'user'} = C4::Context->config("user");
77 $self->{'password'} = C4::Context->config("pass");
78 $self->{'tls'} = C4::Context->config("tls");
79 if( $self->{'tls'} && $self->{'tls'} eq 'yes' ) {
80 $self->{'ca'} = C4::Context->config('ca');
81 $self->{'cert'} = C4::Context->config('cert');
82 $self->{'key'} = C4::Context->config('key');
83 $self->{'tlsoptions'} = ";mysql_ssl=1;mysql_ssl_client_key=".$self->{key}.";mysql_ssl_client_cert=".$self->{cert}.";mysql_ssl_ca_file=".$self->{ca};
84 $self->{'tlscmdline'} = " --ssl-cert ". $self->{cert} . " --ssl-key " . $self->{key} . " --ssl-ca ".$self->{ca}." "
86 $self->{'dbh'} = DBI->connect("DBI:$self->{dbms}:dbname=$self->{dbname};host=$self->{hostname}" .
87 ( $self->{port} ? ";port=$self->{port}" : "" ).
88 ( $self->{tlsoptions} ? $self->{tlsoptions} : ""),
89 $self->{'user'}, $self->{'password'});
90 $self->{'language'} = undef;
91 $self->{'marcflavour'} = undef;
92 $self->{'dbh'}->do('set NAMES "utf8"');
93 $self->{'dbh'}->{'mysql_enable_utf8'}=1;
95 bless $self, $class;
96 return $self;
99 =head2 marc_framework_sql_list
101 my ($defaulted_to_en, $list) =
102 $installer->marc_framework_sql_list($lang, $marcflavour);
104 Returns in C<$list> a structure listing the filename, description, section,
105 and mandatory/optional status of MARC framework scripts available for C<$lang>
106 and C<$marcflavour>.
108 If the C<$defaulted_to_en> return value is true, no scripts are available
109 for language C<$lang> and the 'en' ones are returned.
111 =cut
113 sub marc_framework_sql_list {
114 my $self = shift;
115 my $lang = shift;
116 my $marcflavour = shift;
118 my $defaulted_to_en = 0;
120 undef $/;
121 my $dir = C4::Context->config('intranetdir') . "/installer/data/$self->{dbms}/$lang/marcflavour/".lc($marcflavour);
122 unless (opendir( MYDIR, $dir )) {
123 if ($lang eq 'en') {
124 warn "cannot open MARC frameworks directory $dir";
125 } else {
126 # if no translated MARC framework is available,
127 # default to English
128 $dir = C4::Context->config('intranetdir') . "/installer/data/$self->{dbms}/en/marcflavour/".lc($marcflavour);
129 opendir(MYDIR, $dir) or warn "cannot open English MARC frameworks directory $dir";
130 $defaulted_to_en = 1;
133 my @listdir = sort grep { !/^\.|marcflavour/ && -d "$dir/$_" } readdir(MYDIR);
134 closedir MYDIR;
136 my @fwklist;
137 my $request = $self->{'dbh'}->prepare("SELECT value FROM systempreferences WHERE variable='FrameworksLoaded'");
138 $request->execute;
139 my ($frameworksloaded) = $request->fetchrow;
140 $frameworksloaded = '' unless defined $frameworksloaded; # avoid warning
141 my %frameworksloaded;
142 foreach ( split( /\|/, $frameworksloaded ) ) {
143 $frameworksloaded{$_} = 1;
146 foreach my $requirelevel (@listdir) {
147 opendir( MYDIR, "$dir/$requirelevel" );
148 my @listname = grep { !/^\./ && -f "$dir/$requirelevel/$_" && $_ =~ m/\.(sql|yml)$/ } readdir(MYDIR);
149 closedir MYDIR;
150 my %cell;
151 my @frameworklist;
152 map {
153 my $name = substr( $_, 0, -4 ); # FIXME: restricted to 3 letter extension
154 open my $fh, "<:encoding(UTF-8)", "$dir/$requirelevel/$name.txt";
155 my $line = <$fh>;
156 $line = Encode::encode('UTF-8', $line) unless ( Encode::is_utf8($line) );
157 my @lines = split /\n/, $line;
158 my $mandatory = ($requirelevel =~ /(mandatory|requi|oblig|necess)/i);
159 push @frameworklist,
161 'fwkname' => $name,
162 'fwkfile' => "$dir/$requirelevel/$_",
163 'fwkdescription' => \@lines,
164 'checked' => ( ( $frameworksloaded{$_} || $mandatory ) ? 1 : 0 ),
165 'mandatory' => $mandatory,
167 } @listname;
168 my @fwks =
169 sort { $a->{'fwkname'} cmp $b->{'fwkname'} } @frameworklist;
171 $cell{"frameworks"} = \@fwks;
172 $cell{"label"} = ucfirst($requirelevel);
173 $cell{"code"} = lc($requirelevel);
174 push @fwklist, \%cell;
177 return ($defaulted_to_en, \@fwklist);
180 =head2 sample_data_sql_list
182 my ($defaulted_to_en, $list) = $installer->sample_data_sql_list($lang);
184 Returns in C<$list> a structure listing the filename, description, section,
185 and mandatory/optional status of sample data scripts available for C<$lang>.
186 If the C<$defaulted_to_en> return value is true, no scripts are available
187 for language C<$lang> and the 'en' ones are returned.
189 =cut
191 sub sample_data_sql_list {
192 my $self = shift;
193 my $lang = shift;
195 my $defaulted_to_en = 0;
197 undef $/;
198 my $dir = C4::Context->config('intranetdir') . "/installer/data/$self->{dbms}/$lang";
199 unless (opendir( MYDIR, $dir )) {
200 if ($lang eq 'en') {
201 warn "cannot open sample data directory $dir";
202 } else {
203 # if no sample data is available,
204 # default to English
205 $dir = C4::Context->config('intranetdir') . "/installer/data/$self->{dbms}/en";
206 opendir(MYDIR, $dir) or warn "cannot open English sample data directory $dir";
207 $defaulted_to_en = 1;
210 my @listdir = sort grep { !/^\.|marcflavour/ && -d "$dir/$_" } readdir(MYDIR);
211 closedir MYDIR;
213 my @levellist;
214 my $request = $self->{'dbh'}->prepare("SELECT value FROM systempreferences WHERE variable='FrameworksLoaded'");
215 $request->execute;
216 my ($frameworksloaded) = $request->fetchrow;
217 $frameworksloaded = '' unless defined $frameworksloaded; # avoid warning
218 my %frameworksloaded;
219 foreach ( split( /\|/, $frameworksloaded ) ) {
220 $frameworksloaded{$_} = 1;
223 foreach my $requirelevel (@listdir) {
224 opendir( MYDIR, "$dir/$requirelevel" );
225 my @listname = grep { !/^\./ && -f "$dir/$requirelevel/$_" && $_ =~ m/\.(sql|yml)$/ } readdir(MYDIR);
226 closedir MYDIR;
227 my %cell;
228 my @frameworklist;
229 map {
230 my ( $name, $ext ) = split /\./, $_;
231 my @lines;
232 if ( $ext =~ /yml/ ) {
233 my $yaml = LoadFile("$dir/$requirelevel/$name\.$ext");
234 @lines = @{ $yaml->{'description'} };
235 } else {
236 open my $fh, "<:encoding(UTF-8)", "$dir/$requirelevel/$name.txt";
237 my $line = <$fh>;
238 $line = Encode::encode('UTF-8', $line) unless ( Encode::is_utf8($line) );
239 @lines = split /\n/, $line;
241 my $mandatory = ($requirelevel =~ /(mandatory|requi|oblig|necess)/i);
242 push @frameworklist,
244 'fwkname' => $name,
245 'fwkfile' => "$dir/$requirelevel/$_",
246 'fwkdescription' => \@lines,
247 'checked' => ( ( $frameworksloaded{$_} || $mandatory ) ? 1 : 0 ),
248 'mandatory' => $mandatory,
250 } @listname;
251 my @fwks = sort { $a->{'fwkname'} cmp $b->{'fwkname'} } @frameworklist;
253 $cell{"frameworks"} = \@fwks;
254 $cell{"label"} = ucfirst($requirelevel);
255 $cell{"code"} = lc($requirelevel);
256 push @levellist, \%cell;
259 return ($defaulted_to_en, \@levellist);
262 =head2 load_db_schema
264 my $error = $installer->load_db_schema();
266 Loads the SQL script that creates Koha's tables and indexes. The
267 return value is a string containing error messages reported by the
268 load.
270 =cut
272 sub load_db_schema {
273 my $self = shift;
275 my $datadir = C4::Context->config('intranetdir') . "/installer/data/$self->{dbms}";
276 my $error = $self->load_sql("$datadir/kohastructure.sql");
277 return $error;
281 =head2 load_sql_in_order
283 my ($fwk_language, $list) = $installer->load_sql_in_order($all_languages, @sql_list);
285 Given a list of SQL scripts supplied in C<@sql_list>, loads each of them
286 into the database and sets the FrameworksLoaded system preference to names
287 of the scripts that were loaded.
289 The SQL files are loaded in alphabetical order by filename (not including
290 directory path). This means that dependencies among the scripts are to
291 be resolved by carefully naming them, keeping in mind that the directory name
292 does *not* currently count.
294 B<FIXME:> this is a rather delicate way of dealing with dependencies between
295 the install scripts.
297 The return value C<$list> is an arrayref containing a hashref for each
298 "level" or directory containing SQL scripts; the hashref in turns contains
299 a list of hashrefs containing a list of each script load and any error
300 messages associated with the loading of each script.
302 B<FIXME:> The C<$fwk_language> code probably doesn't belong and needs to be
303 moved to a different method.
305 =cut
307 sub load_sql_in_order {
308 my $self = shift;
309 my $all_languages = shift;
310 my @sql_list = @_;
312 my $lang;
313 my %hashlevel;
314 my @fnames = sort {
315 my @aa = split /\/|\\/, ($a);
316 my @bb = split /\/|\\/, ($b);
317 $aa[-1] cmp $bb[-1]
318 } @sql_list;
319 my $request = $self->{'dbh'}->prepare( "SELECT value FROM systempreferences WHERE variable='FrameworksLoaded'" );
320 $request->execute;
321 my ($systempreference) = $request->fetchrow;
322 $systempreference = '' unless defined $systempreference; # avoid warning
324 my $global_mandatory_dir = C4::Context->config('intranetdir') . "/installer/data/$self->{dbms}/mandatory";
326 # Make sure some stuffs are loaded first
327 unshift(@fnames, C4::Context->config('intranetdir') . "/installer/data/$self->{dbms}/sysprefs.sql");
328 unshift(@fnames,
329 "$global_mandatory_dir/subtag_registry.sql",
330 "$global_mandatory_dir/auth_val_cat.sql",
331 "$global_mandatory_dir/message_transport_types.sql",
332 "$global_mandatory_dir/sample_notices_message_attributes.sql",
333 "$global_mandatory_dir/sample_notices_message_transports.sql",
334 "$global_mandatory_dir/keyboard_shortcuts.sql",
337 push @fnames, C4::Context->config('intranetdir') . "/installer/data/mysql/userflags.sql";
338 push @fnames, C4::Context->config('intranetdir') . "/installer/data/mysql/userpermissions.sql";
339 push @fnames, C4::Context->config('intranetdir') . "/installer/data/mysql/audio_alerts.sql";
340 push @fnames, C4::Context->config('intranetdir') . "/installer/data/mysql/account_offset_types.sql";
341 push @fnames, C4::Context->config('intranetdir') . "/installer/data/mysql/account_credit_types.sql";
342 push @fnames, C4::Context->config('intranetdir') . "/installer/data/mysql/account_debit_types.sql";
343 foreach my $file (@fnames) {
344 # warn $file;
345 undef $/;
346 my $error = $self->load_sql($file);
347 my @file = split qr(\/|\\), $file;
348 $lang = $file[ scalar(@file) - 3 ] unless ($lang);
349 my $level = $file[ scalar(@file) - 2 ];
350 unless ($error) {
351 $systempreference .= "$file[scalar(@file)-1]|"
352 unless ( index( $systempreference, $file[ scalar(@file) - 1 ] ) >= 0 );
355 #Bulding here a hierarchy to display files by level.
356 push @{ $hashlevel{$level} },
357 { "fwkname" => $file[ scalar(@file) - 1 ], "error" => $error };
360 #systempreference contains an ending |
361 chop $systempreference;
362 my @list;
363 map { push @list, { "level" => $_, "fwklist" => $hashlevel{$_} } } keys %hashlevel;
364 my $fwk_language;
365 for my $each_language (@$all_languages) {
367 # warn "CODE".$each_language->{'language_code'};
368 # warn "LANG:".$lang;
369 if ( $lang eq $each_language->{'language_code'} ) {
370 $fwk_language = $each_language->{language_locale_name};
373 my $updateflag =
374 $self->{'dbh'}->do(
375 "UPDATE systempreferences set value=\"$systempreference\" where variable='FrameworksLoaded'"
378 unless ( $updateflag == 1 ) {
379 my $string =
380 "INSERT INTO systempreferences (value, variable, explanation, type) VALUES (\"$systempreference\",'FrameworksLoaded','Frameworks loaded through webinstaller','choice')";
381 my $rq = $self->{'dbh'}->prepare($string);
382 $rq->execute;
384 return ($fwk_language, \@list);
387 =head2 set_marcflavour_syspref
389 $installer->set_marcflavour_syspref($marcflavour);
391 Set the 'marcflavour' system preference. The incoming
392 C<$marcflavour> references to a subdirectory of
393 installer/data/$dbms/$lang/marcflavour, and is
394 normalized to MARC21, UNIMARC or NORMARC.
396 FIXME: this method assumes that the MARC flavour will be either
397 MARC21, UNIMARC or NORMARC.
399 =cut
401 sub set_marcflavour_syspref {
402 my $self = shift;
403 my $marcflavour = shift;
405 # we can have some variants of marc flavour, by having different directories, like : unimarc_small and unimarc_full, for small and complete unimarc frameworks.
406 # marc_cleaned finds the marcflavour, without the variant.
407 my $marc_cleaned = 'MARC21';
408 $marc_cleaned = 'UNIMARC' if $marcflavour =~ /unimarc/i;
409 $marc_cleaned = 'NORMARC' if $marcflavour =~ /normarc/i;
410 my $request =
411 $self->{'dbh'}->prepare(
412 "INSERT IGNORE INTO `systempreferences` (variable,value,explanation,options,type) VALUES('marcflavour','$marc_cleaned','Define global MARC flavor (MARC21, UNIMARC or NORMARC) used for character encoding','MARC21|UNIMARC|NORMARC','Choice');"
414 $request->execute;
417 =head2 set_version_syspref
419 $installer->set_version_syspref();
421 Set or update the 'Version' system preference to the current
422 Koha software version.
424 =cut
426 sub set_version_syspref {
427 my $self = shift;
429 my $kohaversion = Koha::version();
430 # remove the 3 last . to have a Perl number
431 $kohaversion =~ s/(.*\..*)\.(.*)\.(.*)/$1$2$3/;
432 if (C4::Context->preference('Version')) {
433 warn "UPDATE Version";
434 my $finish=$self->{'dbh'}->prepare("UPDATE systempreferences SET value=? WHERE variable='Version'");
435 $finish->execute($kohaversion);
436 } else {
437 warn "INSERT Version";
438 my $finish=$self->{'dbh'}->prepare("INSERT into systempreferences (variable,value,explanation) values ('Version',?,'The Koha database version. WARNING: Do not change this value manually, it is maintained by the webinstaller')");
439 $finish->execute($kohaversion);
441 C4::Context->clear_syspref_cache();
444 =head2 load_sql
446 my $error = $installer->load_sql($filename);
448 Runs the specified input file using a sql loader DBIx::RunSQL, or a yaml loader
449 Returns any strings sent to STDERR
451 # FIXME This should be improved: sometimes the caller and load_sql warn the same
452 error.
454 =cut
456 sub load_sql {
457 my $self = shift;
458 my $filename = shift;
459 my $error;
461 my $dbh = $self->{ dbh };
463 my $dup_stderr;
464 do {
465 local *STDERR;
466 open STDERR, ">>", \$dup_stderr;
468 if ( $filename =~ /sql$/ ) { # SQL files
469 eval {
470 DBIx::RunSQL->run_sql_file(
471 dbh => $dbh,
472 sql => $filename,
476 else { # YAML files
477 eval {
478 my $yaml = LoadFile( $filename ); # Load YAML
479 for my $table ( @{ $yaml->{'tables'} } ) {
480 my $table_name = ( keys %$table )[0]; # table name
481 my @rows = @{ $table->{$table_name}->{rows} }; #
482 my @columns = ( sort keys %{$rows[0]} ); # column names
483 my $fields = join ",", @columns; # idem, joined
484 my $placeholders = join ",", map { "?" } @columns; # '?,..,?' string
485 my $query = "INSERT INTO $table_name ( $fields ) VALUES ( $placeholders )";
486 my $sth = $dbh->prepare($query);
487 foreach my $row ( @rows ) {
488 my @values = map { $row->{$_} } @columns;
489 $sth->execute( @values );
495 # errors thrown while loading installer data should be logged
496 if( $dup_stderr ) {
497 warn "C4::Installer::load_sql returned the following errors while attempting to load $filename:\n";
498 $error = $dup_stderr;
501 return $error;
504 =head2 get_file_path_from_name
506 my $filename = $installer->get_file_path_from_name('script_name');
508 searches through the set of known SQL scripts and finds the fully
509 qualified path name for the script that mathches the input.
511 returns undef if no match was found.
514 =cut
516 sub get_file_path_from_name {
517 my $self = shift;
518 my $partialname = shift;
520 my $lang = 'en'; # FIXME: how do I know what language I want?
522 my ($defaulted_to_en, $list) = $self->sample_data_sql_list($lang);
523 # warn( Data::Dumper->Dump( [ $list ], [ 'list' ] ) );
525 my @found;
526 foreach my $frameworklist ( @$list ) {
527 push @found, grep { $_->{'fwkfile'} =~ /$partialname$/ } @{$frameworklist->{'frameworks'}};
530 # warn( Data::Dumper->Dump( [ \@found ], [ 'found' ] ) );
531 if ( 0 == scalar @found ) {
532 return;
533 } elsif ( 1 < scalar @found ) {
534 warn "multiple results found for $partialname";
535 return;
536 } else {
537 return $found[0]->{'fwkfile'};
542 sub foreign_key_exists {
543 my ( $table_name, $constraint_name ) = @_;
544 my $dbh = C4::Context->dbh;
545 my (undef, $infos) = $dbh->selectrow_array(qq|SHOW CREATE TABLE $table_name|);
546 return $infos =~ m|CONSTRAINT `$constraint_name` FOREIGN KEY|;
549 sub index_exists {
550 my ( $table_name, $key_name ) = @_;
551 my $dbh = C4::Context->dbh;
552 my ($exists) = $dbh->selectrow_array(
554 SHOW INDEX FROM $table_name
555 WHERE key_name = ?
556 |, undef, $key_name
558 return $exists;
561 sub column_exists {
562 my ( $table_name, $column_name ) = @_;
563 return unless TableExists($table_name);
564 my $dbh = C4::Context->dbh;
565 my ($exists) = $dbh->selectrow_array(
567 SHOW COLUMNS FROM $table_name
568 WHERE Field = ?
569 |, undef, $column_name
571 return $exists;
574 sub TableExists { # Could be renamed table_exists for consistency
575 my $table = shift;
576 eval {
577 my $dbh = C4::Context->dbh;
578 local $dbh->{PrintError} = 0;
579 local $dbh->{RaiseError} = 1;
580 $dbh->do(qq{SELECT * FROM $table WHERE 1 = 0 });
582 return 1 unless $@;
583 return 0;
587 =head1 AUTHOR
589 C4::Installer is a refactoring of logic originally from installer/installer.pl, which was
590 originally written by Henri-Damien Laurant.
592 Koha Development Team <http://koha-community.org/>
594 Galen Charlton <galen.charlton@liblime.com>
596 =cut