File Coverage

File:C4/Installer.pm
Coverage:5.2%

linestmtbrancondsubtimecode
1package 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
1
1
1
1440
1
49
use strict;
21#use warnings; FIXME - Bug 2505
22
23our $VERSION = 3.00;
24
1
1
1
4
2
8
use C4::Context;
25
1
1
1
187
27
1372
use C4::Installer::PerlModules 1.000000;
26
27 - 45
=head1 NAME

C4::Installer

=head1 SYNOPSIS

 use C4::Installer;
 my $installer = C4::Installer->new();
 my $all_languages = getAllLanguages();
 my $error = $installer->load_db_schema();
 my $list = $installer->sql_file_list('en', 'marc21', { optional => 1, mandatory => 1 });
 my ($fwk_language, $error_list) = $installer->load_sql_in_order($all_languages, @$list);
 $installer->set_version_syspref();
 $installer->set_marcflavour_syspref('MARC21');
 $installer->set_indexing_engine(0);

=head1 DESCRIPTION

=cut
46
47 - 55
=head1 METHODS

=head2 new

  my $installer = C4::Installer->new();

Creates a new installer.

=cut
56
57sub new {
58
0
    my $class = shift;
59
60
0
    my $self = {};
61
62    # get basic information from context
63
0
    $self->{'dbname'} = C4::Context->config("database");
64
0
    $self->{'dbms'} = C4::Context->config("db_scheme") ? C4::Context->config("db_scheme") : "mysql";
65
0
    $self->{'hostname'} = C4::Context->config("hostname");
66
0
    $self->{'port'} = C4::Context->config("port");
67
0
    $self->{'user'} = C4::Context->config("user");
68
0
    $self->{'password'} = C4::Context->config("pass");
69
0
    $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
0
    $self->{'language'} = undef;
73
0
    $self->{'marcflavour'} = undef;
74
0
        $self->{'dbh'}->do('set NAMES "utf8"');
75
0
    $self->{'dbh'}->{'mysql_enable_utf8'}=1;
76
77
0
    bless $self, $class;
78
0
    return $self;
79}
80
81 - 89
=head2 marcflavour_list

  my ($marcflavours) = $installer->marcflavour_list($lang);

Return a arrayref of the MARC flavour sets available for the
specified language C<$lang>.  Returns 'undef' if a directory
for the language does not exist.

=cut
90
91sub marcflavour_list {
92
0
    my $self = shift;
93
0
    my $lang = shift;
94
95
0
    my $dir = C4::Context->config('intranetdir') . "/installer/data/$self->{dbms}/$lang/marcflavour";
96
0
    opendir(MYDIR, $dir) or return;
97
0
0
    my @list = grep { !/^\.|CVS/ && -d "$dir/$_" } readdir(MYDIR);
98
0
    closedir MYDIR;
99
0
    return \@list;
100}
101
102 - 114
=head2 marc_framework_sql_list

  my ($defaulted_to_en, $list) = 
     $installer->marc_framework_sql_list($lang, $marcflavour);

Returns in C<$list> a structure listing the filename, description, section,
and mandatory/optional status of MARC framework scripts available for C<$lang>
and C<$marcflavour>.

If the C<$defaulted_to_en> return value is true, no scripts are available
for language C<$lang> and the 'en' ones are returned.

