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 );
25 use C4::Installer::PerlModules;
29 use vars qw(@ISA @EXPORT);
32 @ISA = qw( Exporter );
33 push @EXPORT, qw( foreign_key_exists index_exists column_exists );
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->{'dbh'} = DBI->connect("DBI:$self->{dbms}:dbname=$self->{dbname};host=$self->{hostname}" .
79 ( $self->{port} ? ";port=$self->{port}" : "" ),
80 $self->{'user'}, $self->{'password'});
81 $self->{'language'} = undef;
82 $self->{'marcflavour'} = undef;
83 $self->{'dbh'}->do('set NAMES "utf8"');
84 $self->{'dbh'}->{'mysql_enable_utf8'}=1;
90 =head2 marc_framework_sql_list
92 my ($defaulted_to_en, $list) =
93 $installer->marc_framework_sql_list($lang, $marcflavour);
95 Returns in C<$list> a structure listing the filename, description, section,
96 and mandatory/optional status of MARC framework scripts available for C<$lang>
99 If the C<$defaulted_to_en> return value is true, no scripts are available
100 for language C<$lang> and the 'en' ones are returned.
104 sub marc_framework_sql_list {
107 my $marcflavour = shift;
109 my $defaulted_to_en = 0;
112 my $dir = C4::Context->config('intranetdir') . "/installer/data/$self->{dbms}/$lang/marcflavour/".lc($marcflavour);
113 unless (opendir( MYDIR, $dir )) {
115 warn "cannot open MARC frameworks directory $dir";
117 # if no translated MARC framework is available,
119 $dir = C4::Context->config('intranetdir') . "/installer/data/$self->{dbms}/en/marcflavour/".lc($marcflavour);
120 opendir(MYDIR, $dir) or warn "cannot open English MARC frameworks directory $dir";
121 $defaulted_to_en = 1;
124 my @listdir = sort grep { !/^\.|marcflavour/ && -d "$dir/$_" } readdir(MYDIR);
128 my $request = $self->{'dbh'}->prepare("SELECT value FROM systempreferences WHERE variable='FrameworksLoaded'");
130 my ($frameworksloaded) = $request->fetchrow;
131 $frameworksloaded = '' unless defined $frameworksloaded; # avoid warning
132 my %frameworksloaded;
133 foreach ( split( /\|/, $frameworksloaded ) ) {
134 $frameworksloaded{$_} = 1;
137 foreach my $requirelevel (@listdir) {
138 opendir( MYDIR, "$dir/$requirelevel" );
139 my @listname = grep { !/^\./ && -f "$dir/$requirelevel/$_" && $_ =~ m/\.sql$/ } readdir(MYDIR);
144 my $name = substr( $_, 0, -4 );
145 open my $fh, "<:encoding(UTF-8)", "$dir/$requirelevel/$name.txt";
147 $lines =~ s/\n|\r/<br \/>/g;
148 $lines = Encode::encode('UTF-8', $lines) unless ( Encode::is_utf8($lines) );
149 my $mandatory = ($requirelevel =~ /(mandatory|requi|oblig|necess)/i);
153 'fwkfile' => "$dir/$requirelevel/$_",
154 'fwkdescription' => $lines,
155 'checked' => ( ( $frameworksloaded{$_} || $mandatory ) ? 1 : 0 ),
156 'mandatory' => $mandatory,
160 sort { $a->{'fwkname'} cmp $b->{'fwkname'} } @frameworklist;
162 $cell{"frameworks"} = \@fwks;
163 $cell{"label"} = ucfirst($requirelevel);
164 $cell{"code"} = lc($requirelevel);
165 push @fwklist, \%cell;
168 return ($defaulted_to_en, \@fwklist);
171 =head2 sample_data_sql_list
173 my ($defaulted_to_en, $list) = $installer->sample_data_sql_list($lang);
175 Returns in C<$list> a structure listing the filename, description, section,
176 and mandatory/optional status of sample data scripts available for C<$lang>.
177 If the C<$defaulted_to_en> return value is true, no scripts are available
178 for language C<$lang> and the 'en' ones are returned.
182 sub sample_data_sql_list {
186 my $defaulted_to_en = 0;
189 my $dir = C4::Context->config('intranetdir') . "/installer/data/$self->{dbms}/$lang";
190 unless (opendir( MYDIR, $dir )) {
192 warn "cannot open sample data directory $dir";
194 # if no sample data is available,
196 $dir = C4::Context->config('intranetdir') . "/installer/data/$self->{dbms}/en";
197 opendir(MYDIR, $dir) or warn "cannot open English sample data directory $dir";
198 $defaulted_to_en = 1;
201 my @listdir = sort grep { !/^\.|marcflavour/ && -d "$dir/$_" } readdir(MYDIR);
205 my $request = $self->{'dbh'}->prepare("SELECT value FROM systempreferences WHERE variable='FrameworksLoaded'");
207 my ($frameworksloaded) = $request->fetchrow;
208 $frameworksloaded = '' unless defined $frameworksloaded; # avoid warning
209 my %frameworksloaded;
210 foreach ( split( /\|/, $frameworksloaded ) ) {
211 $frameworksloaded{$_} = 1;
214 foreach my $requirelevel (@listdir) {
215 opendir( MYDIR, "$dir/$requirelevel" );
216 my @listname = grep { !/^\./ && -f "$dir/$requirelevel/$_" && $_ =~ m/\.sql$/ } readdir(MYDIR);
221 my $name = substr( $_, 0, -4 );
222 open my $fh , "<:encoding(UTF-8)", "$dir/$requirelevel/$name.txt";
224 $lines =~ s/\n|\r/<br \/>/g;
225 $lines = Encode::encode('UTF-8', $lines) unless ( Encode::is_utf8($lines) );
226 my $mandatory = ($requirelevel =~ /(mandatory|requi|oblig|necess)/i);
230 'fwkfile' => "$dir/$requirelevel/$_",
231 'fwkdescription' => $lines,
232 'checked' => ( ( $frameworksloaded{$_} || $mandatory ) ? 1 : 0 ),
233 'mandatory' => $mandatory,
236 my @fwks = sort { $a->{'fwkname'} cmp $b->{'fwkname'} } @frameworklist;
238 $cell{"frameworks"} = \@fwks;
239 $cell{"label"} = ucfirst($requirelevel);
240 $cell{"code"} = lc($requirelevel);
241 push @levellist, \%cell;
244 return ($defaulted_to_en, \@levellist);
247 =head2 load_db_schema
249 my $error = $installer->load_db_schema();
251 Loads the SQL script that creates Koha's tables and indexes. The
252 return value is a string containing error messages reported by the
260 my $datadir = C4::Context->config('intranetdir') . "/installer/data/$self->{dbms}";
261 my $error = $self->load_sql("$datadir/kohastructure.sql");
266 =head2 load_sql_in_order
268 my ($fwk_language, $list) = $installer->load_sql_in_order($all_languages, @sql_list);
270 Given a list of SQL scripts supplied in C<@sql_list>, loads each of them
271 into the database and sets the FrameworksLoaded system preference to names
272 of the scripts that were loaded.
274 The SQL files are loaded in alphabetical order by filename (not including
275 directory path). This means that dependencies among the scripts are to
276 be resolved by carefully naming them, keeping in mind that the directory name
277 does *not* currently count.
279 B<FIXME:> this is a rather delicate way of dealing with dependencies between
282 The return value C<$list> is an arrayref containing a hashref for each
283 "level" or directory containing SQL scripts; the hashref in turns contains
284 a list of hashrefs containing a list of each script load and any error
285 messages associated with the loading of each script.
287 B<FIXME:> The C<$fwk_language> code probably doesn't belong and needs to be
288 moved to a different method.
292 sub load_sql_in_order {
294 my $all_languages = shift;
300 my @aa = split /\/|\\/, ($a);
301 my @bb = split /\/|\\/, ($b);
304 my $request = $self->{'dbh'}->prepare( "SELECT value FROM systempreferences WHERE variable='FrameworksLoaded'" );
306 my ($systempreference) = $request->fetchrow;
307 $systempreference = '' unless defined $systempreference; # avoid warning
308 # Make sure subtag_registry.sql is loaded second
309 my $subtag_registry = C4::Context->config('intranetdir') . "/installer/data/$self->{dbms}/mandatory/subtag_registry.sql";
310 unshift(@fnames, $subtag_registry);
311 # Make sure the global sysprefs.sql file is loaded first
312 my $globalsysprefs = C4::Context->config('intranetdir') . "/installer/data/$self->{dbms}/sysprefs.sql";
313 unshift(@fnames, $globalsysprefs);
314 push @fnames, C4::Context->config('intranetdir') . "/installer/data/mysql/userflags.sql";
315 push @fnames, C4::Context->config('intranetdir') . "/installer/data/mysql/userpermissions.sql";
316 push @fnames, C4::Context->config('intranetdir') . "/installer/data/mysql/audio_alerts.sql";
317 foreach my $file (@fnames) {
320 my $error = $self->load_sql($file);
321 my @file = split qr(\/|\\), $file;
322 $lang = $file[ scalar(@file) - 3 ] unless ($lang);
323 my $level = $file[ scalar(@file) - 2 ];
325 $systempreference .= "$file[scalar(@file)-1]|"
326 unless ( index( $systempreference, $file[ scalar(@file) - 1 ] ) >= 0 );
329 #Bulding here a hierarchy to display files by level.
330 push @{ $hashlevel{$level} },
331 { "fwkname" => $file[ scalar(@file) - 1 ], "error" => $error };
334 #systempreference contains an ending |
335 chop $systempreference;
337 map { push @list, { "level" => $_, "fwklist" => $hashlevel{$_} } } keys %hashlevel;
339 for my $each_language (@$all_languages) {
341 # warn "CODE".$each_language->{'language_code'};
342 # warn "LANG:".$lang;
343 if ( $lang eq $each_language->{'language_code'} ) {
344 $fwk_language = $each_language->{language_locale_name};
349 "UPDATE systempreferences set value=\"$systempreference\" where variable='FrameworksLoaded'"
352 unless ( $updateflag == 1 ) {
354 "INSERT INTO systempreferences (value, variable, explanation, type) VALUES (\"$systempreference\",'FrameworksLoaded','Frameworks loaded through webinstaller','choice')";
355 my $rq = $self->{'dbh'}->prepare($string);
358 return ($fwk_language, \@list);
361 =head2 set_marcflavour_syspref
363 $installer->set_marcflavour_syspref($marcflavour);
365 Set the 'marcflavour' system preference. The incoming
366 C<$marcflavour> references to a subdirectory of
367 installer/data/$dbms/$lang/marcflavour, and is
368 normalized to MARC21, UNIMARC or NORMARC.
370 FIXME: this method assumes that the MARC flavour will be either
371 MARC21, UNIMARC or NORMARC.
375 sub set_marcflavour_syspref {
377 my $marcflavour = shift;
379 # we can have some variants of marc flavour, by having different directories, like : unimarc_small and unimarc_full, for small and complete unimarc frameworks.
380 # marc_cleaned finds the marcflavour, without the variant.
381 my $marc_cleaned = 'MARC21';
382 $marc_cleaned = 'UNIMARC' if $marcflavour =~ /unimarc/i;
383 $marc_cleaned = 'NORMARC' if $marcflavour =~ /normarc/i;
385 $self->{'dbh'}->prepare(
386 "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');"
391 =head2 set_version_syspref
393 $installer->set_version_syspref();
395 Set or update the 'Version' system preference to the current
396 Koha software version.
400 sub set_version_syspref {
403 my $kohaversion = Koha::version();
404 # remove the 3 last . to have a Perl number
405 $kohaversion =~ s/(.*\..*)\.(.*)\.(.*)/$1$2$3/;
406 if (C4::Context->preference('Version')) {
407 warn "UPDATE Version";
408 my $finish=$self->{'dbh'}->prepare("UPDATE systempreferences SET value=? WHERE variable='Version'");
409 $finish->execute($kohaversion);
411 warn "INSERT Version";
412 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')");
413 $finish->execute($kohaversion);
415 C4::Context->clear_syspref_cache();
420 my $error = $installer->load_sql($filename);
422 Runs a the specified SQL file using a sql loader DBIx::RunSQL
423 Returns any strings sent to STDERR
425 # FIXME This should be improved: sometimes the caller and load_sql warn the same
432 my $filename = shift;
435 my $dbh = $self->{ dbh };
440 open STDERR, ">>", \$dup_stderr;
443 DBIx::RunSQL->run_sql_file(
449 # errors thrown while loading installer data should be logged
451 warn "C4::Installer::load_sql returned the following errors while attempting to load $filename:\n";
452 $error = $dup_stderr;
459 =head2 get_file_path_from_name
461 my $filename = $installer->get_file_path_from_name('script_name');
463 searches through the set of known SQL scripts and finds the fully
464 qualified path name for the script that mathches the input.
466 returns undef if no match was found.
471 sub get_file_path_from_name {
473 my $partialname = shift;
475 my $lang = 'en'; # FIXME: how do I know what language I want?
477 my ($defaulted_to_en, $list) = $self->sample_data_sql_list($lang);
478 # warn( Data::Dumper->Dump( [ $list ], [ 'list' ] ) );
481 foreach my $frameworklist ( @$list ) {
482 push @found, grep { $_->{'fwkfile'} =~ /$partialname$/ } @{$frameworklist->{'frameworks'}};
485 # warn( Data::Dumper->Dump( [ \@found ], [ 'found' ] ) );
486 if ( 0 == scalar @found ) {
488 } elsif ( 1 < scalar @found ) {
489 warn "multiple results found for $partialname";
492 return $found[0]->{'fwkfile'};
497 sub foreign_key_exists {
498 my ( $table_name, $constraint_name ) = @_;
499 my $dbh = C4::Context->dbh;
500 my (undef, $infos) = $dbh->selectrow_array(qq|SHOW CREATE TABLE $table_name|);
501 return $infos =~ m|CONSTRAINT `$constraint_name` FOREIGN KEY|;
505 my ( $table_name, $key_name ) = @_;
506 my $dbh = C4::Context->dbh;
507 my ($exists) = $dbh->selectrow_array(
509 SHOW INDEX FROM $table_name
517 my ( $table_name, $column_name ) = @_;
518 my $dbh = C4::Context->dbh;
519 my ($exists) = $dbh->selectrow_array(
521 SHOW COLUMNS FROM $table_name
523 |, undef, $column_name
530 C4::Installer is a refactoring of logic originally from installer/installer.pl, which was
531 originally written by Henri-Damien Laurant.
533 Koha Development Team <http://koha-community.org/>
535 Galen Charlton <galen.charlton@liblime.com>