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