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