=cut
115
116sub marc_framework_sql_list {
117
0
    my $self = shift;
118
0
    my $lang = shift;
119
0
    my $marcflavour = shift;
120
121
0
    my $defaulted_to_en = 0;
122
123
0
    undef $/;
124
0
    my $dir = C4::Context->config('intranetdir') . "/installer/data/$self->{dbms}/$lang/marcflavour/".lc($marcflavour);
125
0
    unless (opendir( MYDIR, $dir )) {
126
0
        if ($lang eq 'en') {
127
0
            warn "cannot open MARC frameworks directory $dir";
128        } else {
129            # if no translated MARC framework is available,
130            # default to English
131
0
            $dir = C4::Context->config('intranetdir') . "/installer/data/$self->{dbms}/en/marcflavour/".lc($marcflavour);
132
0
            opendir(MYDIR, $dir) or warn "cannot open English MARC frameworks directory $dir";
133
0
            $defaulted_to_en = 1;
134        }
135    }
136
0
0
    my @listdir = sort grep { !/^\.|marcflavour/ && -d "$dir/$_" } readdir(MYDIR);
137
0
    closedir MYDIR;
138
139
0
    my @fwklist;
140
0
    my $request = $self->{'dbh'}->prepare("SELECT value FROM systempreferences WHERE variable='FrameworksLoaded'");
141
0
    $request->execute;
142
0
    my ($frameworksloaded) = $request->fetchrow;
143
0
    $frameworksloaded = '' unless defined $frameworksloaded; # avoid warning
144
0
    my %frameworksloaded;
145
0
    foreach ( split( /\|/, $frameworksloaded ) ) {
146
0
        $frameworksloaded{$_} = 1;
147    }
148
149
0
    foreach my $requirelevel (@listdir) {
150
0
        opendir( MYDIR, "$dir/$requirelevel" );
151
0
0
        my @listname = grep { !/^\./ && -f "$dir/$requirelevel/$_" && $_ =~ m/\.sql$/ } readdir(MYDIR);
152
0
        closedir MYDIR;
153
0
        my %cell;
154
0
        my @frameworklist;
155
0
        map {
156
0
            my $name = substr( $_, 0, -4 );
157
0
            open FILE, "<:utf8","$dir/$requirelevel/$name.txt";
158
0
            my $lines = <FILE>;
159
0
            $lines =~ s/\n|\r/<br \/>/g;
160
1
1
1
18
14
26
            use utf8;
161
0
            utf8::encode($lines) unless ( utf8::is_utf8($lines) );
162
0
            my $mandatory = ($requirelevel =~ /(mandatory|requi|oblig|necess)/i);
163
0
            push @frameworklist,
164              {
165                'fwkname' => $name,
166                'fwkfile' => "$dir/$requirelevel/$_",
167                'fwkdescription' => $lines,
168                'checked' => ( ( $frameworksloaded{$_} || $mandatory ) ? 1 : 0 ),
169                'mandatory' => $mandatory,
170              };
171        } @listname;
172
0
        my @fwks =
173
0
          sort { $a->{'fwkname'} cmp $b->{'fwkname'} } @frameworklist;
174
175
0
        $cell{"frameworks"} = \@fwks;
176
0
        $cell{"label"} = ucfirst($requirelevel);
177
0
        $cell{"code"} = lc($requirelevel);
178
0
        push @fwklist, \%cell;
179    }
180
181
0
    return ($defaulted_to_en, \@fwklist);
182}
183
184 - 193
=head2 sample_data_sql_list

  my ($defaulted_to_en, $list) = $installer->sample_data_sql_list($lang);

Returns in C<$list> a structure listing the filename, description, section,
and mandatory/optional status of sample data scripts available for C<$lang>.
If the C<$defaulted_to_en> return value is true, no scripts are available
for language C<$lang> and the 'en' ones are returned.

=cut
194
195sub sample_data_sql_list {
196
0
    my $self = shift;
197
0
    my $lang = shift;
198
199
0
    my $defaulted_to_en = 0;
200
201
0
    undef $/;
202
0
    my $dir = C4::Context->config('intranetdir') . "/installer/data/$self->{dbms}/$lang";
203
0
    unless (opendir( MYDIR, $dir )) {
204
0
        if ($lang eq 'en') {
205
0
            warn "cannot open sample data directory $dir";
206        } else {
207            # if no sample data is available,
208            # default to English
209
0
            $dir = C4::Context->config('intranetdir') . "/installer/data/$self->{dbms}/en";
210
0
            opendir(MYDIR, $dir) or warn "cannot open English sample data directory $dir";
211
0
            $defaulted_to_en = 1;
212        }
213    }
214
0
0
    my @listdir = sort grep { !/^\.|marcflavour/ && -d "$dir/$_" } readdir(MYDIR);
215
0
    closedir MYDIR;
216
217
0
    my @levellist;
218
0
    my $request = $self->{'dbh'}->prepare("SELECT value FROM systempreferences WHERE variable='FrameworksLoaded'");
219
0
    $request->execute;
220
0
    my ($frameworksloaded) = $request->fetchrow;
221
0
    $frameworksloaded = '' unless defined $frameworksloaded; # avoid warning
222
0
    my %frameworksloaded;
223
0
    foreach ( split( /\|/, $frameworksloaded ) ) {
224
0
        $frameworksloaded{$_} = 1;
225    }
226
227
0
    foreach my $requirelevel (@listdir) {
228
0
        opendir( MYDIR, "$dir/$requirelevel" );
229
0
0
        my @listname = grep { !/^\./ && -f "$dir/$requirelevel/$_" && $_ =~ m/\.sql$/ } readdir(MYDIR);
230
0
        closedir MYDIR;
231
0
        my %cell;
232
0
        my @frameworklist;
233
0
        map {
234
0
            my $name = substr( $_, 0, -4 );
235
0
            open FILE, "<:utf8","$dir/$requirelevel/$name.txt";
236
0
            my $lines = <FILE>;
237
0
            $lines =~ s/\n|\r/<br \/>/g;
238
1
1
1
826
11
18
            use utf8;
239
0
            utf8::encode($lines) unless ( utf8::is_utf8($lines) );
240
0
            my $mandatory = ($requirelevel =~ /(mandatory|requi|oblig|necess)/i);
241
0
            push @frameworklist,
242              {
243                'fwkname' => $name,
244                'fwkfile' => "$dir/$requirelevel/$_",
245                'fwkdescription' => $lines,
246                'checked' => ( ( $frameworksloaded{$_} || $mandatory ) ? 1 : 0 ),
247                'mandatory' => $mandatory,
248              };
249        } @listname;
250
0
0
        my @fwks = sort { $a->{'fwkname'} cmp $b->{'fwkname'} } @frameworklist;
251
252
0
        $cell{"frameworks"} = \@fwks;
253
0
        $cell{"label"} = ucfirst($requirelevel);
254
0
        $cell{"code"} = lc($requirelevel);
255
0
        push @levellist, \%cell;
256    }
257
258
0
    return ($defaulted_to_en, \@levellist);
259}
260
261 - 270
=head2 sql_file_list

  my $list = $installer->sql_file_list($lang, $marcflavour, $subset_wanted);

