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