Bug 14811: Don't update permanent_location with CART or PROC
[koha.git] / C4 / Installer.pm
blob63be8679c4198e189ee0bb7d00eb4248004fc1d0
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 strict;
21 #use warnings; FIXME - Bug 2505
23 our $VERSION = 3.07.00.049;
24 use C4::Context;
25 use C4::Installer::PerlModules;
27 =head1 NAME
29 C4::Installer
31 =head1 SYNOPSIS
33 use C4::Installer;
34 my $installer = C4::Installer->new();
35 my $all_languages = getAllLanguages();
36 my $error = $installer->load_db_schema();
37 my $list;
38 #fill $list with list of sql files
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');
43 =head1 DESCRIPTION
45 =cut
47 =head1 METHODS
49 =head2 new
51 my $installer = C4::Installer->new();
53 Creates a new installer.
55 =cut
57 sub new {
58 my $class = shift;
60 my $self = {};
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;
77 bless $self, $class;
78 return $self;
81 =head2 marc_framework_sql_list
83 my ($defaulted_to_en, $list) =
84 $installer->marc_framework_sql_list($lang, $marcflavour);
86 Returns in C<$list> a structure listing the filename, description, section,
87 and mandatory/optional status of MARC framework scripts available for C<$lang>
88 and C<$marcflavour>.
90 If the C<$defaulted_to_en> return value is true, no scripts are available
91 for language C<$lang> and the 'en' ones are returned.
93 =cut
95 sub marc_framework_sql_list {
96 my $self = shift;
97 my $lang = shift;
98 my $marcflavour = shift;
100 my $defaulted_to_en = 0;
102 undef $/;
103 my $dir = C4::Context->config('intranetdir') . "/installer/data/$self->{dbms}/$lang/marcflavour/".lc($marcflavour);
104 unless (opendir( MYDIR, $dir )) {
105 if ($lang eq 'en') {
106 warn "cannot open MARC frameworks directory $dir";
107 } else {
108 # if no translated MARC framework is available,
109 # default to English
110 $dir = C4::Context->config('intranetdir') . "/installer/data/$self->{dbms}/en/marcflavour/".lc($marcflavour);
111 opendir(MYDIR, $dir) or warn "cannot open English MARC frameworks directory $dir";
112 $defaulted_to_en = 1;
115 my @listdir = sort grep { !/^\.|marcflavour/ && -d "$dir/$_" } readdir(MYDIR);
116 closedir MYDIR;
118 my @fwklist;
119 my $request = $self->{'dbh'}->prepare("SELECT value FROM systempreferences WHERE variable='FrameworksLoaded'");
120 $request->execute;
121 my ($frameworksloaded) = $request->fetchrow;
122 $frameworksloaded = '' unless defined $frameworksloaded; # avoid warning
123 my %frameworksloaded;
124 foreach ( split( /\|/, $frameworksloaded ) ) {
125 $frameworksloaded{$_} = 1;
128 foreach my $requirelevel (@listdir) {
129 opendir( MYDIR, "$dir/$requirelevel" );
130 my @listname = grep { !/^\./ && -f "$dir/$requirelevel/$_" && $_ =~ m/\.sql$/ } readdir(MYDIR);
131 closedir MYDIR;
132 my %cell;
133 my @frameworklist;
134 map {
135 my $name = substr( $_, 0, -4 );
136 open my $fh, "<:encoding(UTF-8)", "$dir/$requirelevel/$name.txt";
137 my $lines = <$fh>;
138 $lines =~ s/\n|\r/<br \/>/g;
139 use utf8;
140 utf8::encode($lines) unless ( utf8::is_utf8($lines) );
141 my $mandatory = ($requirelevel =~ /(mandatory|requi|oblig|necess)/i);
142 push @frameworklist,
144 'fwkname' => $name,
145 'fwkfile' => "$dir/$requirelevel/$_",
146 'fwkdescription' => $lines,
147 'checked' => ( ( $frameworksloaded{$_} || $mandatory ) ? 1 : 0 ),
148 'mandatory' => $mandatory,
150 } @listname;
151 my @fwks =
152 sort { $a->{'fwkname'} cmp $b->{'fwkname'} } @frameworklist;
154 $cell{"frameworks"} = \@fwks;
155 $cell{"label"} = ucfirst($requirelevel);
156 $cell{"code"} = lc($requirelevel);
157 push @fwklist, \%cell;
160 return ($defaulted_to_en, \@fwklist);
163 =head2 sample_data_sql_list
165 my ($defaulted_to_en, $list) = $installer->sample_data_sql_list($lang);
167 Returns in C<$list> a structure listing the filename, description, section,
168 and mandatory/optional status of sample data scripts available for C<$lang>.
169 If the C<$defaulted_to_en> return value is true, no scripts are available
170 for language C<$lang> and the 'en' ones are returned.
172 =cut
174 sub sample_data_sql_list {
175 my $self = shift;
176 my $lang = shift;
178 my $defaulted_to_en = 0;
180 undef $/;
181 my $dir = C4::Context->config('intranetdir') . "/installer/data/$self->{dbms}/$lang";
182 unless (opendir( MYDIR, $dir )) {
183 if ($lang eq 'en') {
184 warn "cannot open sample data directory $dir";
185 } else {
186 # if no sample data is available,
187 # default to English
188 $dir = C4::Context->config('intranetdir') . "/installer/data/$self->{dbms}/en";
189 opendir(MYDIR, $dir) or warn "cannot open English sample data directory $dir";
190 $defaulted_to_en = 1;
193 my @listdir = sort grep { !/^\.|marcflavour/ && -d "$dir/$_" } readdir(MYDIR);
194 closedir MYDIR;
196 my @levellist;
197 my $request = $self->{'dbh'}->prepare("SELECT value FROM systempreferences WHERE variable='FrameworksLoaded'");
198 $request->execute;
199 my ($frameworksloaded) = $request->fetchrow;
200 $frameworksloaded = '' unless defined $frameworksloaded; # avoid warning
201 my %frameworksloaded;
202 foreach ( split( /\|/, $frameworksloaded ) ) {
203 $frameworksloaded{$_} = 1;
206 foreach my $requirelevel (@listdir) {
207 opendir( MYDIR, "$dir/$requirelevel" );
208 my @listname = grep { !/^\./ && -f "$dir/$requirelevel/$_" && $_ =~ m/\.sql$/ } readdir(MYDIR);
209 closedir MYDIR;
210 my %cell;
211 my @frameworklist;
212 map {
213 my $name = substr( $_, 0, -4 );
214 open my $fh , "<:encoding(UTF-8)", "$dir/$requirelevel/$name.txt";
215 my $lines = <$fh>;
216 $lines =~ s/\n|\r/<br \/>/g;
217 use utf8;
218 utf8::encode($lines) unless ( utf8::is_utf8($lines) );
219 my $mandatory = ($requirelevel =~ /(mandatory|requi|oblig|necess)/i);
220 push @frameworklist,
222 'fwkname' => $name,
223 'fwkfile' => "$dir/$requirelevel/$_",
224 'fwkdescription' => $lines,
225 'checked' => ( ( $frameworksloaded{$_} || $mandatory ) ? 1 : 0 ),
226 'mandatory' => $mandatory,
228 } @listname;
229 my @fwks = sort { $a->{'fwkname'} cmp $b->{'fwkname'} } @frameworklist;
231 $cell{"frameworks"} = \@fwks;
232 $cell{"label"} = ucfirst($requirelevel);
233 $cell{"code"} = lc($requirelevel);
234 push @levellist, \%cell;
237 return ($defaulted_to_en, \@levellist);
240 =head2 load_db_schema
242 my $error = $installer->load_db_schema();
244 Loads the SQL script that creates Koha's tables and indexes. The
245 return value is a string containing error messages reported by the
246 load.
248 =cut
250 sub load_db_schema {
251 my $self = shift;
253 my $datadir = C4::Context->config('intranetdir') . "/installer/data/$self->{dbms}";
254 my $error = $self->load_sql("$datadir/kohastructure.sql");
255 return $error;
259 =head2 load_sql_in_order
261 my ($fwk_language, $list) = $installer->load_sql_in_order($all_languages, @sql_list);
263 Given a list of SQL scripts supplied in C<@sql_list>, loads each of them
264 into the database and sets the FrameworksLoaded system preference to names
265 of the scripts that were loaded.
267 The SQL files are loaded in alphabetical order by filename (not including
268 directory path). This means that dependencies among the scripts are to
269 be resolved by carefully naming them, keeping in mind that the directory name
270 does *not* currently count.
272 B<FIXME:> this is a rather delicate way of dealing with dependencies between
273 the install scripts.
275 The return value C<$list> is an arrayref containing a hashref for each
276 "level" or directory containing SQL scripts; the hashref in turns contains
277 a list of hashrefs containing a list of each script load and any error
278 messages associated with the loading of each script.
280 B<FIXME:> The C<$fwk_language> code probably doesn't belong and needs to be
281 moved to a different method.
283 =cut
285 sub load_sql_in_order {
286 my $self = shift;
287 my $all_languages = shift;
288 my @sql_list = @_;
290 my $lang;
291 my %hashlevel;
292 my @fnames = sort {
293 my @aa = split /\/|\\/, ($a);
294 my @bb = split /\/|\\/, ($b);
295 $aa[-1] cmp $bb[-1]
296 } @sql_list;
297 my $request = $self->{'dbh'}->prepare( "SELECT value FROM systempreferences WHERE variable='FrameworksLoaded'" );
298 $request->execute;
299 my ($systempreference) = $request->fetchrow;
300 $systempreference = '' unless defined $systempreference; # avoid warning
301 # Make sure subtag_registry.sql is loaded second
302 my $subtag_registry = C4::Context->config('intranetdir') . "/installer/data/$self->{dbms}/mandatory/subtag_registry.sql";
303 unshift(@fnames, $subtag_registry);
304 # Make sure the global sysprefs.sql file is loaded first
305 my $globalsysprefs = C4::Context->config('intranetdir') . "/installer/data/$self->{dbms}/sysprefs.sql";
306 unshift(@fnames, $globalsysprefs);
307 foreach my $file (@fnames) {
308 # warn $file;
309 undef $/;
310 my $error = $self->load_sql($file);
311 my @file = split qr(\/|\\), $file;
312 $lang = $file[ scalar(@file) - 3 ] unless ($lang);
313 my $level = $file[ scalar(@file) - 2 ];
314 unless ($error) {
315 $systempreference .= "$file[scalar(@file)-1]|"
316 unless ( index( $systempreference, $file[ scalar(@file) - 1 ] ) >= 0 );
319 #Bulding here a hierarchy to display files by level.
320 push @{ $hashlevel{$level} },
321 { "fwkname" => $file[ scalar(@file) - 1 ], "error" => $error };
324 #systempreference contains an ending |
325 chop $systempreference;
326 my @list;
327 map { push @list, { "level" => $_, "fwklist" => $hashlevel{$_} } } keys %hashlevel;
328 my $fwk_language;
329 for my $each_language (@$all_languages) {
331 # warn "CODE".$each_language->{'language_code'};
332 # warn "LANG:".$lang;
333 if ( $lang eq $each_language->{'language_code'} ) {
334 $fwk_language = $each_language->{language_locale_name};
337 my $updateflag =
338 $self->{'dbh'}->do(
339 "UPDATE systempreferences set value=\"$systempreference\" where variable='FrameworksLoaded'"
342 unless ( $updateflag == 1 ) {
343 my $string =
344 "INSERT INTO systempreferences (value, variable, explanation, type) VALUES (\"$systempreference\",'FrameworksLoaded','Frameworks loaded through webinstaller','choice')";
345 my $rq = $self->{'dbh'}->prepare($string);
346 $rq->execute;
348 return ($fwk_language, \@list);
351 =head2 set_marcflavour_syspref
353 $installer->set_marcflavour_syspref($marcflavour);
355 Set the 'marcflavour' system preference. The incoming
356 C<$marcflavour> references to a subdirectory of
357 installer/data/$dbms/$lang/marcflavour, and is
358 normalized to MARC21, UNIMARC or NORMARC.
360 FIXME: this method assumes that the MARC flavour will be either
361 MARC21, UNIMARC or NORMARC.
363 =cut
365 sub set_marcflavour_syspref {
366 my $self = shift;
367 my $marcflavour = shift;
369 # we can have some variants of marc flavour, by having different directories, like : unimarc_small and unimarc_full, for small and complete unimarc frameworks.
370 # marc_cleaned finds the marcflavour, without the variant.
371 my $marc_cleaned = 'MARC21';
372 $marc_cleaned = 'UNIMARC' if $marcflavour =~ /unimarc/i;
373 $marc_cleaned = 'NORMARC' if $marcflavour =~ /normarc/i;
374 my $request =
375 $self->{'dbh'}->prepare(
376 "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');"
378 $request->execute;
381 =head2 set_version_syspref
383 $installer->set_version_syspref();
385 Set or update the 'Version' system preference to the current
386 Koha software version.
388 =cut
390 sub set_version_syspref {
391 my $self = shift;
393 my $kohaversion=C4::Context::KOHAVERSION;
394 # remove the 3 last . to have a Perl number
395 $kohaversion =~ s/(.*\..*)\.(.*)\.(.*)/$1$2$3/;
396 if (C4::Context->preference('Version')) {
397 warn "UPDATE Version";
398 my $finish=$self->{'dbh'}->prepare("UPDATE systempreferences SET value=? WHERE variable='Version'");
399 $finish->execute($kohaversion);
400 } else {
401 warn "INSERT Version";
402 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')");
403 $finish->execute($kohaversion);
405 C4::Context->clear_syspref_cache();
408 =head2 load_sql
410 my $error = $installer->load_sql($filename);
412 Runs a the specified SQL using the DB's command-line
413 SQL tool, and returns any strings sent to STDERR
414 by the command-line tool.
416 B<FIXME:> there has been a long-standing desire to
417 replace this with an SQL loader that goes
418 through DBI; partly for portability issues
419 and partly to improve error handling.
421 B<FIXME:> even using the command-line loader, some more
422 basic error handling should be added - deal
423 with missing files, e.g.
425 =cut
427 sub load_sql {
428 my $self = shift;
429 my $filename = shift;
431 my $datadir = C4::Context->config('intranetdir') . "/installer/data/$self->{dbms}";
432 my $error;
433 my $strcmd;
434 my $cmd;
435 if ( $self->{dbms} eq 'mysql' ) {
436 $cmd = qx(which mysql 2>/dev/null || whereis mysql 2>/dev/null);
437 chomp $cmd;
438 $cmd = $1 if ($cmd && $cmd =~ /^(.+?)[\r\n]+$/);
439 $cmd = 'mysql' if (!$cmd || !-x $cmd);
440 $strcmd = "$cmd "
441 . ( $self->{hostname} ? " -h $self->{hostname} " : "" )
442 . ( $self->{port} ? " -P $self->{port} " : "" )
443 . ( $self->{user} ? " -u $self->{user} " : "" )
444 . ( $self->{password} ? " -p'$self->{password}'" : "" )
445 . " $self->{dbname} ";
446 $error = qx($strcmd --default-character-set=utf8 <$filename 2>&1 1>/dev/null);
447 } elsif ( $self->{dbms} eq 'Pg' ) {
448 $cmd = qx(which psql 2>/dev/null || whereis psql 2>/dev/null);
449 chomp $cmd;
450 $cmd = $1 if ($cmd && $cmd =~ /^(.+?)[\r\n]+$/);
451 $cmd = 'psql' if (!$cmd || !-x $cmd);
452 $strcmd = "$cmd "
453 . ( $self->{hostname} ? " -h $self->{hostname} " : "" )
454 . ( $self->{port} ? " -p $self->{port} " : "" )
455 . ( $self->{user} ? " -U $self->{user} " : "" )
456 # . ( $self->{password} ? " -W $self->{password}" : "" ) # psql will NOT accept a password, but prompts...
457 . " $self->{dbname} "; # Therefore, be sure to run 'trust' on localhost in pg_hba.conf -fbcit
458 $error = qx($strcmd -f $filename 2>&1 1>/dev/null);
459 # Be sure to set 'client_min_messages = error' in postgresql.conf
460 # so that only true errors are returned to stderr or else the installer will
461 # report the import a failure although it really succeded -fbcit
463 # errors thrown while loading installer data should be logged
464 if($error) {
465 warn "C4::Installer::load_sql returned the following errors while attempting to load $filename:\n";
466 warn "$error";
468 return $error;
471 =head2 get_file_path_from_name
473 my $filename = $installer->get_file_path_from_name('script_name');
475 searches through the set of known SQL scripts and finds the fully
476 qualified path name for the script that mathches the input.
478 returns undef if no match was found.
481 =cut
483 sub get_file_path_from_name {
484 my $self = shift;
485 my $partialname = shift;
487 my $lang = 'en'; # FIXME: how do I know what language I want?
489 my ($defaulted_to_en, $list) = $self->sample_data_sql_list($lang);
490 # warn( Data::Dumper->Dump( [ $list ], [ 'list' ] ) );
492 my @found;
493 foreach my $frameworklist ( @$list ) {
494 push @found, grep { $_->{'fwkfile'} =~ /$partialname$/ } @{$frameworklist->{'frameworks'}};
497 # warn( Data::Dumper->Dump( [ \@found ], [ 'found' ] ) );
498 if ( 0 == scalar @found ) {
499 return;
500 } elsif ( 1 < scalar @found ) {
501 warn "multiple results found for $partialname";
502 return;
503 } else {
504 return $found[0]->{'fwkfile'};
510 =head1 AUTHOR
512 C4::Installer is a refactoring of logic originally from installer/installer.pl, which was
513 originally written by Henri-Damien Laurant.
515 Koha Development Team <http://koha-community.org/>
517 Galen Charlton <galen.charlton@liblime.com>
519 =cut