Returns an arrayref containing the filepaths of installer SQL scripts
available for laod.  The C<$lang> and C<$marcflavour> arguments
specify the desired language and MARC flavour. while C<$subset_wanted>
is a hashref containing possible named parameters 'mandatory' and 'optional'.

=cut
271
272sub sql_file_list {
273
0
    my $self = shift;
274
0
    my $lang = shift;
275
0
    my $marcflavour = shift;
276
0
    my $subset_wanted = shift;
277
278
0
    my ($marc_defaulted_to_en, $marc_sql) = $self->marc_framework_sql_list($lang, $marcflavour);
279
0
    my ($sample_defaulted_to_en, $sample_sql) = $self->sample_data_sql_list($lang);
280
281
0
    my @sql_list = ();
282    map {
283
0
        map {
284
0
0
            if ($subset_wanted->{'mandatory'}) {
285
0
                push @sql_list, $_->{'fwkfile'} if $_->{'mandatory'};
286            }
287
0
            if ($subset_wanted->{'optional'}) {
288
0
                push @sql_list, $_->{'fwkfile'} unless $_->{'mandatory'};
289            }
290
0
        } @{ $_->{'frameworks'} }
291    } (@$marc_sql, @$sample_sql);
292
293    return \@sql_list
294
0
}
295
296 - 304
=head2 load_db_schema

  my $error = $installer->load_db_schema();

Loads the SQL script that creates Koha's tables and indexes.  The
return value is a string containing error messages reported by the
load.

=cut
305
306sub load_db_schema {
307
0
    my $self = shift;
308
309
0
    my $datadir = C4::Context->config('intranetdir') . "/installer/data/$self->{dbms}";
310
0
    my $error = $self->load_sql("$datadir/kohastructure.sql");
311
0
    return $error;
312
313}
314
315 - 339
=head2 load_sql_in_order

  my ($fwk_language, $list) = $installer->load_sql_in_order($all_languages, @sql_list);

Given a list of SQL scripts supplied in C<@sql_list>, loads each of them
into the database and sets the FrameworksLoaded system preference to names
of the scripts that were loaded.

The SQL files are loaded in alphabetical order by filename (not including
directory path).  This means that dependencies among the scripts are to
be resolved by carefully naming them, keeping in mind that the directory name
does *not* currently count.

B<FIXME:> this is a rather delicate way of dealing with dependencies between
the install scripts.

The return value C<$list> is an arrayref containing a hashref for each
"level" or directory containing SQL scripts; the hashref in turns contains
a list of hashrefs containing a list of each script load and any error
messages associated with the loading of each script.

B<FIXME:> The C<$fwk_language> code probably doesn't belong and needs to be
moved to a different method.

