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
25 use C4
::Installer
::PerlModules
1.000000;
34 my $installer = C4::Installer->new();
35 my $all_languages = getAllLanguages();
36 my $error = $installer->load_db_schema();
37 my $list = $installer->sql_file_list('en', 'marc21', { optional => 1, mandatory => 1 });
38 my ($fwk_language, $error_list) = $installer->load_sql_in_order($all_languages, @$list);
39 $installer->set_version_syspref();
40 $installer->set_marcflavour_syspref('MARC21');
41 $installer->set_indexing_engine(0);
51 my $installer = C4::Installer->new();
53 Creates a new installer.
62 # get basic information from context
63 $self->{'dbname'} = C4
::Context
->config("database");
64 $self->{'dbms'} = C4
::Context
->config("db_scheme") ? C4
::Context
->config("db_scheme") : "mysql";
65 $self->{'hostname'} = C4
::Context
->config("hostname");
66 $self->{'port'} = C4
::Context
->config("port");
67 $self->{'user'} = C4
::Context
->config("user");
68 $self->{'password'} = C4
::Context
->config("pass");
69 $self->{'dbh'} = DBI
->connect("DBI:$self->{dbms}:dbname=$self->{dbname};host=$self->{hostname}" .
70 ( $self->{port
} ?
";port=$self->{port}" : "" ),
71 $self->{'user'}, $self->{'password'});
72 $self->{'language'} = undef;
73 $self->{'marcflavour'} = undef;
74 $self->{'dbh'}->do('set NAMES "utf8"');
75 $self->{'dbh'}->{'mysql_enable_utf8'}=1;
81 =head2 marcflavour_list
83 my ($marcflavours) = $installer->marcflavour_list($lang);
85 Return a arrayref of the MARC flavour sets available for the
86 specified language C<$lang>. Returns 'undef' if a directory
87 for the language does not exist.
91 sub marcflavour_list
{
95 my $dir = C4
::Context
->config('intranetdir') . "/installer/data/$self->{dbms}/$lang/marcflavour";
96 opendir(MYDIR
, $dir) or return;
97 my @list = grep { !/^\.|CVS/ && -d
"$dir/$_" } readdir(MYDIR
);
102 =head2 marc_framework_sql_list
104 my ($defaulted_to_en, $list) =
105 $installer->marc_framework_sql_list($lang, $marcflavour);
107 Returns in C<$list> a structure listing the filename, description, section,
108 and mandatory/optional status of MARC framework scripts available for C<$lang>
111 If the C<$defaulted_to_en> return value is true, no scripts are available
112 for language C<$lang> and the 'en' ones are returned.
116 sub marc_framework_sql_list
{
119 my $marcflavour = shift;
121 my $defaulted_to_en = 0;
124 my $dir = C4
::Context
->config('intranetdir') . "/installer/data/$self->{dbms}/$lang/marcflavour/".lc($marcflavour);
125 unless (opendir( MYDIR
, $dir )) {
127 warn "cannot open MARC frameworks directory $dir";
129 # if no translated MARC framework is available,
131 $dir = C4
::Context
->config('intranetdir') . "/installer/data/$self->{dbms}/en/marcflavour/".lc($marcflavour);
132 opendir(MYDIR
, $dir) or warn "cannot open English MARC frameworks directory $dir";
133 $defaulted_to_en = 1;
136 my @listdir = sort grep { !/^\.|marcflavour/ && -d
"$dir/$_" } readdir(MYDIR
);
140 my $request = $self->{'dbh'}->prepare("SELECT value FROM systempreferences WHERE variable='FrameworksLoaded'");
142 my ($frameworksloaded) = $request->fetchrow;
143 $frameworksloaded = '' unless defined $frameworksloaded; # avoid warning
144 my %frameworksloaded;
145 foreach ( split( /\|/, $frameworksloaded ) ) {
146 $frameworksloaded{$_} = 1;
149 foreach my $requirelevel (@listdir) {
150 opendir( MYDIR
, "$dir/$requirelevel" );
151 my @listname = grep { !/^\./ && -f
"$dir/$requirelevel/$_" && $_ =~ m/\.sql$/ } readdir(MYDIR
);
156 my $name = substr( $_, 0, -4 );
157 open FILE
, "<:utf8","$dir/$requirelevel/$name.txt";
159 $lines =~ s/\n|\r/<br \/>/g
;
161 utf8
::encode
($lines) unless ( utf8
::is_utf8
($lines) );
162 my $mandatory = ($requirelevel =~ /(mandatory|requi|oblig|necess)/i);
166 'fwkfile' => "$dir/$requirelevel/$_",
167 'fwkdescription' => $lines,
168 'checked' => ( ( $frameworksloaded{$_} || $mandatory ) ?
1 : 0 ),
169 'mandatory' => $mandatory,
173 sort { $a->{'fwkname'} cmp $b->{'fwkname'} } @frameworklist;
175 $cell{"frameworks"} = \
@fwks;
176 $cell{"label"} = ucfirst($requirelevel);
177 $cell{"code"} = lc($requirelevel);
178 push @fwklist, \
%cell;
181 return ($defaulted_to_en, \
@fwklist);
184 =head2 sample_data_sql_list
186 my ($defaulted_to_en, $list) = $installer->sample_data_sql_list($lang);
188 Returns in C<$list> a structure listing the filename, description, section,
189 and mandatory/optional status of sample data scripts available for C<$lang>.
190 If the C<$defaulted_to_en> return value is true, no scripts are available
191 for language C<$lang> and the 'en' ones are returned.
195 sub sample_data_sql_list
{
199 my $defaulted_to_en = 0;
202 my $dir = C4
::Context
->config('intranetdir') . "/installer/data/$self->{dbms}/$lang";
203 unless (opendir( MYDIR
, $dir )) {
205 warn "cannot open sample data directory $dir";
207 # if no sample data is available,
209 $dir = C4
::Context
->config('intranetdir') . "/installer/data/$self->{dbms}/en";
210 opendir(MYDIR
, $dir) or warn "cannot open English sample data directory $dir";
211 $defaulted_to_en = 1;
214 my @listdir = sort grep { !/^\.|marcflavour/ && -d
"$dir/$_" } readdir(MYDIR
);
218 my $request = $self->{'dbh'}->prepare("SELECT value FROM systempreferences WHERE variable='FrameworksLoaded'");
220 my ($frameworksloaded) = $request->fetchrow;
221 $frameworksloaded = '' unless defined $frameworksloaded; # avoid warning
222 my %frameworksloaded;
223 foreach ( split( /\|/, $frameworksloaded ) ) {
224 $frameworksloaded{$_} = 1;
227 foreach my $requirelevel (@listdir) {
228 opendir( MYDIR
, "$dir/$requirelevel" );
229 my @listname = grep { !/^\./ && -f
"$dir/$requirelevel/$_" && $_ =~ m/\.sql$/ } readdir(MYDIR
);
234 my $name = substr( $_, 0, -4 );
235 open FILE
, "<:utf8","$dir/$requirelevel/$name.txt";
237 $lines =~ s/\n|\r/<br \/>/g
;
239 utf8
::encode
($lines) unless ( utf8
::is_utf8
($lines) );
240 my $mandatory = ($requirelevel =~ /(mandatory|requi|oblig|necess)/i);
244 'fwkfile' => "$dir/$requirelevel/$_",
245 'fwkdescription' => $lines,
246 'checked' => ( ( $frameworksloaded{$_} || $mandatory ) ?
1 : 0 ),
247 'mandatory' => $mandatory,
250 my @fwks = sort { $a->{'fwkname'} cmp $b->{'fwkname'} } @frameworklist;
252 $cell{"frameworks"} = \
@fwks;
253 $cell{"label"} = ucfirst($requirelevel);
254 $cell{"code"} = lc($requirelevel);
255 push @levellist, \
%cell;
258 return ($defaulted_to_en, \
@levellist);
263 my $list = $installer->sql_file_list($lang, $marcflavour, $subset_wanted);
265 Returns an arrayref containing the filepaths of installer SQL scripts
266 available for laod. The C<$lang> and C<$marcflavour> arguments
267 specify the desired language and MARC flavour. while C<$subset_wanted>
268 is a hashref containing possible named parameters 'mandatory' and 'optional'.
275 my $marcflavour = shift;
276 my $subset_wanted = shift;
278 my ($marc_defaulted_to_en, $marc_sql) = $self->marc_framework_sql_list($lang, $marcflavour);
279 my ($sample_defaulted_to_en, $sample_sql) = $self->sample_data_sql_list($lang);
284 if ($subset_wanted->{'mandatory'}) {
285 push @sql_list, $_->{'fwkfile'} if $_->{'mandatory'};
287 if ($subset_wanted->{'optional'}) {
288 push @sql_list, $_->{'fwkfile'} unless $_->{'mandatory'};
290 } @
{ $_->{'frameworks'} }
291 } (@
$marc_sql, @
$sample_sql);
296 =head2 load_db_schema
298 my $error = $installer->load_db_schema();
300 Loads the SQL script that creates Koha's tables and indexes. The
301 return value is a string containing error messages reported by the
309 my $datadir = C4
::Context
->config('intranetdir') . "/installer/data/$self->{dbms}";
310 my $error = $self->load_sql("$datadir/kohastructure.sql");
315 =head2 load_sql_in_order
317 my ($fwk_language, $list) = $installer->load_sql_in_order($all_languages, @sql_list);
319 Given a list of SQL scripts supplied in C<@sql_list>, loads each of them
320 into the database and sets the FrameworksLoaded system preference to names
321 of the scripts that were loaded.
323 The SQL files are loaded in alphabetical order by filename (not including
324 directory path). This means that dependencies among the scripts are to
325 be resolved by carefully naming them, keeping in mind that the directory name
326 does *not* currently count.
328 B<FIXME:> this is a rather delicate way of dealing with dependencies between
331 The return value C<$list> is an arrayref containing a hashref for each
332 "level" or directory containing SQL scripts; the hashref in turns contains
333 a list of hashrefs containing a list of each script load and any error
334 messages associated with the loading of each script.
336 B<FIXME:> The C<$fwk_language> code probably doesn't belong and needs to be
337 moved to a different method.
341 sub load_sql_in_order
{
343 my $all_languages = shift;
349 my @aa = split /\/|\\/, ($a);
350 my @bb = split /\/|\\/, ($b);
353 my $request = $self->{'dbh'}->prepare( "SELECT value FROM systempreferences WHERE variable='FrameworksLoaded'" );
355 my ($systempreference) = $request->fetchrow;
356 $systempreference = '' unless defined $systempreference; # avoid warning
357 # Make sure the global sysprefs.sql file is loaded first
358 my $globalsysprefs = C4
::Context
->config('intranetdir') . "/installer/data/$self->{dbms}/sysprefs.sql";
359 unshift(@fnames, $globalsysprefs);
360 foreach my $file (@fnames) {
363 my $error = $self->load_sql($file);
364 my @file = split qr
(\
/|\\), $file;
365 $lang = $file[ scalar(@file) - 3 ] unless ($lang);
366 my $level = $file[ scalar(@file) - 2 ];
368 $systempreference .= "$file[scalar(@file)-1]|"
369 unless ( index( $systempreference, $file[ scalar(@file) - 1 ] ) >= 0 );
372 #Bulding here a hierarchy to display files by level.
373 push @
{ $hashlevel{$level} },
374 { "fwkname" => $file[ scalar(@file) - 1 ], "error" => $error };
377 #systempreference contains an ending |
378 chop $systempreference;
380 map { push @list, { "level" => $_, "fwklist" => $hashlevel{$_} } } keys %hashlevel;
382 for my $each_language (@
$all_languages) {
384 # warn "CODE".$each_language->{'language_code'};
385 # warn "LANG:".$lang;
386 if ( $lang eq $each_language->{'language_code'} ) {
387 $fwk_language = $each_language->{language_locale_name
};
392 "UPDATE systempreferences set value=\"$systempreference\" where variable='FrameworksLoaded'"
395 unless ( $updateflag == 1 ) {
397 "INSERT INTO systempreferences (value, variable, explanation, type) VALUES (\"$systempreference\",'FrameworksLoaded','Frameworks loaded through webinstaller','choice')";
398 my $rq = $self->{'dbh'}->prepare($string);
401 return ($fwk_language, \
@list);
404 =head2 set_marcflavour_syspref
406 $installer->set_marcflavour_syspref($marcflavour);
408 Set the 'marcflavour' system preference. The incoming
409 C<$marcflavour> references to a subdirectory of
410 installer/data/$dbms/$lang/marcflavour, and is
411 normalized to MARC21 or UNIMARC.
413 FIXME: this method assumes that the MARC flavour will be either
418 sub set_marcflavour_syspref
{
420 my $marcflavour = shift;
422 # we can have some variants of marc flavour, by having different directories, like : unimarc_small and unimarc_full, for small and complete unimarc frameworks.
423 # marc_cleaned finds the marcflavour, without the variant.
424 my $marc_cleaned = 'MARC21';
425 $marc_cleaned = 'UNIMARC' if $marcflavour =~ /unimarc/i;
427 $self->{'dbh'}->prepare(
428 "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');"
433 =head2 set_indexing_engine
435 $installer->set_indexing_engine($nozebra);
437 Sets system preferences related to the indexing
438 engine. The C<$nozebra> argument is a boolean;
439 if true, turn on NoZebra mode and turn off QueryFuzzy,
440 QueryWeightFields, and QueryStemming. If false, turn
441 off NoZebra mode (i.e., use the Zebra search engine).
445 sub set_indexing_engine
{
450 $self->{'dbh'}->do("UPDATE systempreferences SET value=1 WHERE variable='NoZebra'");
451 $self->{'dbh'}->do("UPDATE systempreferences SET value=0 WHERE variable in ('QueryFuzzy','QueryWeightFields','QueryStemming')");
453 $self->{'dbh'}->do("UPDATE systempreferences SET value=0 WHERE variable='NoZebra'");
458 =head2 set_version_syspref
460 $installer->set_version_syspref();
462 Set or update the 'Version' system preference to the current
463 Koha software version.
467 sub set_version_syspref
{
470 my $kohaversion=C4
::Context
::KOHAVERSION
;
471 # remove the 3 last . to have a Perl number
472 $kohaversion =~ s/(.*\..*)\.(.*)\.(.*)/$1$2$3/;
473 if (C4
::Context
->preference('Version')) {
474 warn "UPDATE Version";
475 my $finish=$self->{'dbh'}->prepare("UPDATE systempreferences SET value=? WHERE variable='Version'");
476 $finish->execute($kohaversion);
478 warn "INSERT Version";
479 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')");
480 $finish->execute($kohaversion);
482 C4
::Context
->clear_syspref_cache();
487 my $error = $installer->load_sql($filename);
489 Runs a the specified SQL using the DB's command-line
490 SQL tool, and returns any strings sent to STDERR
491 by the command-line tool.
493 B<FIXME:> there has been a long-standing desire to
494 replace this with an SQL loader that goes
495 through DBI; partly for portability issues
496 and partly to improve error handling.
498 B<FIXME:> even using the command-line loader, some more
499 basic error handling should be added - deal
500 with missing files, e.g.
506 my $filename = shift;
508 my $datadir = C4
::Context
->config('intranetdir') . "/installer/data/$self->{dbms}";
511 if ( $self->{dbms
} eq 'mysql' ) {
513 . ( $self->{hostname
} ?
" -h $self->{hostname} " : "" )
514 . ( $self->{port
} ?
" -P $self->{port} " : "" )
515 . ( $self->{user
} ?
" -u $self->{user} " : "" )
516 . ( $self->{password
} ?
" -p'$self->{password}'" : "" )
517 . " $self->{dbname} ";
518 $error = qx($strcmd --default-character
-set
=utf8
<$filename 2>&1 1>/dev/null
);
519 } elsif ( $self->{dbms
} eq 'Pg' ) {
521 . ( $self->{hostname
} ?
" -h $self->{hostname} " : "" )
522 . ( $self->{port
} ?
" -p $self->{port} " : "" )
523 . ( $self->{user
} ?
" -U $self->{user} " : "" )
524 # . ( $self->{password} ? " -W $self->{password}" : "" ) # psql will NOT accept a password, but prompts...
525 . " $self->{dbname} "; # Therefore, be sure to run 'trust' on localhost in pg_hba.conf -fbcit
526 $error = qx($strcmd -f
$filename 2>&1 1>/dev/null
);
527 # Be sure to set 'client_min_messages = error' in postgresql.conf
528 # so that only true errors are returned to stderr or else the installer will
529 # report the import a failure although it really succeded -fbcit
531 # errors thrown while loading installer data should be logged
533 warn "C4::Installer::load_sql returned the following errors while attempting to load $filename:\n";
539 =head2 get_file_path_from_name
541 my $filename = $installer->get_file_path_from_name('script_name');
543 searches through the set of known SQL scripts and finds the fully
544 qualified path name for the script that mathches the input.
546 returns undef if no match was found.
551 sub get_file_path_from_name
{
553 my $partialname = shift;
555 my $lang = 'en'; # FIXME: how do I know what language I want?
557 my ($defaulted_to_en, $list) = $self->sample_data_sql_list($lang);
558 # warn( Data::Dumper->Dump( [ $list ], [ 'list' ] ) );
561 foreach my $frameworklist ( @
$list ) {
562 push @found, grep { $_->{'fwkfile'} =~ /$partialname$/ } @
{$frameworklist->{'frameworks'}};
565 # warn( Data::Dumper->Dump( [ \@found ], [ 'found' ] ) );
566 if ( 0 == scalar @found ) {
568 } elsif ( 1 < scalar @found ) {
569 warn "multiple results found for $partialname";
572 return $found[0]->{'fwkfile'};
580 C4::Installer is a refactoring of logic originally from installer/installer.pl, which was
581 originally written by Henri-Damien Laurant.
583 Koha Development Team <http://koha-community.org/>
585 Galen Charlton <galen.charlton@liblime.com>