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