bug 8215: (followup) make sure C4::CourseReserves doesn't export anything
[koha.git] / C4 / Installer.pm
1 package C4::Installer;
2
3 # Copyright (C) 2008 LibLime
4 #
5 # This file is part of Koha.
6 #
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.
11 #
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.
15 #
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.
19
20 use strict;
21 #use warnings; FIXME - Bug 2505
22
23 our $VERSION = 3.07.00.049;
24 use C4::Context;
25 use C4::Installer::PerlModules;
26
27 =head1 NAME
28
29 C4::Installer
30
31 =head1 SYNOPSIS
32
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
42 =head1 DESCRIPTION
43
44 =cut
45
46 =head1 METHODS
47
48 =head2 new
49
50   my $installer = C4::Installer->new();
51
52 Creates a new installer.
53
54 =cut
55
56 sub new {
57     my $class = shift;
58
59     my $self = {};
60
61     # get basic information from context
62     $self->{'dbname'}   = C4::Context->config("database");
63     $self->{'dbms'}     = C4::Context->config("db_scheme") ? C4::Context->config("db_scheme") : "mysql";
64     $self->{'hostname'} = C4::Context->config("hostname");
65     $self->{'port'}     = C4::Context->config("port");
66     $self->{'user'}     = C4::Context->config("user");
67     $self->{'password'} = C4::Context->config("pass");
68     $self->{'dbh'} = DBI->connect("DBI:$self->{dbms}:dbname=$self->{dbname};host=$self->{hostname}" .
69                                   ( $self->{port} ? ";port=$self->{port}" : "" ),
70                                   $self->{'user'}, $self->{'password'});
71     $self->{'language'} = undef;
72     $self->{'marcflavour'} = undef;
73         $self->{'dbh'}->do('set NAMES "utf8"');
74     $self->{'dbh'}->{'mysql_enable_utf8'}=1;
75
76     bless $self, $class;
77     return $self;
78 }
79
80 =head2 marcflavour_list
81
82   my ($marcflavours) = $installer->marcflavour_list($lang);
83
84 Return a arrayref of the MARC flavour sets available for the
85 specified language C<$lang>.  Returns 'undef' if a directory
86 for the language does not exist.
87
88 =cut
89
90 sub marcflavour_list {
91     my $self = shift;
92     my $lang = shift;
93
94     my $dir = C4::Context->config('intranetdir') . "/installer/data/$self->{dbms}/$lang/marcflavour";
95     opendir(MYDIR, $dir) or return;
96     my @list = grep { !/^\.|CVS/ && -d "$dir/$_" } readdir(MYDIR);
97     closedir MYDIR;
98     return \@list;
99 }
100
101 =head2 marc_framework_sql_list
102
103   my ($defaulted_to_en, $list) = 
104      $installer->marc_framework_sql_list($lang, $marcflavour);
105
106 Returns in C<$list> a structure listing the filename, description, section,
107 and mandatory/optional status of MARC framework scripts available for C<$lang>
108 and C<$marcflavour>.
109
110 If the C<$defaulted_to_en> return value is true, no scripts are available
111 for language C<$lang> and the 'en' ones are returned.
112
113 =cut
114
115 sub marc_framework_sql_list {
116     my $self = shift;
117     my $lang = shift;
118     my $marcflavour = shift;
119
120     my $defaulted_to_en = 0;
121
122     undef $/;
123     my $dir = C4::Context->config('intranetdir') . "/installer/data/$self->{dbms}/$lang/marcflavour/".lc($marcflavour);
124     unless (opendir( MYDIR, $dir )) {
125         if ($lang eq 'en') {
126             warn "cannot open MARC frameworks directory $dir";
127         } else {
128             # if no translated MARC framework is available,
129             # default to English
130             $dir = C4::Context->config('intranetdir') . "/installer/data/$self->{dbms}/en/marcflavour/".lc($marcflavour);
131             opendir(MYDIR, $dir) or warn "cannot open English MARC frameworks directory $dir";
132             $defaulted_to_en = 1;
133         }
134     }
135     my @listdir = sort grep { !/^\.|marcflavour/ && -d "$dir/$_" } readdir(MYDIR);
136     closedir MYDIR;
137
138     my @fwklist;
139     my $request = $self->{'dbh'}->prepare("SELECT value FROM systempreferences WHERE variable='FrameworksLoaded'");
140     $request->execute;
141     my ($frameworksloaded) = $request->fetchrow;
142     $frameworksloaded = '' unless defined $frameworksloaded; # avoid warning
143     my %frameworksloaded;
144     foreach ( split( /\|/, $frameworksloaded ) ) {
145         $frameworksloaded{$_} = 1;
146     }
147
148     foreach my $requirelevel (@listdir) {
149         opendir( MYDIR, "$dir/$requirelevel" );
150         my @listname = grep { !/^\./ && -f "$dir/$requirelevel/$_" && $_ =~ m/\.sql$/ } readdir(MYDIR);
151         closedir MYDIR;
152         my %cell;
153         my @frameworklist;
154         map {
155             my $name = substr( $_, 0, -4 );
156             open my $fh, "<:encoding(UTF-8)", "$dir/$requirelevel/$name.txt";
157             my $lines = <$fh>;
158             $lines =~ s/\n|\r/<br \/>/g;
159             use utf8;
160             utf8::encode($lines) unless ( utf8::is_utf8($lines) );
161             my $mandatory = ($requirelevel =~ /(mandatory|requi|oblig|necess)/i);
162             push @frameworklist,
163               {
164                 'fwkname'        => $name,
165                 'fwkfile'        => "$dir/$requirelevel/$_",
166                 'fwkdescription' => $lines,
167                 'checked'        => ( ( $frameworksloaded{$_} || $mandatory ) ? 1 : 0 ),
168                 'mandatory'      => $mandatory,
169               };
170         } @listname;
171         my @fwks =
172           sort { $a->{'fwkname'} cmp $b->{'fwkname'} } @frameworklist;
173
174         $cell{"frameworks"} = \@fwks;
175         $cell{"label"}      = ucfirst($requirelevel);
176         $cell{"code"}       = lc($requirelevel);
177         push @fwklist, \%cell;
178     }
179
180     return ($defaulted_to_en, \@fwklist);
181 }
182
183 =head2 sample_data_sql_list
184
185   my ($defaulted_to_en, $list) = $installer->sample_data_sql_list($lang);
186
187 Returns in C<$list> a structure listing the filename, description, section,
188 and mandatory/optional status of sample data scripts available for C<$lang>.
189 If the C<$defaulted_to_en> return value is true, no scripts are available
190 for language C<$lang> and the 'en' ones are returned.
191
192 =cut
193
194 sub sample_data_sql_list {
195     my $self = shift;
196     my $lang = shift;
197
198     my $defaulted_to_en = 0;
199
200     undef $/;
201     my $dir = C4::Context->config('intranetdir') . "/installer/data/$self->{dbms}/$lang";
202     unless (opendir( MYDIR, $dir )) {
203         if ($lang eq 'en') {
204             warn "cannot open sample data directory $dir";
205         } else {
206             # if no sample data is available,
207             # default to English
208             $dir = C4::Context->config('intranetdir') . "/installer/data/$self->{dbms}/en";
209             opendir(MYDIR, $dir) or warn "cannot open English sample data directory $dir";
210             $defaulted_to_en = 1;
211         }
212     }
213     my @listdir = sort grep { !/^\.|marcflavour/ && -d "$dir/$_" } readdir(MYDIR);
214     closedir MYDIR;
215
216     my @levellist;
217     my $request = $self->{'dbh'}->prepare("SELECT value FROM systempreferences WHERE variable='FrameworksLoaded'");
218     $request->execute;
219     my ($frameworksloaded) = $request->fetchrow;
220     $frameworksloaded = '' unless defined $frameworksloaded; # avoid warning
221     my %frameworksloaded;
222     foreach ( split( /\|/, $frameworksloaded ) ) {
223         $frameworksloaded{$_} = 1;
224     }
225
226     foreach my $requirelevel (@listdir) {
227         opendir( MYDIR, "$dir/$requirelevel" );
228         my @listname = grep { !/^\./ && -f "$dir/$requirelevel/$_" && $_ =~ m/\.sql$/ } readdir(MYDIR);
229         closedir MYDIR;
230         my %cell;
231         my @frameworklist;
232         map {
233             my $name = substr( $_, 0, -4 );
234             open my $fh , "<:encoding(UTF-8)", "$dir/$requirelevel/$name.txt";
235             my $lines = <$fh>;
236             $lines =~ s/\n|\r/<br \/>/g;
237             use utf8;
238             utf8::encode($lines) unless ( utf8::is_utf8($lines) );
239             my $mandatory = ($requirelevel =~ /(mandatory|requi|oblig|necess)/i);
240             push @frameworklist,
241               {
242                 'fwkname'        => $name,
243                 'fwkfile'        => "$dir/$requirelevel/$_",
244                 'fwkdescription' => $lines,
245                 'checked'        => ( ( $frameworksloaded{$_} || $mandatory ) ? 1 : 0 ),
246                 'mandatory'      => $mandatory,
247               };
248         } @listname;
249         my @fwks = sort { $a->{'fwkname'} cmp $b->{'fwkname'} } @frameworklist;
250
251         $cell{"frameworks"} = \@fwks;
252         $cell{"label"}      = ucfirst($requirelevel);
253         $cell{"code"}       = lc($requirelevel);
254         push @levellist, \%cell;
255     }
256
257     return ($defaulted_to_en, \@levellist);
258 }
259
260 =head2 sql_file_list
261
262   my $list = $installer->sql_file_list($lang, $marcflavour, $subset_wanted);
263
264 Returns an arrayref containing the filepaths of installer SQL scripts
265 available for laod.  The C<$lang> and C<$marcflavour> arguments
266 specify the desired language and MARC flavour. while C<$subset_wanted>
267 is a hashref containing possible named parameters 'mandatory' and 'optional'.
268
269 =cut
270
271 sub sql_file_list {
272     my $self = shift;
273     my $lang = shift;
274     my $marcflavour = shift;
275     my $subset_wanted = shift;
276
277     my ($marc_defaulted_to_en, $marc_sql) = $self->marc_framework_sql_list($lang, $marcflavour);
278     my ($sample_defaulted_to_en, $sample_sql) = $self->sample_data_sql_list($lang);
279
280     my @sql_list = ();
281     map {
282         map {
283             if ($subset_wanted->{'mandatory'}) {
284                 push @sql_list, $_->{'fwkfile'} if $_->{'mandatory'};
285             }
286             if ($subset_wanted->{'optional'}) {
287                 push @sql_list, $_->{'fwkfile'} unless $_->{'mandatory'};
288             }
289         } @{ $_->{'frameworks'} }
290     } (@$marc_sql, @$sample_sql);
291
292     return \@sql_list
293 }
294
295 =head2 load_db_schema
296
297   my $error = $installer->load_db_schema();
298
299 Loads the SQL script that creates Koha's tables and indexes.  The
300 return value is a string containing error messages reported by the
301 load.
302
303 =cut
304
305 sub load_db_schema {
306     my $self = shift;
307
308     my $datadir = C4::Context->config('intranetdir') . "/installer/data/$self->{dbms}";
309     my $error = $self->load_sql("$datadir/kohastructure.sql");
310     return $error;
311
312 }
313
314 =head2 load_sql_in_order
315
316   my ($fwk_language, $list) = $installer->load_sql_in_order($all_languages, @sql_list);
317
318 Given a list of SQL scripts supplied in C<@sql_list>, loads each of them
319 into the database and sets the FrameworksLoaded system preference to names
320 of the scripts that were loaded.
321
322 The SQL files are loaded in alphabetical order by filename (not including
323 directory path).  This means that dependencies among the scripts are to
324 be resolved by carefully naming them, keeping in mind that the directory name
325 does *not* currently count.
326
327 B<FIXME:> this is a rather delicate way of dealing with dependencies between
328 the install scripts.
329
330 The return value C<$list> is an arrayref containing a hashref for each
331 "level" or directory containing SQL scripts; the hashref in turns contains
332 a list of hashrefs containing a list of each script load and any error
333 messages associated with the loading of each script.
334
335 B<FIXME:> The C<$fwk_language> code probably doesn't belong and needs to be
336 moved to a different method.
337
338 =cut
339
340 sub load_sql_in_order {
341     my $self = shift;
342     my $all_languages = shift;
343     my @sql_list = @_;
344
345     my $lang;
346     my %hashlevel;
347     my @fnames = sort {
348         my @aa = split /\/|\\/, ($a);
349         my @bb = split /\/|\\/, ($b);
350         $aa[-1] cmp $bb[-1]
351     } @sql_list;
352     my $request = $self->{'dbh'}->prepare( "SELECT value FROM systempreferences WHERE variable='FrameworksLoaded'" );
353     $request->execute;
354     my ($systempreference) = $request->fetchrow;
355     $systempreference = '' unless defined $systempreference; # avoid warning
356     # Make sure the global sysprefs.sql file is loaded first
357     my $globalsysprefs = C4::Context->config('intranetdir') . "/installer/data/$self->{dbms}/sysprefs.sql";
358     unshift(@fnames, $globalsysprefs);
359     foreach my $file (@fnames) {
360         #      warn $file;
361         undef $/;
362         my $error = $self->load_sql($file);
363         my @file = split qr(\/|\\), $file;
364         $lang = $file[ scalar(@file) - 3 ] unless ($lang);
365         my $level = $file[ scalar(@file) - 2 ];
366         unless ($error) {
367             $systempreference .= "$file[scalar(@file)-1]|"
368               unless ( index( $systempreference, $file[ scalar(@file) - 1 ] ) >= 0 );
369         }
370
371         #Bulding here a hierarchy to display files by level.
372         push @{ $hashlevel{$level} },
373           { "fwkname" => $file[ scalar(@file) - 1 ], "error" => $error };
374     }
375
376     #systempreference contains an ending |
377     chop $systempreference;
378     my @list;
379     map { push @list, { "level" => $_, "fwklist" => $hashlevel{$_} } } keys %hashlevel;
380     my $fwk_language;
381     for my $each_language (@$all_languages) {
382
383         #       warn "CODE".$each_language->{'language_code'};
384         #       warn "LANG:".$lang;
385         if ( $lang eq $each_language->{'language_code'} ) {
386             $fwk_language = $each_language->{language_locale_name};
387         }
388     }
389     my $updateflag =
390       $self->{'dbh'}->do(
391         "UPDATE systempreferences set value=\"$systempreference\" where variable='FrameworksLoaded'"
392       );
393
394     unless ( $updateflag == 1 ) {
395         my $string =
396             "INSERT INTO systempreferences (value, variable, explanation, type) VALUES (\"$systempreference\",'FrameworksLoaded','Frameworks loaded through webinstaller','choice')";
397         my $rq = $self->{'dbh'}->prepare($string);
398         $rq->execute;
399     }
400     return ($fwk_language, \@list);
401 }
402
403 =head2 set_marcflavour_syspref
404
405   $installer->set_marcflavour_syspref($marcflavour);
406
407 Set the 'marcflavour' system preference.  The incoming
408 C<$marcflavour> references to a subdirectory of
409 installer/data/$dbms/$lang/marcflavour, and is
410 normalized to MARC21, UNIMARC or NORMARC.
411
412 FIXME: this method assumes that the MARC flavour will be either
413 MARC21, UNIMARC or NORMARC.
414
415 =cut
416
417 sub set_marcflavour_syspref {
418     my $self = shift;
419     my $marcflavour = shift;
420
421     # we can have some variants of marc flavour, by having different directories, like : unimarc_small and unimarc_full, for small and complete unimarc frameworks.
422     # marc_cleaned finds the marcflavour, without the variant.
423     my $marc_cleaned = 'MARC21';
424     $marc_cleaned = 'UNIMARC' if $marcflavour =~ /unimarc/i;
425     $marc_cleaned = 'NORMARC' if $marcflavour =~ /normarc/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, UNIMARC or NORMARC) used for character encoding','MARC21|UNIMARC|NORMARC','Choice');"
429         );
430     $request->execute;
431 }
432
433 =head2 set_version_syspref
434
435   $installer->set_version_syspref();
436
437 Set or update the 'Version' system preference to the current
438 Koha software version.
439
440 =cut
441
442 sub set_version_syspref {
443     my $self = shift;
444
445     my $kohaversion=C4::Context::KOHAVERSION;
446     # remove the 3 last . to have a Perl number
447     $kohaversion =~ s/(.*\..*)\.(.*)\.(.*)/$1$2$3/;
448     if (C4::Context->preference('Version')) {
449         warn "UPDATE Version";
450         my $finish=$self->{'dbh'}->prepare("UPDATE systempreferences SET value=? WHERE variable='Version'");
451         $finish->execute($kohaversion);
452     } else {
453         warn "INSERT Version";
454         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')");
455         $finish->execute($kohaversion);
456     }
457     C4::Context->clear_syspref_cache();
458 }
459
460 =head2 load_sql
461
462   my $error = $installer->load_sql($filename);
463
464 Runs a the specified SQL using the DB's command-line
465 SQL tool, and returns any strings sent to STDERR
466 by the command-line tool.
467
468 B<FIXME:> there has been a long-standing desire to
469 replace this with an SQL loader that goes
470 through DBI; partly for portability issues
471 and partly to improve error handling.
472
473 B<FIXME:> even using the command-line loader, some more
474 basic error handling should be added - deal
475 with missing files, e.g.
476
477 =cut
478
479 sub load_sql {
480     my $self = shift;
481     my $filename = shift;
482
483     my $datadir = C4::Context->config('intranetdir') . "/installer/data/$self->{dbms}";
484     my $error;
485     my $strcmd;
486     my $cmd;
487     if ( $self->{dbms} eq 'mysql' ) {
488         $cmd = qx(which mysql 2>/dev/null || whereis mysql 2>/dev/null);
489         chomp $cmd;
490         $cmd = $1 if ($cmd && $cmd =~ /^(.+?)[\r\n]+$/);
491         $cmd = 'mysql' if (!$cmd || !-x $cmd);
492         $strcmd = "$cmd "
493             . ( $self->{hostname} ? " -h $self->{hostname} " : "" )
494             . ( $self->{port}     ? " -P $self->{port} "     : "" )
495             . ( $self->{user}     ? " -u $self->{user} "     : "" )
496             . ( $self->{password} ? " -p'$self->{password}'"   : "" )
497             . " $self->{dbname} ";
498         $error = qx($strcmd --default-character-set=utf8 <$filename 2>&1 1>/dev/null);
499     } elsif ( $self->{dbms} eq 'Pg' ) {
500         $cmd = qx(which psql 2>/dev/null || whereis psql 2>/dev/null);
501         chomp $cmd;
502         $cmd = $1 if ($cmd && $cmd =~ /^(.+?)[\r\n]+$/);
503         $cmd = 'psql' if (!$cmd || !-x $cmd);
504         $strcmd = "$cmd "
505             . ( $self->{hostname} ? " -h $self->{hostname} " : "" )
506             . ( $self->{port}     ? " -p $self->{port} "     : "" )
507             . ( $self->{user}     ? " -U $self->{user} "     : "" )
508 #            . ( $self->{password} ? " -W $self->{password}"   : "" )       # psql will NOT accept a password, but prompts...
509             . " $self->{dbname} ";                        # Therefore, be sure to run 'trust' on localhost in pg_hba.conf -fbcit
510         $error = qx($strcmd -f $filename 2>&1 1>/dev/null);
511         # Be sure to set 'client_min_messages = error' in postgresql.conf
512         # so that only true errors are returned to stderr or else the installer will
513         # report the import a failure although it really succeded -fbcit
514     }
515 #   errors thrown while loading installer data should be logged
516     if($error) {
517       warn "C4::Installer::load_sql returned the following errors while attempting to load $filename:\n";
518       warn "$error";
519     }
520     return $error;
521 }
522
523 =head2 get_file_path_from_name
524
525   my $filename = $installer->get_file_path_from_name('script_name');
526
527 searches through the set of known SQL scripts and finds the fully
528 qualified path name for the script that mathches the input.
529
530 returns undef if no match was found.
531
532
533 =cut
534
535 sub get_file_path_from_name {
536     my $self = shift;
537     my $partialname = shift;
538
539     my $lang = 'en'; # FIXME: how do I know what language I want?
540
541     my ($defaulted_to_en, $list) = $self->sample_data_sql_list($lang);
542     # warn( Data::Dumper->Dump( [ $list ], [ 'list' ] ) );
543
544     my @found;
545     foreach my $frameworklist ( @$list ) {
546         push @found, grep { $_->{'fwkfile'} =~ /$partialname$/ } @{$frameworklist->{'frameworks'}};
547     }
548
549     # warn( Data::Dumper->Dump( [ \@found ], [ 'found' ] ) );
550     if ( 0 == scalar @found ) {
551         return;
552     } elsif ( 1 < scalar @found ) {
553         warn "multiple results found for $partialname";
554         return;
555     } else {
556         return $found[0]->{'fwkfile'};
557     }
558
559 }
560
561
562 =head1 AUTHOR
563
564 C4::Installer is a refactoring of logic originally from installer/installer.pl, which was
565 originally written by Henri-Damien Laurant.
566
567 Koha Development Team <http://koha-community.org/>
568
569 Galen Charlton <galen.charlton@liblime.com>
570
571 =cut
572
573 1;