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