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 );
28 use vars qw(@ISA @EXPORT);
31 @ISA = qw( Exporter );
32 push @EXPORT, qw( foreign_key_exists index_exists column_exists TableExists);
42 my $installer = C4::Installer->new();
43 my $all_languages = getAllLanguages();
44 my $error = $installer->load_db_schema();
46 #fill $list with list of sql files
47 my ($fwk_language, $error_list) = $installer->load_sql_in_order($all_languages, @$list);
48 $installer->set_version_syspref();
49 $installer->set_marcflavour_syspref('MARC21');
59 my $installer = C4::Installer->new();
61 Creates a new installer.
70 # get basic information from context
71 $self->{'dbname'} = C4::Context->config("database");
72 $self->{'dbms'} = C4::Context->config("db_scheme") ? C4::Context->config("db_scheme") : "mysql";
73 $self->{'hostname'} = C4::Context->config("hostname");
74 $self->{'port'} = C4::Context->config("port");
75 $self->{'user'} = C4::Context->config("user");
76 $self->{'password'} = C4::Context->config("pass");
77 $self->{'tls'} = C4::Context->config("tls");
78 if( $self->{'tls'} && $self->{'tls'} eq 'yes' ) {
79 $self->{'ca'} = C4::Context->config('ca');
80 $self->{'cert'} = C4::Context->config('cert');
81 $self->{'key'} = C4::Context->config('key');
82 $self->{'tlsoptions'} = ";mysql_ssl=1;mysql_ssl_client_key=".$self->{key}.";mysql_ssl_client_cert=".$self->{cert}.";mysql_ssl_ca_file=".$self->{ca};
83 $self->{'tlscmdline'} = " --ssl-cert ". $self->{cert} . " --ssl-key " . $self->{key} . " --ssl-ca ".$self->{ca}." "
85 $self->{'dbh'} = DBI->connect("DBI:$self->{dbms}:dbname=$self->{dbname};host=$self->{hostname}" .
86 ( $self->{port} ? ";port=$self->{port}" : "" ).
87 ( $self->{tlsoptions} ? $self->{tlsoptions} : ""),
88 $self->{'user'}, $self->{'password'});
89 $self->{'language'} = undef;
90 $self->{'marcflavour'} = undef;
91 $self->{'dbh'}->do('set NAMES "utf8"');
92 $self->{'dbh'}->{'mysql_enable_utf8'}=1;
98 =head2 marc_framework_sql_list
100 my ($defaulted_to_en, $list) =
101 $installer->marc_framework_sql_list($lang, $marcflavour);
103 Returns in C<$list> a structure listing the filename, description, section,
104 and mandatory/optional status of MARC framework scripts available for C<$lang>
107 If the C<$defaulted_to_en> return value is true, no scripts are available
108 for language C<$lang> and the 'en' ones are returned.
112 sub marc_framework_sql_list {
115 my $marcflavour = shift;
117 my $defaulted_to_en = 0;
120 my $dir = C4::Context->config('intranetdir') . "/installer/data/$self->{dbms}/$lang/marcflavour/".lc($marcflavour);
121 unless (opendir( MYDIR, $dir )) {
123 warn "cannot open MARC frameworks directory $dir";
125 # if no translated MARC framework is available,
127 $dir = C4::Context->config('intranetdir') . "/installer/data/$self->{dbms}/en/marcflavour/".lc($marcflavour);
128 opendir(MYDIR, $dir) or warn "cannot open English MARC frameworks directory $dir";
129 $defaulted_to_en = 1;
132 my @listdir = sort grep { !/^\.|marcflavour/ && -d "$dir/$_" } readdir(MYDIR);
136 my $request = $self->{'dbh'}->prepare("SELECT value FROM systempreferences WHERE variable='FrameworksLoaded'");
138 my ($frameworksloaded) = $request->fetchrow;
139 $frameworksloaded = '' unless defined $frameworksloaded; # avoid warning
140 my %frameworksloaded;
141 foreach ( split( /\|/, $frameworksloaded ) ) {
142 $frameworksloaded{$_} = 1;
145 foreach my $requirelevel (@listdir) {
146 opendir( MYDIR, "$dir/$requirelevel" );
147 my @listname = grep { !/^\./ && -f "$dir/$requirelevel/$_" && $_ =~ m/\.sql$/ } readdir(MYDIR);
152 my $name = substr( $_, 0, -4 );
153 open my $fh, "<:encoding(UTF-8)", "$dir/$requirelevel/$name.txt";
155 $line = Encode::encode('UTF-8', $line) unless ( Encode::is_utf8($line) );
156 my @lines = split /\n/, $line;
157 my $mandatory = ($requirelevel =~ /(mandatory|requi|oblig|necess)/i);
161 'fwkfile' => "$dir/$requirelevel/$_",
162 'fwkdescription' => \@lines,
163 'checked' => ( ( $frameworksloaded{$_} || $mandatory ) ? 1 : 0 ),
164 'mandatory' => $mandatory,
168 sort { $a->{'fwkname'} cmp $b->{'fwkname'} } @frameworklist;
170 $cell{"frameworks"} = \@fwks;
171 $cell{"label"} = ucfirst($requirelevel);
172 $cell{"code"} = lc($requirelevel);
173 push @fwklist, \%cell;
176 return ($defaulted_to_en, \@fwklist);
179 =head2 sample_data_sql_list
181 my ($defaulted_to_en, $list) = $installer->sample_data_sql_list($lang);
183 Returns in C<$list> a structure listing the filename, description, section,
184 and mandatory/optional status of sample data scripts available for C<$lang>.
185 If the C<$defaulted_to_en> return value is true, no scripts are available
186 for language C<$lang> and the 'en' ones are returned.
190 sub sample_data_sql_list {
194 my $defaulted_to_en = 0;
197 my $dir = C4::Context->config('intranetdir') . "/installer/data/$self->{dbms}/$lang";
198 unless (opendir( MYDIR, $dir )) {
200 warn "cannot open sample data directory $dir";
202 # if no sample data is available,
204 $dir = C4::Context->config('intranetdir') . "/installer/data/$self->{dbms}/en";
205 opendir(MYDIR, $dir) or warn "cannot open English sample data directory $dir";
206 $defaulted_to_en = 1;
209 my @listdir = sort grep { !/^\.|marcflavour/ && -d "$dir/$_" } readdir(MYDIR);
213 my $request = $self->{'dbh'}->prepare("SELECT value FROM systempreferences WHERE variable='FrameworksLoaded'");
215 my ($frameworksloaded) = $request->fetchrow;
216 $frameworksloaded = '' unless defined $frameworksloaded; # avoid warning
217 my %frameworksloaded;
218 foreach ( split( /\|/, $frameworksloaded ) ) {
219 $frameworksloaded{$_} = 1;
222 foreach my $requirelevel (@listdir) {
223 opendir( MYDIR, "$dir/$requirelevel" );
224 my @listname = grep { !/^\./ && -f "$dir/$requirelevel/$_" && $_ =~ m/\.sql$/ } readdir(MYDIR);
229 my $name = substr( $_, 0, -4 );
230 open my $fh , "<:encoding(UTF-8)", "$dir/$requirelevel/$name.txt";
232 $line = Encode::encode('UTF-8', $line) unless ( Encode::is_utf8($line) );
233 my @lines = split /\n/, $line;
234 my $mandatory = ($requirelevel =~ /(mandatory|requi|oblig|necess)/i);
238 'fwkfile' => "$dir/$requirelevel/$_",
239 'fwkdescription' => \@lines,
240 'checked' => ( ( $frameworksloaded{$_} || $mandatory ) ? 1 : 0 ),
241 'mandatory' => $mandatory,
244 my @fwks = sort { $a->{'fwkname'} cmp $b->{'fwkname'} } @frameworklist;
246 $cell{"frameworks"} = \@fwks;
247 $cell{"label"} = ucfirst($requirelevel);
248 $cell{"code"} = lc($requirelevel);
249 push @levellist, \%cell;
252 return ($defaulted_to_en, \@levellist);
255 =head2 load_db_schema
257 my $error = $installer->load_db_schema();
259 Loads the SQL script that creates Koha's tables and indexes. The
260 return value is a string containing error messages reported by the
268 my $datadir = C4::Context->config('intranetdir') . "/installer/data/$self->{dbms}";
269 my $error = $self->load_sql("$datadir/kohastructure.sql");
274 =head2 load_sql_in_order
276 my ($fwk_language, $list) = $installer->load_sql_in_order($all_languages, @sql_list);
278 Given a list of SQL scripts supplied in C<@sql_list>, loads each of them
279 into the database and sets the FrameworksLoaded system preference to names
280 of the scripts that were loaded.
282 The SQL files are loaded in alphabetical order by filename (not including
283 directory path). This means that dependencies among the scripts are to
284 be resolved by carefully naming them, keeping in mind that the directory name
285 does *not* currently count.
287 B<FIXME:> this is a rather delicate way of dealing with dependencies between
290 The return value C<$list> is an arrayref containing a hashref for each
291 "level" or directory containing SQL scripts; the hashref in turns contains
292 a list of hashrefs containing a list of each script load and any error
293 messages associated with the loading of each script.
295 B<FIXME:> The C<$fwk_language> code probably doesn't belong and needs to be
296 moved to a different method.
300 sub load_sql_in_order {
302 my $all_languages = shift;
308 my @aa = split /\/|\\/, ($a);
309 my @bb = split /\/|\\/, ($b);
312 my $request = $self->{'dbh'}->prepare( "SELECT value FROM systempreferences WHERE variable='FrameworksLoaded'" );
314 my ($systempreference) = $request->fetchrow;
315 $systempreference = '' unless defined $systempreference; # avoid warning
317 my $global_mandatory_dir = C4::Context->config('intranetdir') . "/installer/data/$self->{dbms}/mandatory";
319 # Make sure some stuffs are loaded first
320 unshift(@fnames, C4::Context->config('intranetdir') . "/installer/data/$self->{dbms}/sysprefs.sql");
322 "$global_mandatory_dir/subtag_registry.sql",
323 "$global_mandatory_dir/auth_val_cat.sql",
324 "$global_mandatory_dir/message_transport_types.sql",
325 "$global_mandatory_dir/sample_notices_message_attributes.sql",
326 "$global_mandatory_dir/sample_notices_message_transports.sql",
327 "$global_mandatory_dir/keyboard_shortcuts.sql",
330 push @fnames, C4::Context->config('intranetdir') . "/installer/data/mysql/userflags.sql";
331 push @fnames, C4::Context->config('intranetdir') . "/installer/data/mysql/userpermissions.sql";
332 push @fnames, C4::Context->config('intranetdir') . "/installer/data/mysql/audio_alerts.sql";
333 push @fnames, C4::Context->config('intranetdir') . "/installer/data/mysql/account_offset_types.sql";
334 push @fnames, C4::Context->config('intranetdir') . "/installer/data/mysql/account_credit_types.sql";
335 push @fnames, C4::Context->config('intranetdir') . "/installer/data/mysql/account_debit_types.sql";
336 foreach my $file (@fnames) {
339 my $error = $self->load_sql($file);
340 my @file = split qr(\/|\\), $file;
341 $lang = $file[ scalar(@file) - 3 ] unless ($lang);
342 my $level = $file[ scalar(@file) - 2 ];
344 $systempreference .= "$file[scalar(@file)-1]|"
345 unless ( index( $systempreference, $file[ scalar(@file) - 1 ] ) >= 0 );
348 #Bulding here a hierarchy to display files by level.
349 push @{ $hashlevel{$level} },
350 { "fwkname" => $file[ scalar(@file) - 1 ], "error" => $error };
353 #systempreference contains an ending |
354 chop $systempreference;
356 map { push @list, { "level" => $_, "fwklist" => $hashlevel{$_} } } keys %hashlevel;
358 for my $each_language (@$all_languages) {
360 # warn "CODE".$each_language->{'language_code'};
361 # warn "LANG:".$lang;
362 if ( $lang eq $each_language->{'language_code'} ) {
363 $fwk_language = $each_language->{language_locale_name};
368 "UPDATE systempreferences set value=\"$systempreference\" where variable='FrameworksLoaded'"
371 unless ( $updateflag == 1 ) {
373 "INSERT INTO systempreferences (value, variable, explanation, type) VALUES (\"$systempreference\",'FrameworksLoaded','Frameworks loaded through webinstaller','choice')";
374 my $rq = $self->{'dbh'}->prepare($string);
377 return ($fwk_language, \@list);
380 =head2 set_marcflavour_syspref
382 $installer->set_marcflavour_syspref($marcflavour);
384 Set the 'marcflavour' system preference. The incoming
385 C<$marcflavour> references to a subdirectory of
386 installer/data/$dbms/$lang/marcflavour, and is
387 normalized to MARC21, UNIMARC or NORMARC.
389 FIXME: this method assumes that the MARC flavour will be either
390 MARC21, UNIMARC or NORMARC.
394 sub set_marcflavour_syspref {
396 my $marcflavour = shift;
398 # we can have some variants of marc flavour, by having different directories, like : unimarc_small and unimarc_full, for small and complete unimarc frameworks.
399 # marc_cleaned finds the marcflavour, without the variant.
400 my $marc_cleaned = 'MARC21';
401 $marc_cleaned = 'UNIMARC' if $marcflavour =~ /unimarc/i;
402 $marc_cleaned = 'NORMARC' if $marcflavour =~ /normarc/i;
404 $self->{'dbh'}->prepare(
405 "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');"
410 =head2 set_version_syspref
412 $installer->set_version_syspref();
414 Set or update the 'Version' system preference to the current
415 Koha software version.
419 sub set_version_syspref {
422 my $kohaversion = Koha::version();
423 # remove the 3 last . to have a Perl number
424 $kohaversion =~ s/(.*\..*)\.(.*)\.(.*)/$1$2$3/;
425 if (C4::Context->preference('Version')) {
426 warn "UPDATE Version";
427 my $finish=$self->{'dbh'}->prepare("UPDATE systempreferences SET value=? WHERE variable='Version'");
428 $finish->execute($kohaversion);
430 warn "INSERT Version";
431 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')");
432 $finish->execute($kohaversion);
434 C4::Context->clear_syspref_cache();
439 my $error = $installer->load_sql($filename);
441 Runs a the specified SQL file using a sql loader DBIx::RunSQL
442 Returns any strings sent to STDERR
444 # FIXME This should be improved: sometimes the caller and load_sql warn the same
451 my $filename = shift;
454 my $dbh = $self->{ dbh };
459 open STDERR, ">>", \$dup_stderr;
462 DBIx::RunSQL->run_sql_file(
468 # errors thrown while loading installer data should be logged
470 warn "C4::Installer::load_sql returned the following errors while attempting to load $filename:\n";
471 $error = $dup_stderr;
477 =head2 get_file_path_from_name
479 my $filename = $installer->get_file_path_from_name('script_name');
481 searches through the set of known SQL scripts and finds the fully
482 qualified path name for the script that mathches the input.
484 returns undef if no match was found.
489 sub get_file_path_from_name {
491 my $partialname = shift;
493 my $lang = 'en'; # FIXME: how do I know what language I want?
495 my ($defaulted_to_en, $list) = $self->sample_data_sql_list($lang);
496 # warn( Data::Dumper->Dump( [ $list ], [ 'list' ] ) );
499 foreach my $frameworklist ( @$list ) {
500 push @found, grep { $_->{'fwkfile'} =~ /$partialname$/ } @{$frameworklist->{'frameworks'}};
503 # warn( Data::Dumper->Dump( [ \@found ], [ 'found' ] ) );
504 if ( 0 == scalar @found ) {
506 } elsif ( 1 < scalar @found ) {
507 warn "multiple results found for $partialname";
510 return $found[0]->{'fwkfile'};
515 sub foreign_key_exists {
516 my ( $table_name, $constraint_name ) = @_;
517 my $dbh = C4::Context->dbh;
518 my (undef, $infos) = $dbh->selectrow_array(qq|SHOW CREATE TABLE $table_name|);
519 return $infos =~ m|CONSTRAINT `$constraint_name` FOREIGN KEY|;
523 my ( $table_name, $key_name ) = @_;
524 my $dbh = C4::Context->dbh;
525 my ($exists) = $dbh->selectrow_array(
527 SHOW INDEX FROM $table_name
535 my ( $table_name, $column_name ) = @_;
536 return unless TableExists($table_name);
537 my $dbh = C4::Context->dbh;
538 my ($exists) = $dbh->selectrow_array(
540 SHOW COLUMNS FROM $table_name
542 |, undef, $column_name
547 sub TableExists { # Could be renamed table_exists for consistency
550 my $dbh = C4::Context->dbh;
551 local $dbh->{PrintError} = 0;
552 local $dbh->{RaiseError} = 1;
553 $dbh->do(qq{SELECT * FROM $table WHERE 1 = 0 });
562 C4::Installer is a refactoring of logic originally from installer/installer.pl, which was
563 originally written by Henri-Damien Laurant.
565 Koha Development Team <http://koha-community.org/>
567 Galen Charlton <galen.charlton@liblime.com>