=cut
340
341sub load_sql_in_order {
342
0
    my $self = shift;
343
0
    my $all_languages = shift;
344
0
    my @sql_list = @_;
345
346
0
    my $lang;
347
0
    my %hashlevel;
348
0
    my @fnames = sort {
349
0
        my @aa = split /\/|\\/, ($a);
350
0
        my @bb = split /\/|\\/, ($b);
351
0
        $aa[-1] cmp $bb[-1]
352    } @sql_list;
353
0
    my $request = $self->{'dbh'}->prepare( "SELECT value FROM systempreferences WHERE variable='FrameworksLoaded'" );
354
0
    $request->execute;
355
0
    my ($systempreference) = $request->fetchrow;
356
0
    $systempreference = '' unless defined $systempreference; # avoid warning
357    # Make sure the global sysprefs.sql file is loaded first
358
0
    my $globalsysprefs = C4::Context->config('intranetdir') . "/installer/data/$self->{dbms}/sysprefs.sql";
359
0
    unshift(@fnames, $globalsysprefs);
360
0
    foreach my $file (@fnames) {
361        # warn $file;
362
0
        undef $/;
363
0
        my $error = $self->load_sql($file);
364
0
        my @file = split qr(\/|\\), $file;
365
0
        $lang = $file[ scalar(@file) - 3 ] unless ($lang);
366
0
        my $level = $file[ scalar(@file) - 2 ];
367
0
        unless ($error) {
368
0
            $systempreference .= "$file[scalar(@file)-1]|"
369              unless ( index( $systempreference, $file[ scalar(@file) - 1 ] ) >= 0 );
370        }
371
372        #Bulding here a hierarchy to display files by level.
373
0
0
        push @{ $hashlevel{$level} },
374          { "fwkname" => $file[ scalar(@file) - 1 ], "error" => $error };
375    }
376
377    #systempreference contains an ending |
378
0
    chop $systempreference;
379
0
    my @list;
380
0
0
    map { push @list, { "level" => $_, "fwklist" => $hashlevel{$_} } } keys %hashlevel;
381
0
    my $fwk_language;
382
0
    for my $each_language (@$all_languages) {
383
384        # warn "CODE".$each_language->{'language_code'};
385        # warn "LANG:".$lang;
386
0
        if ( $lang eq $each_language->{'language_code'} ) {
387
0
            $fwk_language = $each_language->{language_locale_name};
388        }
389    }
390
0
    my $updateflag =
391      $self->{'dbh'}->do(
392        "UPDATE systempreferences set value=\"$systempreference\" where variable='FrameworksLoaded'"
393      );
394
395
0
    unless ( $updateflag == 1 ) {
396
0
        my $string =
397            "INSERT INTO systempreferences (value, variable, explanation, type) VALUES (\"$systempreference\",'FrameworksLoaded','Frameworks loaded through webinstaller','choice')";
398
0
        my $rq = $self->{'dbh'}->prepare($string);
399
0
        $rq->execute;
400    }
401
0
    return ($fwk_language, \@list);
402}
403
404 - 416
=head2 set_marcflavour_syspref

  $installer->set_marcflavour_syspref($marcflavour);

Set the 'marcflavour' system preference.  The incoming
C<$marcflavour> references to a subdirectory of
installer/data/$dbms/$lang/marcflavour, and is
normalized to MARC21 or UNIMARC.

FIXME: this method assumes that the MARC flavour will be either
MARC21 or UNIMARC.

=cut
417
418sub set_marcflavour_syspref {
419
0
    my $self = shift;
420
0
    my $marcflavour = shift;
421
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
0
    my $marc_cleaned = 'MARC21';
425
0
    $marc_cleaned = 'UNIMARC' if $marcflavour =~ /unimarc/i;
426
0
    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');"
429        );
430
0
    $request->execute;
431}
432
433 - 443
=head2 set_indexing_engine

  $installer->set_indexing_engine($nozebra);

Sets system preferences related to the indexing
engine.  The C<$nozebra> argument is a boolean;
if true, turn on NoZebra mode and turn off QueryFuzzy,
QueryWeightFields, and QueryStemming.  If false, turn
off NoZebra mode (i.e., use the Zebra search engine).

=cut
444
445sub set_indexing_engine {
446
0
    my $self = shift;
447
0
    my $nozebra = shift;
448
449
0
    if ($nozebra) {
450
0
        $self->{'dbh'}->do("UPDATE systempreferences SET value=1 WHERE variable='NoZebra'");
451
0
        $self->{'dbh'}->do("UPDATE systempreferences SET value=0 WHERE variable in ('QueryFuzzy','QueryWeightFields','QueryStemming')");
452    } else {
453
0
        $self->{'dbh'}->do("UPDATE systempreferences SET value=0 WHERE variable='NoZebra'");
454    }
455
456}
457
458 - 465
=head2 set_version_syspref

  $installer->set_version_syspref();

