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 under the
8 # terms of the GNU General Public License as published by the Free Software
9 # Foundation; either version 2 of the License, or (at your option) any later
12 # Koha is distributed in the hope that it will be useful, but WITHOUT ANY
13 # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
14 # A PARTICULAR PURPOSE. See the GNU General Public License for more details.
16 # You should have received a copy of the GNU General Public License along
17 # with Koha; if not, write to the Free Software Foundation, Inc.,
18 # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
21 #use warnings; FIXME - Bug 2505
23 our $VERSION = 3.07.00.049;
25 use C4::Installer::PerlModules;
26 use C4::Update::Database;
35 my $installer = C4::Installer->new();
36 my $all_languages = getAllLanguages();
37 my $error = $installer->load_db_schema();
38 my $list = $installer->sql_file_list('en', 'marc21', { optional => 1, mandatory => 1 });
39 my ($fwk_language, $error_list) = $installer->load_sql_in_order($all_languages, @$list);
40 $installer->set_version_syspref();
41 $installer->set_marcflavour_syspref('MARC21');
42 $installer->set_indexing_engine(0);
52 my $installer = C4::Installer->new();
54 Creates a new installer.
63 # get basic information from context
64 $self->{'dbname'} = C4::Context->config("database");
65 $self->{'dbms'} = C4::Context->config("db_scheme") ? C4::Context->config("db_scheme") : "mysql";
66 $self->{'hostname'} = C4::Context->config("hostname");
67 $self->{'port'} = C4::Context->config("port");
68 $self->{'user'} = C4::Context->config("user");
69 $self->{'password'} = C4::Context->config("pass");
70 $self->{'dbh'} = DBI->connect("DBI:$self->{dbms}:dbname=$self->{dbname};host=$self->{hostname}" .
71 ( $self->{port} ? ";port=$self->{port}" : "" ),
72 $self->{'user'}, $self->{'password'});
73 $self->{'language'} = undef;
74 $self->{'marcflavour'} = undef;
75 $self->{'dbh'}->do('set NAMES "utf8"');
76 $self->{'dbh'}->{'mysql_enable_utf8'}=1;
82 =head2 marcflavour_list
84 my ($marcflavours) = $installer->marcflavour_list($lang);
86 Return a arrayref of the MARC flavour sets available for the
87 specified language C<$lang>. Returns 'undef' if a directory
88 for the language does not exist.
92 sub marcflavour_list {
96 my $dir = C4::Context->config('intranetdir') . "/installer/data/$self->{dbms}/$lang/marcflavour";
97 opendir(MYDIR, $dir) or return;
98 my @list = grep { !/^\.|CVS/ && -d "$dir/$_" } readdir(MYDIR);
103 =head2 marc_framework_sql_list
105 my ($defaulted_to_en, $list) =
106 $installer->marc_framework_sql_list($lang, $marcflavour);
108 Returns in C<$list> a structure listing the filename, description, section,
109 and mandatory/optional status of MARC framework scripts available for C<$lang>
112 If the C<$defaulted_to_en> return value is true, no scripts are available
113 for language C<$lang> and the 'en' ones are returned.
117 sub marc_framework_sql_list {
120 my $marcflavour = shift;
122 my $defaulted_to_en = 0;
125 my $dir = C4::Context->config('intranetdir') . "/installer/data/$self->{dbms}/$lang/marcflavour/".lc($marcflavour);
126 unless (opendir( MYDIR, $dir )) {
128 warn "cannot open MARC frameworks directory $dir";
130 # if no translated MARC framework is available,
132 $dir = C4::Context->config('intranetdir') . "/installer/data/$self->{dbms}/en/marcflavour/".lc($marcflavour);
133 opendir(MYDIR, $dir) or warn "cannot open English MARC frameworks directory $dir";
134 $defaulted_to_en = 1;
137 my @listdir = sort grep { !/^\.|marcflavour/ && -d "$dir/$_" } readdir(MYDIR);
141 my $request = $self->{'dbh'}->prepare("SELECT value FROM systempreferences WHERE variable='FrameworksLoaded'");
143 my ($frameworksloaded) = $request->fetchrow;
144 $frameworksloaded = '' unless defined $frameworksloaded; # avoid warning
145 my %frameworksloaded;
146 foreach ( split( /\|/, $frameworksloaded ) ) {
147 $frameworksloaded{$_} = 1;
150 foreach my $requirelevel (@listdir) {
151 opendir( MYDIR, "$dir/$requirelevel" );
152 my @listname = grep { !/^\./ && -f "$dir/$requirelevel/$_" && $_ =~ m/\.sql$/ } readdir(MYDIR);
157 my $name = substr( $_, 0, -4 );
158 open my $fh, "<:encoding(UTF-8)", "$dir/$requirelevel/$name.txt";
160 $lines =~ s/\n|\r/<br \/>/g;
162 utf8::encode($lines) unless ( utf8::is_utf8($lines) );
163 my $mandatory = ($requirelevel =~ /(mandatory|requi|oblig|necess)/i);
167 'fwkfile' => "$dir/$requirelevel/$_",
168 'fwkdescription' => $lines,
169 'checked' => ( ( $frameworksloaded{$_} || $mandatory ) ? 1 : 0 ),
170 'mandatory' => $mandatory,
174 sort { $a->{'fwkname'} cmp $b->{'fwkname'} } @frameworklist;
176 $cell{"frameworks"} = \@fwks;
177 $cell{"label"} = ucfirst($requirelevel);
178 $cell{"code"} = lc($requirelevel);
179 push @fwklist, \%cell;
182 return ($defaulted_to_en, \@fwklist);
185 =head2 sample_data_sql_list
187 my ($defaulted_to_en, $list) = $installer->sample_data_sql_list($lang);
189 Returns in C<$list> a structure listing the filename, description, section,
190 and mandatory/optional status of sample data scripts available for C<$lang>.
191 If the C<$defaulted_to_en> return value is true, no scripts are available
192 for language C<$lang> and the 'en' ones are returned.
196 sub sample_data_sql_list {
200 my $defaulted_to_en = 0;
203 my $dir = C4::Context->config('intranetdir') . "/installer/data/$self->{dbms}/$lang";
204 unless (opendir( MYDIR, $dir )) {
206 warn "cannot open sample data directory $dir";
208 # if no sample data is available,
210 $dir = C4::Context->config('intranetdir') . "/installer/data/$self->{dbms}/en";
211 opendir(MYDIR, $dir) or warn "cannot open English sample data directory $dir";
212 $defaulted_to_en = 1;
215 my @listdir = sort grep { !/^\.|marcflavour/ && -d "$dir/$_" } readdir(MYDIR);
219 my $request = $self->{'dbh'}->prepare("SELECT value FROM systempreferences WHERE variable='FrameworksLoaded'");
221 my ($frameworksloaded) = $request->fetchrow;
222 $frameworksloaded = '' unless defined $frameworksloaded; # avoid warning
223 my %frameworksloaded;
224 foreach ( split( /\|/, $frameworksloaded ) ) {
225 $frameworksloaded{$_} = 1;
228 foreach my $requirelevel (@listdir) {
229 opendir( MYDIR, "$dir/$requirelevel" );
230 my @listname = grep { !/^\./ && -f "$dir/$requirelevel/$_" && $_ =~ m/\.sql$/ } readdir(MYDIR);
235 my $name = substr( $_, 0, -4 );
236 open my $fh , "<:encoding(UTF-8)", "$dir/$requirelevel/$name.txt";
238 $lines =~ s/\n|\r/<br \/>/g;
240 utf8::encode($lines) unless ( utf8::is_utf8($lines) );
241 my $mandatory = ($requirelevel =~ /(mandatory|requi|oblig|necess)/i);
245 'fwkfile' => "$dir/$requirelevel/$_",
246 'fwkdescription' => $lines,
247 'checked' => ( ( $frameworksloaded{$_} || $mandatory ) ? 1 : 0 ),
248 'mandatory' => $mandatory,
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);
264 my $list = $installer->sql_file_list($lang, $marcflavour, $subset_wanted);
266 Returns an arrayref containing the filepaths of installer SQL scripts
267 available for laod. The C<$lang> and C<$marcflavour> arguments
268 specify the desired language and MARC flavour. while C<$subset_wanted>
269 is a hashref containing possible named parameters 'mandatory' and 'optional'.
276 my $marcflavour = shift;
277 my $subset_wanted = shift;
279 my ($marc_defaulted_to_en, $marc_sql) = $self->marc_framework_sql_list($lang, $marcflavour);
280 my ($sample_defaulted_to_en, $sample_sql) = $self->sample_data_sql_list($lang);
285 if ($subset_wanted->{'mandatory'}) {
286 push @sql_list, $_->{'fwkfile'} if $_->{'mandatory'};
288 if ($subset_wanted->{'optional'}) {
289 push @sql_list, $_->{'fwkfile'} unless $_->{'mandatory'};
291 } @{ $_->{'frameworks'} }
292 } (@$marc_sql, @$sample_sql);
297 =head2 load_db_schema
299 my $error = $installer->load_db_schema();
301 Loads the SQL script that creates Koha's tables and indexes. The
302 return value is a string containing error messages reported by the
310 my $datadir = C4::Context->config('intranetdir') . "/installer/data/$self->{dbms}";
311 my $error = $self->load_sql("$datadir/kohastructure.sql");
316 =head2 load_sql_in_order
318 my ($fwk_language, $list) = $installer->load_sql_in_order($all_languages, @sql_list);
320 Given a list of SQL scripts supplied in C<@sql_list>, loads each of them
321 into the database and sets the FrameworksLoaded system preference to names
322 of the scripts that were loaded.
324 The SQL files are loaded in alphabetical order by filename (not including
325 directory path). This means that dependencies among the scripts are to
326 be resolved by carefully naming them, keeping in mind that the directory name
327 does *not* currently count.
329 B<FIXME:> this is a rather delicate way of dealing with dependencies between
332 The return value C<$list> is an arrayref containing a hashref for each
333 "level" or directory containing SQL scripts; the hashref in turns contains
334 a list of hashrefs containing a list of each script load and any error
335 messages associated with the loading of each script.
337 B<FIXME:> The C<$fwk_language> code probably doesn't belong and needs to be
338 moved to a different method.
342 sub load_sql_in_order {
344 my $all_languages = shift;
350 my @aa = split /\/|\\/, ($a);
351 my @bb = split /\/|\\/, ($b);
354 my $request = $self->{'dbh'}->prepare( "SELECT value FROM systempreferences WHERE variable='FrameworksLoaded'" );
356 my ($systempreference) = $request->fetchrow;
357 $systempreference = '' unless defined $systempreference; # avoid warning
358 # Make sure the global sysprefs.sql file is loaded first
359 my $globalsysprefs = C4::Context->config('intranetdir') . "/installer/data/$self->{dbms}/sysprefs.sql";
360 unshift(@fnames, $globalsysprefs);
361 foreach my $file (@fnames) {
364 my $error = $self->load_sql($file);
365 my @file = split qr(\/|\\), $file;
366 $lang = $file[ scalar(@file) - 3 ] unless ($lang);
367 my $level = $file[ scalar(@file) - 2 ];
369 $systempreference .= "$file[scalar(@file)-1]|"
370 unless ( index( $systempreference, $file[ scalar(@file) - 1 ] ) >= 0 );
373 #Bulding here a hierarchy to display files by level.
374 push @{ $hashlevel{$level} },
375 { "fwkname" => $file[ scalar(@file) - 1 ], "error" => $error };
378 #systempreference contains an ending |
379 chop $systempreference;
381 map { push @list, { "level" => $_, "fwklist" => $hashlevel{$_} } } keys %hashlevel;
383 for my $each_language (@$all_languages) {
385 # warn "CODE".$each_language->{'language_code'};
386 # warn "LANG:".$lang;
387 if ( $lang eq $each_language->{'language_code'} ) {
388 $fwk_language = $each_language->{language_locale_name};
393 "UPDATE systempreferences set value=\"$systempreference\" where variable='FrameworksLoaded'"
396 unless ( $updateflag == 1 ) {
398 "INSERT INTO systempreferences (value, variable, explanation, type) VALUES (\"$systempreference\",'FrameworksLoaded','Frameworks loaded through webinstaller','choice')";
399 my $rq = $self->{'dbh'}->prepare($string);
402 return ($fwk_language, \@list);
405 =head2 set_marcflavour_syspref
407 $installer->set_marcflavour_syspref($marcflavour);
409 Set the 'marcflavour' system preference. The incoming
410 C<$marcflavour> references to a subdirectory of
411 installer/data/$dbms/$lang/marcflavour, and is
412 normalized to MARC21 or UNIMARC.
414 FIXME: this method assumes that the MARC flavour will be either
419 sub set_marcflavour_syspref {
421 my $marcflavour = shift;
423 # we can have some variants of marc flavour, by having different directories, like : unimarc_small and unimarc_full, for small and complete unimarc frameworks.
424 # marc_cleaned finds the marcflavour, without the variant.
425 my $marc_cleaned = 'MARC21';
426 $marc_cleaned = 'UNIMARC' if $marcflavour =~ /unimarc/i;
428 $self->{'dbh'}->prepare(
429 "INSERT IGNORE INTO `systempreferences` (variable,value,explanation,options,type) VALUES('marcflavour','$marc_cleaned','Define global MARC flavor (MARC21 or UNIMARC) used for character encoding','MARC21|UNIMARC','Choice');"
434 =head2 set_indexing_engine
436 $installer->set_indexing_engine($nozebra);
438 Sets system preferences related to the indexing
439 engine. The C<$nozebra> argument is a boolean;
440 if true, turn on NoZebra mode and turn off QueryFuzzy,
441 QueryWeightFields, and QueryStemming. If false, turn
442 off NoZebra mode (i.e., use the Zebra search engine).
446 sub set_indexing_engine {
451 $self->{'dbh'}->do("UPDATE systempreferences SET value=1 WHERE variable='NoZebra'");
452 $self->{'dbh'}->do("UPDATE systempreferences SET value=0 WHERE variable in ('QueryFuzzy','QueryWeightFields','QueryStemming')");
454 $self->{'dbh'}->do("UPDATE systempreferences SET value=0 WHERE variable='NoZebra'");
459 =head2 set_version_syspref
461 $installer->set_version_syspref();
463 Set or update the 'Version' system preference to the current
464 Koha software version.
468 sub set_version_syspref {
470 # get all updatedatabase, and mark them as passed, as it's a fresh install
471 my $versions = C4::Update::Database::list_versions_available();
472 for my $v ( @$versions ) {
474 $queries->{queries} = ["initial setup"];
475 $queries->{comments} = ["initial setup"];
476 C4::Update::Database::set_infos($v,$queries,undef,undef);
478 # mark the "old" 3.6 version number
479 my $kohaversion=C4::Context::KOHAVERSION;
480 # remove the 3 last . to have a Perl number
481 $kohaversion =~ s/(.*\..*)\.(.*)\.(.*)/$1$2$3/;
482 if (C4::Context->preference('Version')) {
483 warn "UPDATE Version";
484 my $finish=$self->{'dbh'}->prepare("UPDATE systempreferences SET value=? WHERE variable='Version'");
485 $finish->execute($kohaversion);
487 warn "INSERT Version";
488 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')");
489 $finish->execute($kohaversion);
491 C4::Context->clear_syspref_cache();
496 my $error = $installer->load_sql($filename);
498 Runs a the specified SQL using the DB's command-line
499 SQL tool, and returns any strings sent to STDERR
500 by the command-line tool.
502 B<FIXME:> there has been a long-standing desire to
503 replace this with an SQL loader that goes
504 through DBI; partly for portability issues
505 and partly to improve error handling.
507 B<FIXME:> even using the command-line loader, some more
508 basic error handling should be added - deal
509 with missing files, e.g.
515 my $filename = shift;
517 my $datadir = C4::Context->config('intranetdir') . "/installer/data/$self->{dbms}";
521 if ( $self->{dbms} eq 'mysql' ) {
522 $cmd = qx(which mysql 2>/dev/null || whereis mysql 2>/dev/null);
524 $cmd = $1 if ($cmd && $cmd =~ /^(.+?)[\r\n]+$/);
525 $cmd = 'mysql' if (!$cmd || !-x $cmd);
527 . ( $self->{hostname} ? " -h $self->{hostname} " : "" )
528 . ( $self->{port} ? " -P $self->{port} " : "" )
529 . ( $self->{user} ? " -u $self->{user} " : "" )
530 . ( $self->{password} ? " -p'$self->{password}'" : "" )
531 . " $self->{dbname} ";
532 $error = qx($strcmd --default-character-set=utf8 <$filename 2>&1 1>/dev/null);
533 } elsif ( $self->{dbms} eq 'Pg' ) {
534 $cmd = qx(which psql 2>/dev/null || whereis psql 2>/dev/null);
536 $cmd = $1 if ($cmd && $cmd =~ /^(.+?)[\r\n]+$/);
537 $cmd = 'psql' if (!$cmd || !-x $cmd);
539 . ( $self->{hostname} ? " -h $self->{hostname} " : "" )
540 . ( $self->{port} ? " -p $self->{port} " : "" )
541 . ( $self->{user} ? " -U $self->{user} " : "" )
542 # . ( $self->{password} ? " -W $self->{password}" : "" ) # psql will NOT accept a password, but prompts...
543 . " $self->{dbname} "; # Therefore, be sure to run 'trust' on localhost in pg_hba.conf -fbcit
544 $error = qx($strcmd -f $filename 2>&1 1>/dev/null);
545 # Be sure to set 'client_min_messages = error' in postgresql.conf
546 # so that only true errors are returned to stderr or else the installer will
547 # report the import a failure although it really succeded -fbcit
549 # errors thrown while loading installer data should be logged
551 warn "C4::Installer::load_sql returned the following errors while attempting to load $filename:\n";
557 =head2 get_file_path_from_name
559 my $filename = $installer->get_file_path_from_name('script_name');
561 searches through the set of known SQL scripts and finds the fully
562 qualified path name for the script that mathches the input.
564 returns undef if no match was found.
569 sub get_file_path_from_name {
571 my $partialname = shift;
573 my $lang = 'en'; # FIXME: how do I know what language I want?
575 my ($defaulted_to_en, $list) = $self->sample_data_sql_list($lang);
576 # warn( Data::Dumper->Dump( [ $list ], [ 'list' ] ) );
579 foreach my $frameworklist ( @$list ) {
580 push @found, grep { $_->{'fwkfile'} =~ /$partialname$/ } @{$frameworklist->{'frameworks'}};
583 # warn( Data::Dumper->Dump( [ \@found ], [ 'found' ] ) );
584 if ( 0 == scalar @found ) {
586 } elsif ( 1 < scalar @found ) {
587 warn "multiple results found for $partialname";
590 return $found[0]->{'fwkfile'};
598 C4::Installer is a refactoring of logic originally from installer/installer.pl, which was
599 originally written by Henri-Damien Laurant.
601 Koha Development Team <http://koha-community.org/>
603 Galen Charlton <galen.charlton@liblime.com>