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