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>.
22 use Encode qw( encode is_utf8 );
29 use vars qw(@ISA @EXPORT);
32 @ISA = qw( Exporter );
33 push @EXPORT, qw( primary_key_exists foreign_key_exists index_exists column_exists TableExists);
43 my $installer = C4::Installer->new();
44 my $all_languages = getAllLanguages();
45 my $error = $installer->load_db_schema();
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');
60 my $installer = C4::Installer->new();
62 Creates a new installer.
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;
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>
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.
113 sub marc_framework_sql_list {
116 my $marcflavour = shift;
118 my $defaulted_to_en = 0;
121 my $dir = C4::Context->config('intranetdir') . "/installer/data/$self->{dbms}/$lang/marcflavour/".lc($marcflavour);
122 unless (opendir( MYDIR, $dir )) {
124 warn "cannot open MARC frameworks directory $dir";
126 # if no translated MARC framework is available,
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);
137 my $request = $self->{'dbh'}->prepare("SELECT value FROM systempreferences WHERE variable='FrameworksLoaded'");
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);
153 my ( $name, $ext ) = split /\./, $_;
155 if ( $ext =~ /yml/ ) {
156 my $yaml = YAML::XS::LoadFile("$dir/$requirelevel/$name\.$ext");
157 @lines = @{ $yaml->{'description'} };
159 open my $fh, "<:encoding(UTF-8)", "$dir/$requirelevel/$name.txt";
161 $line = Encode::encode('UTF-8', $line) unless ( Encode::is_utf8($line) );
162 @lines = split /\n/, $line;
164 my $mandatory = ($requirelevel =~ /(mandatory|requi|oblig|necess)/i);
168 'fwkfile' => "$dir/$requirelevel/$_",
169 'fwkdescription' => \@lines,
170 'checked' => ( ( $frameworksloaded{$_} || $mandatory ) ? 1 : 0 ),
171 'mandatory' => $mandatory,
175 sort { $a->{'fwkname'} cmp $b->{'fwkname'} } @frameworklist;
177 $cell{"frameworks"} = \@fwks;
178 $cell{"label"} = ($requirelevel =~ /(mandatory|requi|oblig|necess)/i)?'mandatory':'optional';
179 $cell{"code"} = lc($requirelevel);
180 push @fwklist, \%cell;
183 return ($defaulted_to_en, \@fwklist);
186 =head2 sample_data_sql_list
188 my ($defaulted_to_en, $list) = $installer->sample_data_sql_list($lang);
190 Returns in C<$list> a structure listing the filename, description, section,
191 and mandatory/optional status of sample data scripts available for C<$lang>.
192 If the C<$defaulted_to_en> return value is true, no scripts are available
193 for language C<$lang> and the 'en' ones are returned.
197 sub sample_data_sql_list {
201 my $defaulted_to_en = 0;
204 my $dir = C4::Context->config('intranetdir') . "/installer/data/$self->{dbms}/$lang";
205 unless (opendir( MYDIR, $dir )) {
207 warn "cannot open sample data directory $dir";
209 # if no sample data is available,
211 $dir = C4::Context->config('intranetdir') . "/installer/data/$self->{dbms}/en";
212 opendir(MYDIR, $dir) or warn "cannot open English sample data directory $dir";
213 $defaulted_to_en = 1;
216 my @listdir = sort grep { !/^\.|marcflavour/ && -d "$dir/$_" } readdir(MYDIR);
220 my $request = $self->{'dbh'}->prepare("SELECT value FROM systempreferences WHERE variable='FrameworksLoaded'");
222 my ($frameworksloaded) = $request->fetchrow;
223 $frameworksloaded = '' unless defined $frameworksloaded; # avoid warning
224 my %frameworksloaded;
225 foreach ( split( /\|/, $frameworksloaded ) ) {
226 $frameworksloaded{$_} = 1;
229 foreach my $requirelevel (@listdir) {
230 opendir( MYDIR, "$dir/$requirelevel" );
231 my @listname = grep { !/^\./ && -f "$dir/$requirelevel/$_" && $_ =~ m/\.(sql|yml)$/ } readdir(MYDIR);
236 my ( $name, $ext ) = split /\./, $_;
238 if ( $ext =~ /yml/ ) {
239 my $yaml = YAML::XS::LoadFile("$dir/$requirelevel/$name\.$ext");
240 @lines = @{ $yaml->{'description'} };
242 open my $fh, "<:encoding(UTF-8)", "$dir/$requirelevel/$name.txt";
244 $line = Encode::encode('UTF-8', $line) unless ( Encode::is_utf8($line) );
245 @lines = split /\n/, $line;
247 my $mandatory = ($requirelevel =~ /(mandatory|requi|oblig|necess)/i);
251 'fwkfile' => "$dir/$requirelevel/$_",
252 'fwkdescription' => \@lines,
253 'checked' => ( ( $frameworksloaded{$_} || $mandatory ) ? 1 : 0 ),
254 'mandatory' => $mandatory,
257 my @fwks = sort { $a->{'fwkname'} cmp $b->{'fwkname'} } @frameworklist;
259 $cell{"frameworks"} = \@fwks;
260 $cell{"label"} = ($requirelevel =~ /(mandatory|requi|oblig|necess)/i)?'mandatory':'optional';
261 $cell{"code"} = lc($requirelevel);
262 push @levellist, \%cell;
265 return ($defaulted_to_en, \@levellist);
268 =head2 load_db_schema
270 my $error = $installer->load_db_schema();
272 Loads the SQL script that creates Koha's tables and indexes. The
273 return value is a string containing error messages reported by the
281 my $datadir = C4::Context->config('intranetdir') . "/installer/data/$self->{dbms}";
283 # Disable checks before load
284 $self->{'dbh'}->do(q{SET NAMES utf8mb4});
285 $self->{'dbh'}->do(q{SET @OLD_UNIQUE_CHECKS=@@UNIQUE_CHECKS, UNIQUE_CHECKS=0});
286 $self->{'dbh'}->do(q{SET @OLD_FOREIGN_KEY_CHECKS=@@FOREIGN_KEY_CHECKS, FOREIGN_KEY_CHECKS=0});
287 $self->{'dbh'}->do(q{SET @OLD_SQL_MODE=@@SQL_MODE, SQL_MODE='NO_AUTO_VALUE_ON_ZERO'});
288 $self->{'dbh'}->do(q{SET @OLD_SQL_NOTES=@@SQL_NOTES, SQL_NOTES=0});
291 my $error = $self->load_sql("$datadir/kohastructure.sql");
293 # Re-enable checks after load
294 $self->{'dbh'}->do(q{SET SQL_MODE=@OLD_SQL_MODE});
295 $self->{'dbh'}->do(q{SET FOREIGN_KEY_CHECKS=@OLD_FOREIGN_KEY_CHECKS});
296 $self->{'dbh'}->do(q{SET UNIQUE_CHECKS=@OLD_UNIQUE_CHECKS});
297 $self->{'dbh'}->do(q{SET SQL_NOTES=@OLD_SQL_NOTES});
303 =head2 load_sql_in_order
305 my ($fwk_language, $list) = $installer->load_sql_in_order($all_languages, @sql_list);
307 Given a list of SQL scripts supplied in C<@sql_list>, loads each of them
308 into the database and sets the FrameworksLoaded system preference to names
309 of the scripts that were loaded.
311 The SQL files are loaded in alphabetical order by filename (not including
312 directory path). This means that dependencies among the scripts are to
313 be resolved by carefully naming them, keeping in mind that the directory name
314 does *not* currently count.
316 B<FIXME:> this is a rather delicate way of dealing with dependencies between
319 The return value C<$list> is an arrayref containing a hashref for each
320 "level" or directory containing SQL scripts; the hashref in turns contains
321 a list of hashrefs containing a list of each script load and any error
322 messages associated with the loading of each script.
324 B<FIXME:> The C<$fwk_language> code probably doesn't belong and needs to be
325 moved to a different method.
329 sub load_sql_in_order {
331 my $langchoice = shift;
332 my $all_languages = shift;
338 my @aa = split /\/|\\/, ($a);
339 my @bb = split /\/|\\/, ($b);
342 my $request = $self->{'dbh'}->prepare( "SELECT value FROM systempreferences WHERE variable='FrameworksLoaded'" );
344 my ($systempreference) = $request->fetchrow;
345 $systempreference = '' unless defined $systempreference; # avoid warning
347 my $global_mandatory_dir = C4::Context->config('intranetdir') . "/installer/data/$self->{dbms}/mandatory";
349 # Make sure some stuffs are loaded first
351 "$global_mandatory_dir/sysprefs.sql",
352 "$global_mandatory_dir/subtag_registry.sql",
353 "$global_mandatory_dir/auth_val_cat.sql",
354 "$global_mandatory_dir/message_transport_types.sql",
355 "$global_mandatory_dir/sample_notices_message_attributes.sql",
356 "$global_mandatory_dir/sample_notices_message_transports.sql",
357 "$global_mandatory_dir/keyboard_shortcuts.sql",
360 push @fnames, "$global_mandatory_dir/userflags.sql",
361 "$global_mandatory_dir/userpermissions.sql",
362 "$global_mandatory_dir/audio_alerts.sql",
363 "$global_mandatory_dir/account_offset_types.sql",
364 "$global_mandatory_dir/account_credit_types.sql",
365 "$global_mandatory_dir/account_debit_types.sql",
367 my $localization_file = C4::Context->config('intranetdir') .
368 "/installer/data/$self->{dbms}/localization/$langchoice/custom.sql";
369 if ( $langchoice ne 'en' and -f $localization_file ) {
370 push @fnames, $localization_file;
372 foreach my $file (@fnames) {
375 my $error = $self->load_sql($file);
376 my @file = split qr(\/|\\), $file;
377 $lang = $file[ scalar(@file) - 3 ] unless ($lang);
378 my $level = ( $file =~ /(localization)/ ) ? $1 : $file[ scalar(@file) - 2 ];
380 $systempreference .= "$file[scalar(@file)-1]|"
381 unless ( index( $systempreference, $file[ scalar(@file) - 1 ] ) >= 0 );
384 #Bulding here a hierarchy to display files by level.
385 push @{ $hashlevel{$level} },
386 { "fwkname" => $file[ scalar(@file) - 1 ], "error" => $error };
389 #systempreference contains an ending |
390 chop $systempreference;
392 map { push @list, { "level" => $_, "fwklist" => $hashlevel{$_} } } keys %hashlevel;
394 for my $each_language (@$all_languages) {
396 # warn "CODE".$each_language->{'language_code'};
397 # warn "LANG:".$lang;
398 if ( $lang eq $each_language->{'language_code'} ) {
399 $fwk_language = $each_language->{language_locale_name};
404 "UPDATE systempreferences set value=\"$systempreference\" where variable='FrameworksLoaded'"
407 unless ( $updateflag == 1 ) {
409 "INSERT INTO systempreferences (value, variable, explanation, type) VALUES (\"$systempreference\",'FrameworksLoaded','Frameworks loaded through webinstaller','choice')";
410 my $rq = $self->{'dbh'}->prepare($string);
413 return ($fwk_language, \@list);
416 =head2 set_marcflavour_syspref
418 $installer->set_marcflavour_syspref($marcflavour);
420 Set the 'marcflavour' system preference. The incoming
421 C<$marcflavour> references to a subdirectory of
422 installer/data/$dbms/$lang/marcflavour, and is
423 normalized to MARC21, UNIMARC or NORMARC.
425 FIXME: this method assumes that the MARC flavour will be either
426 MARC21, UNIMARC or NORMARC.
430 sub set_marcflavour_syspref {
432 my $marcflavour = shift;
434 # we can have some variants of marc flavour, by having different directories, like : unimarc_small and unimarc_full, for small and complete unimarc frameworks.
435 # marc_cleaned finds the marcflavour, without the variant.
436 my $marc_cleaned = 'MARC21';
437 $marc_cleaned = 'UNIMARC' if $marcflavour =~ /unimarc/i;
438 $marc_cleaned = 'NORMARC' if $marcflavour =~ /normarc/i;
440 $self->{'dbh'}->prepare(
441 "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');"
446 =head2 set_version_syspref
448 $installer->set_version_syspref();
450 Set or update the 'Version' system preference to the current
451 Koha software version.
455 sub set_version_syspref {
458 my $kohaversion = Koha::version();
459 # remove the 3 last . to have a Perl number
460 $kohaversion =~ s/(.*\..*)\.(.*)\.(.*)/$1$2$3/;
461 if (C4::Context->preference('Version')) {
462 warn "UPDATE Version";
463 my $finish=$self->{'dbh'}->prepare("UPDATE systempreferences SET value=? WHERE variable='Version'");
464 $finish->execute($kohaversion);
466 warn "INSERT Version";
467 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')");
468 $finish->execute($kohaversion);
470 C4::Context->clear_syspref_cache();
473 =head2 set_languages_syspref
475 $installer->set_languages_syspref();
477 Add the installation language to 'language' and 'OPACLanguages' system preferences
478 if different from 'en'
482 sub set_languages_syspref {
484 my $language = shift;
486 return if ( not $language or $language eq 'en' );
488 warn "UPDATE Languages";
490 my $pref = $self->{'dbh'}->prepare("UPDATE systempreferences SET value=? WHERE variable='language'");
491 $pref->execute("en,$language");
493 $pref = $self->{'dbh'}->prepare("UPDATE systempreferences SET value=? WHERE variable='OPACLanguages'");
494 $pref->execute("en,$language");
496 C4::Context->clear_syspref_cache();
499 =head2 process_yml_table
501 my $query_info = $installer->process_yml_table($table);
503 Analyzes a table loaded in YAML format.
504 Returns the values required to build an insert statement.
508 sub process_yml_table {
510 my $table_name = ( keys %$table )[0]; # table name
511 my @rows = @{ $table->{$table_name}->{rows} }; #
512 my @columns = ( sort keys %{$rows[0]} ); # column names
513 my $fields = join ",", map{sprintf("`%s`", $_)} @columns; # idem, joined
514 my $query = "INSERT INTO $table_name ( $fields ) VALUES ";
515 my @multiline = @{ $table->{$table_name}->{'multiline'} }; # to check multiline values;
516 my $placeholders = '(' . join ( ",", map { "?" } @columns ) . ')'; # '(?,..,?)' string
518 foreach my $row ( @rows ) {
519 push @values, [ map {
521 ( @multiline and grep { $_ eq $col } @multiline )
522 ? join "\r\n", @{$row->{$col}} # join multiline values
526 return { query => $query, placeholders => $placeholders, values => \@values };
531 my $error = $installer->load_sql($filename);
533 Runs the specified input file using a sql loader DBIx::RunSQL, or a yaml loader
534 Returns any strings sent to STDERR
536 # FIXME This should be improved: sometimes the caller and load_sql warn the same
543 my $filename = shift;
546 my $dbh = $self->{ dbh };
551 open STDERR, ">>", \$dup_stderr;
553 if ( $filename =~ /sql$/ ) { # SQL files
555 DBIx::RunSQL->run_sql_file(
563 my $yaml = YAML::XS::LoadFile( $filename ); # Load YAML
564 for my $table ( @{ $yaml->{'tables'} } ) {
565 my $query_info = process_yml_table($table);
566 my $query = $query_info->{query};
567 my $placeholders = $query_info->{placeholders};
568 my $values = $query_info->{values};
569 # Doing only 1 INSERT query for the whole table
570 my @all_rows_values = map { @$_ } @$values;
571 $query .= join ', ', ( $placeholders ) x scalar @$values;
572 $dbh->do( $query, undef, @all_rows_values );
574 for my $statement ( @{ $yaml->{'sql_statements'} } ) { # extra SQL statements
575 $dbh->do($statement);
580 warn "Something went wrong loading file $filename ($@)";
583 # errors thrown while loading installer data should be logged
585 warn "C4::Installer::load_sql returned the following errors while attempting to load $filename:\n";
586 $error = $dup_stderr;
592 =head2 get_file_path_from_name
594 my $filename = $installer->get_file_path_from_name('script_name');
596 searches through the set of known SQL scripts and finds the fully
597 qualified path name for the script that mathches the input.
599 returns undef if no match was found.
604 sub get_file_path_from_name {
606 my $partialname = shift;
608 my $lang = 'en'; # FIXME: how do I know what language I want?
610 my ($defaulted_to_en, $list) = $self->sample_data_sql_list($lang);
611 # warn( Data::Dumper->Dump( [ $list ], [ 'list' ] ) );
614 foreach my $frameworklist ( @$list ) {
615 push @found, grep { $_->{'fwkfile'} =~ /$partialname$/ } @{$frameworklist->{'frameworks'}};
618 # warn( Data::Dumper->Dump( [ \@found ], [ 'found' ] ) );
619 if ( 0 == scalar @found ) {
621 } elsif ( 1 < scalar @found ) {
622 warn "multiple results found for $partialname";
625 return $found[0]->{'fwkfile'};
630 sub primary_key_exists {
631 my ( $table_name, $key_name ) = @_;
632 my $dbh = C4::Context->dbh;
633 my ($exists) = $dbh->selectrow_array(
635 SHOW INDEX FROM $table_name
636 WHERE key_name = 'PRIMARY' AND column_name = ?
642 sub foreign_key_exists {
643 my ( $table_name, $constraint_name ) = @_;
644 my $dbh = C4::Context->dbh;
645 my (undef, $infos) = $dbh->selectrow_array(qq|SHOW CREATE TABLE $table_name|);
646 return $infos =~ m|CONSTRAINT `$constraint_name` FOREIGN KEY|;
650 my ( $table_name, $key_name ) = @_;
651 my $dbh = C4::Context->dbh;
652 my ($exists) = $dbh->selectrow_array(
654 SHOW INDEX FROM $table_name
662 my ( $table_name, $column_name ) = @_;
663 return unless TableExists($table_name);
664 my $dbh = C4::Context->dbh;
665 my ($exists) = $dbh->selectrow_array(
667 SHOW COLUMNS FROM $table_name
669 |, undef, $column_name
674 sub TableExists { # Could be renamed table_exists for consistency
677 my $dbh = C4::Context->dbh;
678 local $dbh->{PrintError} = 0;
679 local $dbh->{RaiseError} = 1;
680 $dbh->do(qq{SELECT * FROM $table WHERE 1 = 0 });
689 C4::Installer is a refactoring of logic originally from installer/installer.pl, which was
690 originally written by Henri-Damien Laurant.
692 Koha Development Team <http://koha-community.org/>
694 Galen Charlton <galen.charlton@liblime.com>