Bug 9552 - BIB1 Relation "Greater Than" Attribute Not Mapped Properly in CCL.Properties
[koha.git] / C4 / Installer.pm
blob304698ed0eb9f3daa1ac7d4fb135372a57d0c40e
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 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
10 # version.
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.
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 = $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);
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 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.
89 =cut
91 sub marcflavour_list {
92 my $self = shift;
93 my $lang = shift;
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);
98 closedir MYDIR;
99 return \@list;
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>
109 and C<$marcflavour>.
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.
114 =cut
116 sub marc_framework_sql_list {
117 my $self = shift;
118 my $lang = shift;
119 my $marcflavour = shift;
121 my $defaulted_to_en = 0;
123 undef $/;
124 my $dir = C4::Context->config('intranetdir') . "/installer/data/$self->{dbms}/$lang/marcflavour/".lc($marcflavour);
125 unless (opendir( MYDIR, $dir )) {
126 if ($lang eq 'en') {
127 warn "cannot open MARC frameworks directory $dir";
128 } else {
129 # if no translated MARC framework is available,
130 # default to English
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);
137 closedir MYDIR;
139 my @fwklist;
140 my $request = $self->{'dbh'}->prepare("SELECT value FROM systempreferences WHERE variable='FrameworksLoaded'");
141 $request->execute;
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);
152 closedir MYDIR;
153 my %cell;
154 my @frameworklist;
155 map {
156 my $name = substr( $_, 0, -4 );
157 open my $fh, "<:encoding(UTF-8)", "$dir/$requirelevel/$name.txt";
158 my $lines = <$fh>;
159 $lines =~ s/\n|\r/<br \/>/g;
160 use utf8;
161 utf8::encode($lines) unless ( utf8::is_utf8($lines) );
162 my $mandatory = ($requirelevel =~ /(mandatory|requi|oblig|necess)/i);
163 push @frameworklist,
165 'fwkname' => $name,
166 'fwkfile' => "$dir/$requirelevel/$_",
167 'fwkdescription' => $lines,
168 'checked' => ( ( $frameworksloaded{$_} || $mandatory ) ? 1 : 0 ),
169 'mandatory' => $mandatory,
171 } @listname;
172 my @fwks =
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.
193 =cut
195 sub sample_data_sql_list {
196 my $self = shift;
197 my $lang = shift;
199 my $defaulted_to_en = 0;
201 undef $/;
202 my $dir = C4::Context->config('intranetdir') . "/installer/data/$self->{dbms}/$lang";
203 unless (opendir( MYDIR, $dir )) {
204 if ($lang eq 'en') {
205 warn "cannot open sample data directory $dir";
206 } else {
207 # if no sample data is available,
208 # default to English
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);
215 closedir MYDIR;
217 my @levellist;
218 my $request = $self->{'dbh'}->prepare("SELECT value FROM systempreferences WHERE variable='FrameworksLoaded'");
219 $request->execute;
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);
230 closedir MYDIR;
231 my %cell;
232 my @frameworklist;
233 map {
234 my $name = substr( $_, 0, -4 );
235 open my $fh , "<:encoding(UTF-8)", "$dir/$requirelevel/$name.txt";
236 my $lines = <$fh>;
237 $lines =~ s/\n|\r/<br \/>/g;
238 use utf8;
239 utf8::encode($lines) unless ( utf8::is_utf8($lines) );
240 my $mandatory = ($requirelevel =~ /(mandatory|requi|oblig|necess)/i);
241 push @frameworklist,
243 'fwkname' => $name,
244 'fwkfile' => "$dir/$requirelevel/$_",
245 'fwkdescription' => $lines,
246 'checked' => ( ( $frameworksloaded{$_} || $mandatory ) ? 1 : 0 ),
247 'mandatory' => $mandatory,
249 } @listname;
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);
261 =head2 sql_file_list
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'.
270 =cut
272 sub sql_file_list {
273 my $self = shift;
274 my $lang = shift;
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);
281 my @sql_list = ();
282 map {
283 map {
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);
293 return \@sql_list
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
302 load.
304 =cut
306 sub load_db_schema {
307 my $self = shift;
309 my $datadir = C4::Context->config('intranetdir') . "/installer/data/$self->{dbms}";
310 my $error = $self->load_sql("$datadir/kohastructure.sql");
311 return $error;
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
329 the install scripts.
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.
339 =cut
341 sub load_sql_in_order {
342 my $self = shift;
343 my $all_languages = shift;
344 my @sql_list = @_;
346 my $lang;
347 my %hashlevel;
348 my @fnames = sort {
349 my @aa = split /\/|\\/, ($a);
350 my @bb = split /\/|\\/, ($b);
351 $aa[-1] cmp $bb[-1]
352 } @sql_list;
353 my $request = $self->{'dbh'}->prepare( "SELECT value FROM systempreferences WHERE variable='FrameworksLoaded'" );
354 $request->execute;
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) {
361 # warn $file;
362 undef $/;
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 ];
367 unless ($error) {
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;
379 my @list;
380 map { push @list, { "level" => $_, "fwklist" => $hashlevel{$_} } } keys %hashlevel;
381 my $fwk_language;
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};
390 my $updateflag =
391 $self->{'dbh'}->do(
392 "UPDATE systempreferences set value=\"$systempreference\" where variable='FrameworksLoaded'"
395 unless ( $updateflag == 1 ) {
396 my $string =
397 "INSERT INTO systempreferences (value, variable, explanation, type) VALUES (\"$systempreference\",'FrameworksLoaded','Frameworks loaded through webinstaller','choice')";
398 my $rq = $self->{'dbh'}->prepare($string);
399 $rq->execute;
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
414 MARC21 or UNIMARC.
416 =cut
418 sub set_marcflavour_syspref {
419 my $self = shift;
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;
426 my $request =
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');"
430 $request->execute;
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).
443 =cut
445 sub set_indexing_engine {
446 my $self = shift;
447 my $nozebra = shift;
449 if ($nozebra) {
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')");
452 } else {
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.
465 =cut
467 sub set_version_syspref {
468 my $self = shift;
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);
477 } else {
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();
485 =head2 load_sql
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.
502 =cut
504 sub load_sql {
505 my $self = shift;
506 my $filename = shift;
508 my $datadir = C4::Context->config('intranetdir') . "/installer/data/$self->{dbms}";
509 my $error;
510 my $strcmd;
511 my $cmd;
512 if ( $self->{dbms} eq 'mysql' ) {
513 $cmd = qx(which mysql 2>/dev/null || whereis mysql 2>/dev/null);
514 chomp $cmd;
515 $cmd = $1 if ($cmd && $cmd =~ /^(.+?)[\r\n]+$/);
516 $cmd = 'mysql' if (!$cmd || !-x $cmd);
517 $strcmd = "$cmd "
518 . ( $self->{hostname} ? " -h $self->{hostname} " : "" )
519 . ( $self->{port} ? " -P $self->{port} " : "" )
520 . ( $self->{user} ? " -u $self->{user} " : "" )
521 . ( $self->{password} ? " -p'$self->{password}'" : "" )
522 . " $self->{dbname} ";
523 $error = qx($strcmd --default-character-set=utf8 <$filename 2>&1 1>/dev/null);
524 } elsif ( $self->{dbms} eq 'Pg' ) {
525 $cmd = qx(which psql 2>/dev/null || whereis psql 2>/dev/null);
526 chomp $cmd;
527 $cmd = $1 if ($cmd && $cmd =~ /^(.+?)[\r\n]+$/);
528 $cmd = 'psql' if (!$cmd || !-x $cmd);
529 $strcmd = "$cmd "
530 . ( $self->{hostname} ? " -h $self->{hostname} " : "" )
531 . ( $self->{port} ? " -p $self->{port} " : "" )
532 . ( $self->{user} ? " -U $self->{user} " : "" )
533 # . ( $self->{password} ? " -W $self->{password}" : "" ) # psql will NOT accept a password, but prompts...
534 . " $self->{dbname} "; # Therefore, be sure to run 'trust' on localhost in pg_hba.conf -fbcit
535 $error = qx($strcmd -f $filename 2>&1 1>/dev/null);
536 # Be sure to set 'client_min_messages = error' in postgresql.conf
537 # so that only true errors are returned to stderr or else the installer will
538 # report the import a failure although it really succeded -fbcit
540 # errors thrown while loading installer data should be logged
541 if($error) {
542 warn "C4::Installer::load_sql returned the following errors while attempting to load $filename:\n";
543 warn "$error";
545 return $error;
548 =head2 get_file_path_from_name
550 my $filename = $installer->get_file_path_from_name('script_name');
552 searches through the set of known SQL scripts and finds the fully
553 qualified path name for the script that mathches the input.
555 returns undef if no match was found.
558 =cut
560 sub get_file_path_from_name {
561 my $self = shift;
562 my $partialname = shift;
564 my $lang = 'en'; # FIXME: how do I know what language I want?
566 my ($defaulted_to_en, $list) = $self->sample_data_sql_list($lang);
567 # warn( Data::Dumper->Dump( [ $list ], [ 'list' ] ) );
569 my @found;
570 foreach my $frameworklist ( @$list ) {
571 push @found, grep { $_->{'fwkfile'} =~ /$partialname$/ } @{$frameworklist->{'frameworks'}};
574 # warn( Data::Dumper->Dump( [ \@found ], [ 'found' ] ) );
575 if ( 0 == scalar @found ) {
576 return;
577 } elsif ( 1 < scalar @found ) {
578 warn "multiple results found for $partialname";
579 return;
580 } else {
581 return $found[0]->{'fwkfile'};
587 =head1 AUTHOR
589 C4::Installer is a refactoring of logic originally from installer/installer.pl, which was
590 originally written by Henri-Damien Laurant.
592 Koha Development Team <http://koha-community.org/>
594 Galen Charlton <galen.charlton@liblime.com>
596 =cut