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