Bug 18089 - All XSLT testing singleBranchMode = 0 fails to show even if install has...
[koha.git] / C4 / Installer.pm
blobbd1b150b425cf8bfe9b3e2555081a4b915f1a470
1 package C4::Installer;
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>.
20 use Modern::Perl;
22 use Encode qw( encode is_utf8 );
23 use DBIx::RunSQL;
24 use C4::Context;
25 use C4::Installer::PerlModules;
26 use DBI;
27 use Koha;
29 use vars qw(@ISA @EXPORT);
30 BEGIN {
31 require Exporter;
32 @ISA = qw( Exporter );
33 push @EXPORT, qw( foreign_key_exists index_exists column_exists );
36 =head1 NAME
38 C4::Installer
40 =head1 SYNOPSIS
42 use C4::Installer;
43 my $installer = C4::Installer->new();
44 my $all_languages = getAllLanguages();
45 my $error = $installer->load_db_schema();
46 my $list;
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');
52 =head1 DESCRIPTION
54 =cut
56 =head1 METHODS
58 =head2 new
60 my $installer = C4::Installer->new();
62 Creates a new installer.
64 =cut
66 sub new {
67 my $class = shift;
69 my $self = {};
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;
86 bless $self, $class;
87 return $self;
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>
97 and C<$marcflavour>.
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.
102 =cut
104 sub marc_framework_sql_list {
105 my $self = shift;
106 my $lang = shift;
107 my $marcflavour = shift;
109 my $defaulted_to_en = 0;
111 undef $/;
112 my $dir = C4::Context->config('intranetdir') . "/installer/data/$self->{dbms}/$lang/marcflavour/".lc($marcflavour);
113 unless (opendir( MYDIR, $dir )) {
114 if ($lang eq 'en') {
115 warn "cannot open MARC frameworks directory $dir";
116 } else {
117 # if no translated MARC framework is available,
118 # default to English
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);
125 closedir MYDIR;
127 my @fwklist;
128 my $request = $self->{'dbh'}->prepare("SELECT value FROM systempreferences WHERE variable='FrameworksLoaded'");
129 $request->execute;
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);
140 closedir MYDIR;
141 my %cell;
142 my @frameworklist;
143 map {
144 my $name = substr( $_, 0, -4 );
145 open my $fh, "<:encoding(UTF-8)", "$dir/$requirelevel/$name.txt";
146 my $lines = <$fh>;
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);
150 push @frameworklist,
152 'fwkname' => $name,
153 'fwkfile' => "$dir/$requirelevel/$_",
154 'fwkdescription' => $lines,
155 'checked' => ( ( $frameworksloaded{$_} || $mandatory ) ? 1 : 0 ),
156 'mandatory' => $mandatory,
158 } @listname;
159 my @fwks =
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.
180 =cut
182 sub sample_data_sql_list {
183 my $self = shift;
184 my $lang = shift;
186 my $defaulted_to_en = 0;
188 undef $/;
189 my $dir = C4::Context->config('intranetdir') . "/installer/data/$self->{dbms}/$lang";
190 unless (opendir( MYDIR, $dir )) {
191 if ($lang eq 'en') {
192 warn "cannot open sample data directory $dir";
193 } else {
194 # if no sample data is available,
195 # default to English
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);
202 closedir MYDIR;
204 my @levellist;
205 my $request = $self->{'dbh'}->prepare("SELECT value FROM systempreferences WHERE variable='FrameworksLoaded'");
206 $request->execute;
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);
217 closedir MYDIR;
218 my %cell;
219 my @frameworklist;
220 map {
221 my $name = substr( $_, 0, -4 );
222 open my $fh , "<:encoding(UTF-8)", "$dir/$requirelevel/$name.txt";
223 my $lines = <$fh>;
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);
227 push @frameworklist,
229 'fwkname' => $name,
230 'fwkfile' => "$dir/$requirelevel/$_",
231 'fwkdescription' => $lines,
232 'checked' => ( ( $frameworksloaded{$_} || $mandatory ) ? 1 : 0 ),
233 'mandatory' => $mandatory,
235 } @listname;
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
253 load.
255 =cut
257 sub load_db_schema {
258 my $self = shift;
260 my $datadir = C4::Context->config('intranetdir') . "/installer/data/$self->{dbms}";
261 my $error = $self->load_sql("$datadir/kohastructure.sql");
262 return $error;
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
280 the install scripts.
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.
290 =cut
292 sub load_sql_in_order {
293 my $self = shift;
294 my $all_languages = shift;
295 my @sql_list = @_;
297 my $lang;
298 my %hashlevel;
299 my @fnames = sort {
300 my @aa = split /\/|\\/, ($a);
301 my @bb = split /\/|\\/, ($b);
302 $aa[-1] cmp $bb[-1]
303 } @sql_list;
304 my $request = $self->{'dbh'}->prepare( "SELECT value FROM systempreferences WHERE variable='FrameworksLoaded'" );
305 $request->execute;
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 authorised value categories are loaded at the beginning
312 my $av_cat = C4::Context->config('intranetdir') . "/installer/data/$self->{dbms}/mandatory/auth_val_cat.sql";
313 unshift(@fnames, $av_cat);
314 # Make sure the global sysprefs.sql file is loaded first
315 my $globalsysprefs = C4::Context->config('intranetdir') . "/installer/data/$self->{dbms}/sysprefs.sql";
316 unshift(@fnames, $globalsysprefs);
317 push @fnames, C4::Context->config('intranetdir') . "/installer/data/mysql/userflags.sql";
318 push @fnames, C4::Context->config('intranetdir') . "/installer/data/mysql/userpermissions.sql";
319 push @fnames, C4::Context->config('intranetdir') . "/installer/data/mysql/audio_alerts.sql";
320 push @fnames, C4::Context->config('intranetdir') . "/installer/data/mysql/mandatory/refund_lost_item_fee_rules.sql";
321 foreach my $file (@fnames) {
322 # warn $file;
323 undef $/;
324 my $error = $self->load_sql($file);
325 my @file = split qr(\/|\\), $file;
326 $lang = $file[ scalar(@file) - 3 ] unless ($lang);
327 my $level = $file[ scalar(@file) - 2 ];
328 unless ($error) {
329 $systempreference .= "$file[scalar(@file)-1]|"
330 unless ( index( $systempreference, $file[ scalar(@file) - 1 ] ) >= 0 );
333 #Bulding here a hierarchy to display files by level.
334 push @{ $hashlevel{$level} },
335 { "fwkname" => $file[ scalar(@file) - 1 ], "error" => $error };
338 #systempreference contains an ending |
339 chop $systempreference;
340 my @list;
341 map { push @list, { "level" => $_, "fwklist" => $hashlevel{$_} } } keys %hashlevel;
342 my $fwk_language;
343 for my $each_language (@$all_languages) {
345 # warn "CODE".$each_language->{'language_code'};
346 # warn "LANG:".$lang;
347 if ( $lang eq $each_language->{'language_code'} ) {
348 $fwk_language = $each_language->{language_locale_name};
351 my $updateflag =
352 $self->{'dbh'}->do(
353 "UPDATE systempreferences set value=\"$systempreference\" where variable='FrameworksLoaded'"
356 unless ( $updateflag == 1 ) {
357 my $string =
358 "INSERT INTO systempreferences (value, variable, explanation, type) VALUES (\"$systempreference\",'FrameworksLoaded','Frameworks loaded through webinstaller','choice')";
359 my $rq = $self->{'dbh'}->prepare($string);
360 $rq->execute;
362 return ($fwk_language, \@list);
365 =head2 set_marcflavour_syspref
367 $installer->set_marcflavour_syspref($marcflavour);
369 Set the 'marcflavour' system preference. The incoming
370 C<$marcflavour> references to a subdirectory of
371 installer/data/$dbms/$lang/marcflavour, and is
372 normalized to MARC21, UNIMARC or NORMARC.
374 FIXME: this method assumes that the MARC flavour will be either
375 MARC21, UNIMARC or NORMARC.
377 =cut
379 sub set_marcflavour_syspref {
380 my $self = shift;
381 my $marcflavour = shift;
383 # we can have some variants of marc flavour, by having different directories, like : unimarc_small and unimarc_full, for small and complete unimarc frameworks.
384 # marc_cleaned finds the marcflavour, without the variant.
385 my $marc_cleaned = 'MARC21';
386 $marc_cleaned = 'UNIMARC' if $marcflavour =~ /unimarc/i;
387 $marc_cleaned = 'NORMARC' if $marcflavour =~ /normarc/i;
388 my $request =
389 $self->{'dbh'}->prepare(
390 "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');"
392 $request->execute;
395 =head2 set_version_syspref
397 $installer->set_version_syspref();
399 Set or update the 'Version' system preference to the current
400 Koha software version.
402 =cut
404 sub set_version_syspref {
405 my $self = shift;
407 my $kohaversion = Koha::version();
408 # remove the 3 last . to have a Perl number
409 $kohaversion =~ s/(.*\..*)\.(.*)\.(.*)/$1$2$3/;
410 if (C4::Context->preference('Version')) {
411 warn "UPDATE Version";
412 my $finish=$self->{'dbh'}->prepare("UPDATE systempreferences SET value=? WHERE variable='Version'");
413 $finish->execute($kohaversion);
414 } else {
415 warn "INSERT Version";
416 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')");
417 $finish->execute($kohaversion);
419 C4::Context->clear_syspref_cache();
422 =head2 load_sql
424 my $error = $installer->load_sql($filename);
426 Runs a the specified SQL file using a sql loader DBIx::RunSQL
427 Returns any strings sent to STDERR
429 # FIXME This should be improved: sometimes the caller and load_sql warn the same
430 error.
432 =cut
434 sub load_sql {
435 my $self = shift;
436 my $filename = shift;
437 my $error;
439 my $dbh = $self->{ dbh };
441 my $dup_stderr;
442 do {
443 local *STDERR;
444 open STDERR, ">>", \$dup_stderr;
446 eval {
447 DBIx::RunSQL->run_sql_file(
448 dbh => $dbh,
449 sql => $filename,
453 # errors thrown while loading installer data should be logged
454 if( $dup_stderr ) {
455 warn "C4::Installer::load_sql returned the following errors while attempting to load $filename:\n";
456 $error = $dup_stderr;
460 return $error;
463 =head2 get_file_path_from_name
465 my $filename = $installer->get_file_path_from_name('script_name');
467 searches through the set of known SQL scripts and finds the fully
468 qualified path name for the script that mathches the input.
470 returns undef if no match was found.
473 =cut
475 sub get_file_path_from_name {
476 my $self = shift;
477 my $partialname = shift;
479 my $lang = 'en'; # FIXME: how do I know what language I want?
481 my ($defaulted_to_en, $list) = $self->sample_data_sql_list($lang);
482 # warn( Data::Dumper->Dump( [ $list ], [ 'list' ] ) );
484 my @found;
485 foreach my $frameworklist ( @$list ) {
486 push @found, grep { $_->{'fwkfile'} =~ /$partialname$/ } @{$frameworklist->{'frameworks'}};
489 # warn( Data::Dumper->Dump( [ \@found ], [ 'found' ] ) );
490 if ( 0 == scalar @found ) {
491 return;
492 } elsif ( 1 < scalar @found ) {
493 warn "multiple results found for $partialname";
494 return;
495 } else {
496 return $found[0]->{'fwkfile'};
501 sub foreign_key_exists {
502 my ( $table_name, $constraint_name ) = @_;
503 my $dbh = C4::Context->dbh;
504 my (undef, $infos) = $dbh->selectrow_array(qq|SHOW CREATE TABLE $table_name|);
505 return $infos =~ m|CONSTRAINT `$constraint_name` FOREIGN KEY|;
508 sub index_exists {
509 my ( $table_name, $key_name ) = @_;
510 my $dbh = C4::Context->dbh;
511 my ($exists) = $dbh->selectrow_array(
513 SHOW INDEX FROM $table_name
514 WHERE key_name = ?
515 |, undef, $key_name
517 return $exists;
520 sub column_exists {
521 my ( $table_name, $column_name ) = @_;
522 my $dbh = C4::Context->dbh;
523 my ($exists) = $dbh->selectrow_array(
525 SHOW COLUMNS FROM $table_name
526 WHERE Field = ?
527 |, undef, $column_name
529 return $exists;
532 =head1 AUTHOR
534 C4::Installer is a refactoring of logic originally from installer/installer.pl, which was
535 originally written by Henri-Damien Laurant.
537 Koha Development Team <http://koha-community.org/>
539 Galen Charlton <galen.charlton@liblime.com>
541 =cut