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