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  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);
  42
  43 =head1 DESCRIPTION
  44
  45 =cut
  46
  47 =head1 METHODS
  48
  49 =head2 new
  50
  51   my $installer = C4::Installer->new();
  52
  53 Creates a new installer.
  54
  55 =cut
  56
  57 sub new {
  58     my $class = shift;
  59
  60     my $self = {};
  61
  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;
  76
  77     bless $self, $class;
  78     return $self;
  79 }
  80
  81 =head2 marcflavour_list
  82
  83   my ($marcflavours) = $installer->marcflavour_list($lang);
  84
  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.
  88
  89 =cut
  90
  91 sub marcflavour_list {
  92     my $self = shift;
  93     my $lang = shift;
  94
  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;
 100 }
 101
 102 =head2 marc_framework_sql_list
 103
 104   my ($defaulted_to_en, $list) =
 105      $installer->marc_framework_sql_list($lang, $marcflavour);
 106
 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>.
 110
 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.
 113
 114 =cut
 115
 116 sub marc_framework_sql_list {
 117     my $self = shift;
 118     my $lang = shift;
 119     my $marcflavour = shift;
 120
 121     my $defaulted_to_en = 0;
 122
 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;
 134         }
 135     }
 136     my @listdir = sort grep { !/^\.|marcflavour/ && -d "$dir/$_" } readdir(MYDIR);
 137     closedir MYDIR;
 138
 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;
 147     }
 148
 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 FILE, "<:utf8","$dir/$requirelevel/$name.txt";
 158             my $lines = <FILE>;
 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,
 164               {
 165                 'fwkname'        => $name,
 166                 'fwkfile'        => "$dir/$requirelevel/$_",
 167                 'fwkdescription' => $lines,
 168                 'checked'        => ( ( $frameworksloaded{$_} || $mandatory ) ? 1 : 0 ),
 169                 'mandatory'      => $mandatory,
 170               };
 171         } @listname;
 172         my @fwks =
 173           sort { $a->{'fwkname'} cmp $b->{'fwkname'} } @frameworklist;
 174
 175         $cell{"frameworks"} = \@fwks;
 176         $cell{"label"}      = ucfirst($requirelevel);
 177         $cell{"code"}       = lc($requirelevel);
 178         push @fwklist, \%cell;
 179     }
 180
 181     return ($defaulted_to_en, \@fwklist);
 182 }
 183
 184 =head2 sample_data_sql_list
 185
 186   my ($defaulted_to_en, $list) = $installer->sample_data_sql_list($lang);
 187
 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.
 192
 193 =cut
 194
 195 sub sample_data_sql_list {
 196     my $self = shift;
 197     my $lang = shift;
 198
 199     my $defaulted_to_en = 0;
 200
 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;
 212         }
 213     }
 214     my @listdir = sort grep { !/^\.|marcflavour/ && -d "$dir/$_" } readdir(MYDIR);
 215     closedir MYDIR;
 216
 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;
 225     }
 226
 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 FILE, "<:utf8","$dir/$requirelevel/$name.txt";
 236             my $lines = <FILE>;
 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,
 242               {
 243                 'fwkname'        => $name,
 244                 'fwkfile'        => "$dir/$requirelevel/$_",
 245                 'fwkdescription' => $lines,
 246                 'checked'        => ( ( $frameworksloaded{$_} || $mandatory ) ? 1 : 0 ),
 247                 'mandatory'      => $mandatory,
 248               };
 249         } @listname;
 250         my @fwks = sort { $a->{'fwkname'} cmp $b->{'fwkname'} } @frameworklist;
 251
 252         $cell{"frameworks"} = \@fwks;
 253         $cell{"label"}      = ucfirst($requirelevel);
 254         $cell{"code"}       = lc($requirelevel);
 255         push @levellist, \%cell;
 256     }
 257
 258     return ($defaulted_to_en, \@levellist);
 259 }
 260
 261 =head2 sql_file_list
 262
 263   my $list = $installer->sql_file_list($lang, $marcflavour, $subset_wanted);
 264
 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'.
 269
 270 =cut
 271
 272 sub sql_file_list {
 273     my $self = shift;
 274     my $lang = shift;
 275     my $marcflavour = shift;
 276     my $subset_wanted = shift;
 277
 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);
 280
 281     my @sql_list = ();
 282     map {
 283         map {
 284             if ($subset_wanted->{'mandatory'}) {
 285                 push @sql_list, $_->{'fwkfile'} if $_->{'mandatory'};
 286             }
 287             if ($subset_wanted->{'optional'}) {
 288                 push @sql_list, $_->{'fwkfile'} unless $_->{'mandatory'};
 289             }
 290         } @{ $_->{'frameworks'} }
 291     } (@$marc_sql, @$sample_sql);
 292
 293     return \@sql_list
 294 }
 295
 296 =head2 load_db_schema
 297
 298   my $error = $installer->load_db_schema();
 299
 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.
 303
 304 =cut
 305
 306 sub load_db_schema {
 307     my $self = shift;
 308
 309     my $datadir = C4::Context->config('intranetdir') . "/installer/data/$self->{dbms}";
 310     my $error = $self->load_sql("$datadir/kohastructure.sql");
 311     return $error;
 312
 313 }
 314
 315 =head2 load_sql_in_order
 316
 317   my ($fwk_language, $list) = $installer->load_sql_in_order($all_languages, @sql_list);
 318
 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.
 322
 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.
 327
 328 B<FIXME:> this is a rather delicate way of dealing with dependencies between
 329 the install scripts.
 330
 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.
 335
 336 B<FIXME:> The C<$fwk_language> code probably doesn't belong and needs to be
 337 moved to a different method.
 338
 339 =cut
 340
 341 sub load_sql_in_order {
 342     my $self = shift;
 343     my $all_languages = shift;
 344     my @sql_list = @_;
 345
 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 );
 370         }
 371
 372         #Bulding here a hierarchy to display files by level.
 373         push @{ $hashlevel{$level} },
 374           { "fwkname" => $file[ scalar(@file) - 1 ], "error" => $error };
 375     }
 376
 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) {
 383
 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};
 388         }
 389     }
 390     my $updateflag =
 391       $self->{'dbh'}->do(
 392         "UPDATE systempreferences set value=\"$systempreference\" where variable='FrameworksLoaded'"
 393       );
 394
 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;
 400     }
 401     return ($fwk_language, \@list);
 402 }
 403
 404 =head2 set_marcflavour_syspref
 405
 406   $installer->set_marcflavour_syspref($marcflavour);
 407
 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.
 412
 413 FIXME: this method assumes that the MARC flavour will be either
 414 MARC21 or UNIMARC.
 415
 416 =cut
 417
 418 sub set_marcflavour_syspref {
 419     my $self = shift;
 420     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     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');"
 429         );
 430     $request->execute;
 431 }
 432
 433 =head2 set_indexing_engine
 434
 435   $installer->set_indexing_engine($nozebra);
 436
 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).
 442
 443 =cut
 444
 445 sub set_indexing_engine {
 446     my $self = shift;
 447     my $nozebra = shift;
 448
 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'");
 454     }
 455
 456 }
 457
 458 =head2 set_version_syspref
 459
 460   $installer->set_version_syspref();
 461
 462 Set or update the 'Version' system preference to the current
 463 Koha software version.
 464
 465 =cut
 466
 467 sub set_version_syspref {
 468     my $self = shift;
 469
 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);
 481     }
 482     C4::Context->clear_syspref_cache();
 483 }
 484
 485 =head2 load_sql
 486
 487   my $error = $installer->load_sql($filename);
 488
 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.
 492
 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.
 497
 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.
 501
 502 =cut
 503
 504 sub load_sql {
 505     my $self = shift;
 506     my $filename = shift;
 507
 508     my $datadir = C4::Context->config('intranetdir') . "/installer/data/$self->{dbms}";
 509     my $error;
 510     my $strcmd;
 511     if ( $self->{dbms} eq 'mysql' ) {
 512         $strcmd = "mysql "
 513             . ( $self->{hostname} ? " -h $self->{hostname} " : "" )
 514             . ( $self->{port}     ? " -P $self->{port} "     : "" )
 515             . ( $self->{user}     ? " -u $self->{user} "     : "" )
 516             . ( $self->{password} ? " -p'$self->{password}'"   : "" )
 517             . " $self->{dbname} ";
 518         $error = qx($strcmd --default-character-set=utf8 <$filename 2>&1 1>/dev/null);
 519     } elsif ( $self->{dbms} eq 'Pg' ) {
 520         $strcmd = "psql "
 521             . ( $self->{hostname} ? " -h $self->{hostname} " : "" )
 522             . ( $self->{port}     ? " -p $self->{port} "     : "" )
 523             . ( $self->{user}     ? " -U $self->{user} "     : "" )
 524 #            . ( $self->{password} ? " -W $self->{password}"   : "" )       # psql will NOT accept a password, but prompts...
 525             . " $self->{dbname} ";                        # Therefore, be sure to run 'trust' on localhost in pg_hba.conf -fbcit
 526         $error = qx($strcmd -f $filename 2>&1 1>/dev/null);
 527         # Be sure to set 'client_min_messages = error' in postgresql.conf
 528         # so that only true errors are returned to stderr or else the installer will
 529         # report the import a failure although it really succeded -fbcit
 530     }
 531 #   errors thrown while loading installer data should be logged
 532     if($error) {
 533       warn "C4::Installer::load_sql returned the following errors while attempting to load $filename:\n";
 534       warn "$error";
 535     }
 536     return $error;
 537 }
 538
 539 =head2 get_file_path_from_name
 540
 541   my $filename = $installer->get_file_path_from_name('script_name');
 542
 543 searches through the set of known SQL scripts and finds the fully
 544 qualified path name for the script that mathches the input.
 545
 546 returns undef if no match was found.
 547
 548
 549 =cut
 550
 551 sub get_file_path_from_name {
 552     my $self = shift;
 553     my $partialname = shift;
 554
 555     my $lang = 'en'; # FIXME: how do I know what language I want?
 556
 557     my ($defaulted_to_en, $list) = $self->sample_data_sql_list($lang);
 558     # warn( Data::Dumper->Dump( [ $list ], [ 'list' ] ) );
 559
 560     my @found;
 561     foreach my $frameworklist ( @$list ) {
 562         push @found, grep { $_->{'fwkfile'} =~ /$partialname$/ } @{$frameworklist->{'frameworks'}};
 563     }
 564
 565     # warn( Data::Dumper->Dump( [ \@found ], [ 'found' ] ) );
 566     if ( 0 == scalar @found ) {
 567         return;
 568     } elsif ( 1 < scalar @found ) {
 569         warn "multiple results found for $partialname";
 570         return;
 571     } else {
 572         return $found[0]->{'fwkfile'};
 573     }
 574
 575 }
 576
 577
 578 =head1 AUTHOR
 579
 580 C4::Installer is a refactoring of logic originally from installer/installer.pl, which was
 581 originally written by Henri-Damien Laurant.
 582
 583 Koha Development Team <http://koha-community.org/>
 584
 585 Galen Charlton <galen.charlton@liblime.com>
 586
 587 =cut
 588
 589 1;