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     foreach my $file (@fnames) {
 358         #      warn $file;
 359         undef $/;
 360         my $error = $self->load_sql($file);
 361         my @file = split qr(\/|\\), $file;
 362         $lang = $file[ scalar(@file) - 3 ] unless ($lang);
 363         my $level = $file[ scalar(@file) - 2 ];
 364         unless ($error) {
 365             $systempreference .= "$file[scalar(@file)-1]|"
 366               unless ( index( $systempreference, $file[ scalar(@file) - 1 ] ) >= 0 );
 367         }
 368
 369         #Bulding here a hierarchy to display files by level.
 370         push @{ $hashlevel{$level} },
 371           { "fwkname" => $file[ scalar(@file) - 1 ], "error" => $error };
 372     }
 373
 374     #systempreference contains an ending |
 375     chop $systempreference;
 376     my @list;
 377     map { push @list, { "level" => $_, "fwklist" => $hashlevel{$_} } } keys %hashlevel;
 378     my $fwk_language;
 379     for my $each_language (@$all_languages) {
 380
 381         #       warn "CODE".$each_language->{'language_code'};
 382         #       warn "LANG:".$lang;
 383         if ( $lang eq $each_language->{'language_code'} ) {
 384             $fwk_language = $each_language->{language_locale_name};
 385         }
 386     }
 387     my $updateflag =
 388       $self->{'dbh'}->do(
 389         "UPDATE systempreferences set value=\"$systempreference\" where variable='FrameworksLoaded'"
 390       );
 391
 392     unless ( $updateflag == 1 ) {
 393         my $string =
 394             "INSERT INTO systempreferences (value, variable, explanation, type) VALUES (\"$systempreference\",'FrameworksLoaded','Frameworks loaded through webinstaller','choice')";
 395         my $rq = $self->{'dbh'}->prepare($string);
 396         $rq->execute;
 397     }
 398     return ($fwk_language, \@list);
 399 }
 400
 401 =head2 set_marcflavour_syspref
 402
 403   $installer->set_marcflavour_syspref($marcflavour);
 404
 405 Set the 'marcflavour' system preference.  The incoming
 406 C<$marcflavour> references to a subdirectory of
 407 installer/data/$dbms/$lang/marcflavour, and is
 408 normalized to MARC21 or UNIMARC.
 409
 410 FIXME: this method assumes that the MARC flavour will be either
 411 MARC21 or UNIMARC.
 412
 413 =cut
 414
 415 sub set_marcflavour_syspref {
 416     my $self = shift;
 417     my $marcflavour = shift;
 418
 419     # we can have some variants of marc flavour, by having different directories, like : unimarc_small and unimarc_full, for small and complete unimarc frameworks.
 420     # marc_cleaned finds the marcflavour, without the variant.
 421     my $marc_cleaned = 'MARC21';
 422     $marc_cleaned = 'UNIMARC' if $marcflavour =~ /unimarc/i;
 423     my $request =
 424         $self->{'dbh'}->prepare(
 425           "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');"
 426         );
 427     $request->execute;
 428 }
 429
 430 =head2 set_indexing_engine
 431
 432   $installer->set_indexing_engine($nozebra);
 433
 434 Sets system preferences related to the indexing
 435 engine.  The C<$nozebra> argument is a boolean;
 436 if true, turn on NoZebra mode and turn off QueryFuzzy,
 437 QueryWeightFields, and QueryStemming.  If false, turn
 438 off NoZebra mode (i.e., use the Zebra search engine).
 439
 440 =cut
 441
 442 sub set_indexing_engine {
 443     my $self = shift;
 444     my $nozebra = shift;
 445
 446     if ($nozebra) {
 447         $self->{'dbh'}->do("UPDATE systempreferences SET value=1 WHERE variable='NoZebra'");
 448         $self->{'dbh'}->do("UPDATE systempreferences SET value=0 WHERE variable in ('QueryFuzzy','QueryWeightFields','QueryStemming')");
 449     } else {
 450         $self->{'dbh'}->do("UPDATE systempreferences SET value=0 WHERE variable='NoZebra'");
 451     }
 452
 453 }
 454
 455 =head2 set_version_syspref
 456
 457   $installer->set_version_syspref();
 458
 459 Set or update the 'Version' system preference to the current
 460 Koha software version.
 461
 462 =cut
 463
 464 sub set_version_syspref {
 465     my $self = shift;
 466
 467     my $kohaversion=C4::Context::KOHAVERSION;
 468     # remove the 3 last . to have a Perl number
 469     $kohaversion =~ s/(.*\..*)\.(.*)\.(.*)/$1$2$3/;
 470     if (C4::Context->preference('Version')) {
 471         warn "UPDATE Version";
 472         my $finish=$self->{'dbh'}->prepare("UPDATE systempreferences SET value=? WHERE variable='Version'");
 473         $finish->execute($kohaversion);
 474     } else {
 475         warn "INSERT Version";
 476         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')");
 477         $finish->execute($kohaversion);
 478     }
 479     C4::Context->clear_syspref_cache();
 480 }
 481
 482 =head2 load_sql
 483
 484   my $error = $installer->load_sql($filename);
 485
 486 Runs a the specified SQL using the DB's command-line
 487 SQL tool, and returns any strings sent to STDERR
 488 by the command-line tool.
 489
 490 B<FIXME:> there has been a long-standing desire to
 491 replace this with an SQL loader that goes
 492 through DBI; partly for portability issues
 493 and partly to improve error handling.
 494
 495 B<FIXME:> even using the command-line loader, some more
 496 basic error handling should be added - deal
 497 with missing files, e.g.
 498
 499 =cut
 500
 501 sub load_sql {
 502     my $self = shift;
 503     my $filename = shift;
 504
 505     my $datadir = C4::Context->config('intranetdir') . "/installer/data/$self->{dbms}";
 506     my $error;
 507     my $strcmd;
 508     if ( $self->{dbms} eq 'mysql' ) {
 509         $strcmd = "mysql "
 510             . ( $self->{hostname} ? " -h $self->{hostname} " : "" )
 511             . ( $self->{port}     ? " -P $self->{port} "     : "" )
 512             . ( $self->{user}     ? " -u $self->{user} "     : "" )
 513             . ( $self->{password} ? " -p'$self->{password}'"   : "" )
 514             . " $self->{dbname} ";
 515         $error = qx($strcmd --default-character-set=utf8 <$filename 2>&1 1>/dev/null);
 516     } elsif ( $self->{dbms} eq 'Pg' ) {
 517         $strcmd = "psql "
 518             . ( $self->{hostname} ? " -h $self->{hostname} " : "" )
 519             . ( $self->{port}     ? " -p $self->{port} "     : "" )
 520             . ( $self->{user}     ? " -U $self->{user} "     : "" )
 521 #            . ( $self->{password} ? " -W $self->{password}"   : "" )       # psql will NOT accept a password, but prompts...
 522             . " $self->{dbname} ";                        # Therefore, be sure to run 'trust' on localhost in pg_hba.conf -fbcit
 523         $error = qx($strcmd -f $filename 2>&1 1>/dev/null);
 524         # Be sure to set 'client_min_messages = error' in postgresql.conf
 525         # so that only true errors are returned to stderr or else the installer will
 526         # report the import a failure although it really succeded -fbcit
 527     }
 528 #   errors thrown while loading installer data should be logged
 529     warn "C4::Installer::load_sql returned the following errors while attempting to load $filename:\n";
 530     warn $error;
 531     return $error;
 532 }
 533
 534 =head2 get_file_path_from_name
 535
 536   my $filename = $installer->get_file_path_from_name('script_name');
 537
 538 searches through the set of known SQL scripts and finds the fully
 539 qualified path name for the script that mathches the input.
 540
 541 returns undef if no match was found.
 542
 543
 544 =cut
 545
 546 sub get_file_path_from_name {
 547     my $self = shift;
 548     my $partialname = shift;
 549
 550     my $lang = 'en'; # FIXME: how do I know what language I want?
 551
 552     my ($defaulted_to_en, $list) = $self->sample_data_sql_list($lang);
 553     # warn( Data::Dumper->Dump( [ $list ], [ 'list' ] ) );
 554
 555     my @found;
 556     foreach my $frameworklist ( @$list ) {
 557         push @found, grep { $_->{'fwkfile'} =~ /$partialname$/ } @{$frameworklist->{'frameworks'}};
 558     }
 559
 560     # warn( Data::Dumper->Dump( [ \@found ], [ 'found' ] ) );
 561     if ( 0 == scalar @found ) {
 562         return;
 563     } elsif ( 1 < scalar @found ) {
 564         warn "multiple results found for $partialname";
 565         return;
 566     } else {
 567         return $found[0]->{'fwkfile'};
 568     }
 569
 570 }
 571
 572
 573 =head1 AUTHOR
 574
 575 C4::Installer is a refactoring of logic originally from installer/installer.pl, which was
 576 originally written by Henri-Damien Laurant.
 577
 578 Koha Development Team <http://koha-community.org/>
 579
 580 Galen Charlton <galen.charlton@liblime.com>
 581
 582 =cut
 583
 584 1;