Set or update the 'Version' system preference to the current
Koha software version.

=cut
466
467sub set_version_syspref {
468
0
    my $self = shift;
469
470
0
    my $kohaversion=C4::Context::KOHAVERSION;
471    # remove the 3 last . to have a Perl number
472
0
    $kohaversion =~ s/(.*\..*)\.(.*)\.(.*)/$1$2$3/;
473
0
    if (C4::Context->preference('Version')) {
474
0
        warn "UPDATE Version";
475
0
        my $finish=$self->{'dbh'}->prepare("UPDATE systempreferences SET value=? WHERE variable='Version'");
476
0
        $finish->execute($kohaversion);
477    } else {
478
0
        warn "INSERT Version";
479
0
        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
0
        $finish->execute($kohaversion);
481    }
482
0
    C4::Context->clear_syspref_cache();
483}
484
485 - 502
=head2 load_sql

  my $error = $installer->load_sql($filename);

Runs a the specified SQL using the DB's command-line
SQL tool, and returns any strings sent to STDERR
by the command-line tool.

B<FIXME:> there has been a long-standing desire to
replace this with an SQL loader that goes
through DBI; partly for portability issues
and partly to improve error handling.

B<FIXME:> even using the command-line loader, some more
basic error handling should be added - deal
with missing files, e.g.

=cut
503
504sub load_sql {
505
0
    my $self = shift;
506
0
    my $filename = shift;
507
508
0
    my $datadir = C4::Context->config('intranetdir') . "/installer/data/$self->{dbms}";
509
0
    my $error;
510
0
    my $strcmd;
511
0
    my $cmd;
512
0
    if ( $self->{dbms} eq 'mysql' ) {
513
0
        $cmd = qx(which mysql 2>/dev/null || whereis mysql 2>/dev/null);
514
0
        chomp $cmd;
515
0
        $cmd = $1 if ($cmd && $cmd =~ /^(.+?)[\r\n]+$/);
516
0
        $cmd = 'mysql' if (!$cmd || !-x $cmd);
517
0
        $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
0
        $error = qx($strcmd --default-character-set=utf8 <$filename 2>&1 1>/dev/null);
524    } elsif ( $self->{dbms} eq 'Pg' ) {
525
0
        $cmd = qx(which psql 2>/dev/null || whereis psql 2>/dev/null);
526
0
        chomp $cmd;
527
0
        $cmd = $1 if ($cmd && $cmd =~ /^(.+?)[\r\n]+$/);
528
0
        $cmd = 'psql' if (!$cmd || !-x $cmd);
529
0
        $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
0
        $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
539    }
540# errors thrown while loading installer data should be logged
541
0
    if($error) {
542
0
      warn "C4::Installer::load_sql returned the following errors while attempting to load $filename:\n";
543
0
      warn "$error";
544    }
545
0
    return $error;
546}
547
548 - 558
=head2 get_file_path_from_name

  my $filename = $installer->get_file_path_from_name('script_name');

searches through the set of known SQL scripts and finds the fully
qualified path name for the script that mathches the input.

returns undef if no match was found.


=cut
559
560sub get_file_path_from_name {
561
0
    my $self = shift;
562
0
    my $partialname = shift;
563
564
0
    my $lang = 'en'; # FIXME: how do I know what language I want?
565
566
0
    my ($defaulted_to_en, $list) = $self->sample_data_sql_list($lang);
567    # warn( Data::Dumper->Dump( [ $list ], [ 'list' ] ) );
568
569
0
    my @found;
570
0
    foreach my $frameworklist ( @$list ) {
571
0
0
0
        push @found, grep { $_->{'fwkfile'} =~ /$partialname$/ } @{$frameworklist->{'frameworks'}};
572    }
573
574    # warn( Data::Dumper->Dump( [ \@found ], [ 'found' ] ) );
575
0
    if ( 0 == scalar @found ) {
576
0
        return;
577    } elsif ( 1 < scalar @found ) {
578
0
        warn "multiple results found for $partialname";
579
0
        return;
580    } else {
581
0
        return $found[0]->{'fwkfile'};
582    }
583
584}
585
586
587 - 596
=head1 AUTHOR

C4::Installer is a refactoring of logic originally from installer/installer.pl, which was
originally written by Henri-Damien Laurant.

Koha Development Team <http://koha-community.org/>

Galen Charlton <galen.charlton@liblime.com>

=cut
597
5981;