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