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 Modern::Perl;
  21
  22 use Encode qw( encode is_utf8 );
  23 use DBIx::RunSQL;
  24 use YAML::XS;
  25 use C4::Context;
  26 use DBI;
  27 use Koha;
  28
  29 use vars qw(@ISA @EXPORT);
  30 BEGIN {
  31     require Exporter;
  32     @ISA = qw( Exporter );
  33     push @EXPORT, qw( primary_key_exists foreign_key_exists index_exists column_exists TableExists);
  34 };
  35
  36 =head1 NAME
  37
  38 C4::Installer
  39
  40 =head1 SYNOPSIS
  41
  42  use C4::Installer;
  43  my $installer = C4::Installer->new();
  44  my $all_languages = getAllLanguages();
  45  my $error = $installer->load_db_schema();
  46  my $list;
  47  #fill $list with list of sql files
  48  my ($fwk_language, $error_list) = $installer->load_sql_in_order($all_languages, @$list);
  49  $installer->set_version_syspref();
  50  $installer->set_marcflavour_syspref('MARC21');
  51
  52 =head1 DESCRIPTION
  53
  54 =cut
  55
  56 =head1 METHODS
  57
  58 =head2 new
  59
  60   my $installer = C4::Installer->new();
  61
  62 Creates a new installer.
  63
  64 =cut
  65
  66 sub new {
  67     my $class = shift;
  68
  69     my $self = {};
  70
  71     # get basic information from context
  72     $self->{'dbname'}   = C4::Context->config("database");
  73     $self->{'dbms'}     = C4::Context->config("db_scheme") ? C4::Context->config("db_scheme") : "mysql";
  74     $self->{'hostname'} = C4::Context->config("hostname");
  75     $self->{'port'}     = C4::Context->config("port");
  76     $self->{'user'}     = C4::Context->config("user");
  77     $self->{'password'} = C4::Context->config("pass");
  78     $self->{'tls'} = C4::Context->config("tls");
  79     if( $self->{'tls'} && $self->{'tls'} eq 'yes' ) {
  80         $self->{'ca'} = C4::Context->config('ca');
  81         $self->{'cert'} = C4::Context->config('cert');
  82         $self->{'key'} = C4::Context->config('key');
  83         $self->{'tlsoptions'} = ";mysql_ssl=1;mysql_ssl_client_key=".$self->{key}.";mysql_ssl_client_cert=".$self->{cert}.";mysql_ssl_ca_file=".$self->{ca};
  84         $self->{'tlscmdline'} =  " --ssl-cert ". $self->{cert} . " --ssl-key " . $self->{key} . " --ssl-ca ".$self->{ca}." "
  85     }
  86     $self->{'dbh'} = DBI->connect("DBI:$self->{dbms}:dbname=$self->{dbname};host=$self->{hostname}" .
  87                                   ( $self->{port} ? ";port=$self->{port}" : "" ).
  88                                   ( $self->{tlsoptions} ? $self->{tlsoptions} : ""),
  89                                   $self->{'user'}, $self->{'password'});
  90     $self->{'language'} = undef;
  91     $self->{'marcflavour'} = undef;
  92         $self->{'dbh'}->do('set NAMES "utf8"');
  93     $self->{'dbh'}->{'mysql_enable_utf8'}=1;
  94
  95     bless $self, $class;
  96     return $self;
  97 }
  98
  99 =head2 marc_framework_sql_list
 100
 101   my ($defaulted_to_en, $list) =
 102      $installer->marc_framework_sql_list($lang, $marcflavour);
 103
 104 Returns in C<$list> a structure listing the filename, description, section,
 105 and mandatory/optional status of MARC framework scripts available for C<$lang>
 106 and C<$marcflavour>.
 107
 108 If the C<$defaulted_to_en> return value is true, no scripts are available
 109 for language C<$lang> and the 'en' ones are returned.
 110
 111 =cut
 112
 113 sub marc_framework_sql_list {
 114     my $self = shift;
 115     my $lang = shift;
 116     my $marcflavour = shift;
 117
 118     my $defaulted_to_en = 0;
 119
 120     undef $/;
 121     my $dir = C4::Context->config('intranetdir') . "/installer/data/$self->{dbms}/$lang/marcflavour/".lc($marcflavour);
 122     unless (opendir( MYDIR, $dir )) {
 123         if ($lang eq 'en') {
 124             warn "cannot open MARC frameworks directory $dir";
 125         } else {
 126             # if no translated MARC framework is available,
 127             # default to English
 128             $dir = C4::Context->config('intranetdir') . "/installer/data/$self->{dbms}/en/marcflavour/".lc($marcflavour);
 129             opendir(MYDIR, $dir) or warn "cannot open English MARC frameworks directory $dir";
 130             $defaulted_to_en = 1;
 131         }
 132     }
 133     my @listdir = sort grep { !/^\.|marcflavour/ && -d "$dir/$_" } readdir(MYDIR);
 134     closedir MYDIR;
 135
 136     my @fwklist;
 137     my $request = $self->{'dbh'}->prepare("SELECT value FROM systempreferences WHERE variable='FrameworksLoaded'");
 138     $request->execute;
 139     my ($frameworksloaded) = $request->fetchrow;
 140     $frameworksloaded = '' unless defined $frameworksloaded; # avoid warning
 141     my %frameworksloaded;
 142     foreach ( split( /\|/, $frameworksloaded ) ) {
 143         $frameworksloaded{$_} = 1;
 144     }
 145
 146     foreach my $requirelevel (@listdir) {
 147         opendir( MYDIR, "$dir/$requirelevel" );
 148         my @listname = grep { !/^\./ && -f "$dir/$requirelevel/$_" && $_ =~ m/\.(sql|yml)$/ } readdir(MYDIR);
 149         closedir MYDIR;
 150         my %cell;
 151         my @frameworklist;
 152         map {
 153             my ( $name, $ext ) = split /\./, $_;
 154             my @lines;
 155             if ( $ext =~ /yml/ ) {
 156                 my $yaml = YAML::XS::LoadFile("$dir/$requirelevel/$name\.$ext");
 157                 @lines = map { Encode::decode('UTF-8', $_) } @{ $yaml->{'description'} };
 158             } else {
 159                 open my $fh, "<:encoding(UTF-8)", "$dir/$requirelevel/$name.txt";
 160                 my $line = <$fh>;
 161                 $line = Encode::encode('UTF-8', $line) unless ( Encode::is_utf8($line) );
 162                 @lines = split /\n/, $line;
 163             }
 164             my $mandatory = ($requirelevel =~ /(mandatory|requi|oblig|necess)/i);
 165             push @frameworklist,
 166               {
 167                 'fwkname'        => $name,
 168                 'fwkfile'        => "$dir/$requirelevel/$_",
 169                 'fwkdescription' => \@lines,
 170                 'checked'        => ( ( $frameworksloaded{$_} || $mandatory ) ? 1 : 0 ),
 171                 'mandatory'      => $mandatory,
 172               };
 173         } @listname;
 174         my @fwks =
 175           sort { $a->{'fwkname'} cmp $b->{'fwkname'} } @frameworklist;
 176
 177         $cell{"frameworks"} = \@fwks;
 178         $cell{"label"}      = ($requirelevel =~ /(mandatory|requi|oblig|necess)/i)?'mandatory':'optional';
 179         $cell{"code"}       = lc($requirelevel);
 180         push @fwklist, \%cell;
 181     }
 182
 183     return ($defaulted_to_en, \@fwklist);
 184 }
 185
 186 =head2 sample_data_sql_list
 187
 188   my ($defaulted_to_en, $list) = $installer->sample_data_sql_list($lang);
 189
 190 Returns in C<$list> a structure listing the filename, description, section,
 191 and mandatory/optional status of sample data scripts available for C<$lang>.
 192 If the C<$defaulted_to_en> return value is true, no scripts are available
 193 for language C<$lang> and the 'en' ones are returned.
 194
 195 =cut
 196
 197 sub sample_data_sql_list {
 198     my $self = shift;
 199     my $lang = shift;
 200
 201     my $defaulted_to_en = 0;
 202
 203     undef $/;
 204     my $dir = C4::Context->config('intranetdir') . "/installer/data/$self->{dbms}/$lang";
 205     unless (opendir( MYDIR, $dir )) {
 206         if ($lang eq 'en') {
 207             warn "cannot open sample data directory $dir";
 208         } else {
 209             # if no sample data is available,
 210             # default to English
 211             $dir = C4::Context->config('intranetdir') . "/installer/data/$self->{dbms}/en";
 212             opendir(MYDIR, $dir) or warn "cannot open English sample data directory $dir";
 213             $defaulted_to_en = 1;
 214         }
 215     }
 216     my @listdir = sort grep { !/^\.|marcflavour/ && -d "$dir/$_" } readdir(MYDIR);
 217     closedir MYDIR;
 218
 219     my @levellist;
 220     my $request = $self->{'dbh'}->prepare("SELECT value FROM systempreferences WHERE variable='FrameworksLoaded'");
 221     $request->execute;
 222     my ($frameworksloaded) = $request->fetchrow;
 223     $frameworksloaded = '' unless defined $frameworksloaded; # avoid warning
 224     my %frameworksloaded;
 225     foreach ( split( /\|/, $frameworksloaded ) ) {
 226         $frameworksloaded{$_} = 1;
 227     }
 228
 229     foreach my $requirelevel (@listdir) {
 230         opendir( MYDIR, "$dir/$requirelevel" );
 231         my @listname = grep { !/^\./ && -f "$dir/$requirelevel/$_" && $_ =~ m/\.(sql|yml)$/ } readdir(MYDIR);
 232         closedir MYDIR;
 233         my %cell;
 234         my @frameworklist;
 235         map {
 236             my ( $name, $ext ) = split /\./, $_;
 237             my @lines;
 238             if ( $ext =~ /yml/ ) {
 239                 my $yaml = YAML::XS::LoadFile("$dir/$requirelevel/$name\.$ext");
 240                 @lines = map { Encode::decode('UTF-8', $_) } @{ $yaml->{'description'} };
 241             } else {
 242                 open my $fh, "<:encoding(UTF-8)", "$dir/$requirelevel/$name.txt";
 243                 my $line = <$fh>;
 244                 $line = Encode::encode('UTF-8', $line) unless ( Encode::is_utf8($line) );
 245                 @lines = split /\n/, $line;
 246             }
 247             my $mandatory = ($requirelevel =~ /(mandatory|requi|oblig|necess)/i);
 248             push @frameworklist,
 249               {
 250                 'fwkname'        => $name,
 251                 'fwkfile'        => "$dir/$requirelevel/$_",
 252                 'fwkdescription' => \@lines,
 253                 'checked'        => ( ( $frameworksloaded{$_} || $mandatory ) ? 1 : 0 ),
 254                 'mandatory'      => $mandatory,
 255               };
 256         } @listname;
 257         my @fwks = sort { $a->{'fwkname'} cmp $b->{'fwkname'} } @frameworklist;
 258
 259         $cell{"frameworks"} = \@fwks;
 260         $cell{"label"}      = ($requirelevel =~ /(mandatory|requi|oblig|necess)/i)?'mandatory':'optional';
 261         $cell{"code"}       = lc($requirelevel);
 262         push @levellist, \%cell;
 263     }
 264
 265     return ($defaulted_to_en, \@levellist);
 266 }
 267
 268 =head2 load_db_schema
 269
 270   my $error = $installer->load_db_schema();
 271
 272 Loads the SQL script that creates Koha's tables and indexes.  The
 273 return value is a string containing error messages reported by the
 274 load.
 275
 276 =cut
 277
 278 sub load_db_schema {
 279     my $self = shift;
 280
 281     my $datadir = C4::Context->config('intranetdir') . "/installer/data/$self->{dbms}";
 282
 283     # Disable checks before load
 284     $self->{'dbh'}->do(q{SET NAMES utf8mb4});
 285     $self->{'dbh'}->do(q{SET @OLD_UNIQUE_CHECKS=@@UNIQUE_CHECKS, UNIQUE_CHECKS=0});
 286     $self->{'dbh'}->do(q{SET @OLD_FOREIGN_KEY_CHECKS=@@FOREIGN_KEY_CHECKS, FOREIGN_KEY_CHECKS=0});
 287     $self->{'dbh'}->do(q{SET @OLD_SQL_MODE=@@SQL_MODE, SQL_MODE='NO_AUTO_VALUE_ON_ZERO'});
 288     $self->{'dbh'}->do(q{SET @OLD_SQL_NOTES=@@SQL_NOTES, SQL_NOTES=0});
 289
 290     # Load kohastructure
 291     my $error = $self->load_sql("$datadir/kohastructure.sql");
 292
 293     # Re-enable checks after load
 294     $self->{'dbh'}->do(q{SET SQL_MODE=@OLD_SQL_MODE});
 295     $self->{'dbh'}->do(q{SET FOREIGN_KEY_CHECKS=@OLD_FOREIGN_KEY_CHECKS});
 296     $self->{'dbh'}->do(q{SET UNIQUE_CHECKS=@OLD_UNIQUE_CHECKS});
 297     $self->{'dbh'}->do(q{SET SQL_NOTES=@OLD_SQL_NOTES});
 298
 299     return $error;
 300
 301 }
 302
 303 =head2 load_sql_in_order
 304
 305   my ($fwk_language, $list) = $installer->load_sql_in_order($all_languages, @sql_list);
 306
 307 Given a list of SQL scripts supplied in C<@sql_list>, loads each of them
 308 into the database and sets the FrameworksLoaded system preference to names
 309 of the scripts that were loaded.
 310
 311 The SQL files are loaded in alphabetical order by filename (not including
 312 directory path).  This means that dependencies among the scripts are to
 313 be resolved by carefully naming them, keeping in mind that the directory name
 314 does *not* currently count.
 315
 316 B<FIXME:> this is a rather delicate way of dealing with dependencies between
 317 the install scripts.
 318
 319 The return value C<$list> is an arrayref containing a hashref for each
 320 "level" or directory containing SQL scripts; the hashref in turns contains
 321 a list of hashrefs containing a list of each script load and any error
 322 messages associated with the loading of each script.
 323
 324 B<FIXME:> The C<$fwk_language> code probably doesn't belong and needs to be
 325 moved to a different method.
 326
 327 =cut
 328
 329 sub load_sql_in_order {
 330     my $self = shift;
 331     my $langchoice = shift;
 332     my $all_languages = shift;
 333     my @sql_list = @_;
 334
 335     my $lang;
 336     my %hashlevel;
 337     my @fnames = sort {
 338         my @aa = split /\/|\\/, ($a);
 339         my @bb = split /\/|\\/, ($b);
 340         $aa[-1] cmp $bb[-1]
 341     } @sql_list;
 342     my $request = $self->{'dbh'}->prepare( "SELECT value FROM systempreferences WHERE variable='FrameworksLoaded'" );
 343     $request->execute;
 344     my ($systempreference) = $request->fetchrow;
 345     $systempreference = '' unless defined $systempreference; # avoid warning
 346
 347     my $global_mandatory_dir = C4::Context->config('intranetdir') . "/installer/data/$self->{dbms}/mandatory";
 348
 349     # Make sure some stuffs are loaded first
 350     unshift(@fnames,
 351         "$global_mandatory_dir/sysprefs.sql",
 352         "$global_mandatory_dir/subtag_registry.sql",
 353         "$global_mandatory_dir/auth_val_cat.sql",
 354         "$global_mandatory_dir/message_transport_types.sql",
 355         "$global_mandatory_dir/sample_notices_message_attributes.sql",
 356         "$global_mandatory_dir/sample_notices_message_transports.sql",
 357         "$global_mandatory_dir/keyboard_shortcuts.sql",
 358     );
 359
 360     push @fnames, "$global_mandatory_dir/userflags.sql",
 361                   "$global_mandatory_dir/userpermissions.sql",
 362                   "$global_mandatory_dir/audio_alerts.sql",
 363                   "$global_mandatory_dir/account_offset_types.sql",
 364                   "$global_mandatory_dir/account_credit_types.sql",
 365                   "$global_mandatory_dir/account_debit_types.sql",
 366                   ;
 367     my $localization_file = C4::Context->config('intranetdir') .
 368                             "/installer/data/$self->{dbms}/localization/$langchoice/custom.sql";
 369     if ( $langchoice ne 'en' and -f $localization_file ) {
 370         push @fnames, $localization_file;
 371     }
 372     foreach my $file (@fnames) {
 373         #      warn $file;
 374         undef $/;
 375         my $error = $self->load_sql($file);
 376         my @file = split qr(\/|\\), $file;
 377         $lang = $file[ scalar(@file) - 3 ] unless ($lang);
 378         my $level = ( $file =~ /(localization)/ ) ? $1 : $file[ scalar(@file) - 2 ];
 379         unless ($error) {
 380             $systempreference .= "$file[scalar(@file)-1]|"
 381               unless ( index( $systempreference, $file[ scalar(@file) - 1 ] ) >= 0 );
 382         }
 383
 384         #Bulding here a hierarchy to display files by level.
 385         push @{ $hashlevel{$level} },
 386           { "fwkname" => $file[ scalar(@file) - 1 ], "error" => $error };
 387     }
 388
 389     #systempreference contains an ending |
 390     chop $systempreference;
 391     my @list;
 392     map { push @list, { "level" => $_, "fwklist" => $hashlevel{$_} } } keys %hashlevel;
 393     my $fwk_language;
 394     for my $each_language (@$all_languages) {
 395
 396         #       warn "CODE".$each_language->{'language_code'};
 397         #       warn "LANG:".$lang;
 398         if ( $lang eq $each_language->{'language_code'} ) {
 399             $fwk_language = $each_language->{language_locale_name};
 400         }
 401     }
 402     my $updateflag =
 403       $self->{'dbh'}->do(
 404         "UPDATE systempreferences set value=\"$systempreference\" where variable='FrameworksLoaded'"
 405       );
 406
 407     unless ( $updateflag == 1 ) {
 408         my $string =
 409             "INSERT INTO systempreferences (value, variable, explanation, type) VALUES (\"$systempreference\",'FrameworksLoaded','Frameworks loaded through webinstaller','choice')";
 410         my $rq = $self->{'dbh'}->prepare($string);
 411         $rq->execute;
 412     }
 413     return ($fwk_language, \@list);
 414 }
 415
 416 =head2 set_marcflavour_syspref
 417
 418   $installer->set_marcflavour_syspref($marcflavour);
 419
 420 Set the 'marcflavour' system preference.  The incoming
 421 C<$marcflavour> references to a subdirectory of
 422 installer/data/$dbms/$lang/marcflavour, and is
 423 normalized to MARC21, UNIMARC or NORMARC.
 424
 425 FIXME: this method assumes that the MARC flavour will be either
 426 MARC21, UNIMARC or NORMARC.
 427
 428 =cut
 429
 430 sub set_marcflavour_syspref {
 431     my $self = shift;
 432     my $marcflavour = shift;
 433
 434     # we can have some variants of marc flavour, by having different directories, like : unimarc_small and unimarc_full, for small and complete unimarc frameworks.
 435     # marc_cleaned finds the marcflavour, without the variant.
 436     my $marc_cleaned = 'MARC21';
 437     $marc_cleaned = 'UNIMARC' if $marcflavour =~ /unimarc/i;
 438     $marc_cleaned = 'NORMARC' if $marcflavour =~ /normarc/i;
 439     my $request =
 440         $self->{'dbh'}->prepare(
 441           "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');"
 442         );
 443     $request->execute;
 444 }
 445
 446 =head2 set_version_syspref
 447
 448   $installer->set_version_syspref();
 449
 450 Set or update the 'Version' system preference to the current
 451 Koha software version.
 452
 453 =cut
 454
 455 sub set_version_syspref {
 456     my $self = shift;
 457
 458     my $kohaversion = Koha::version();
 459     # remove the 3 last . to have a Perl number
 460     $kohaversion =~ s/(.*\..*)\.(.*)\.(.*)/$1$2$3/;
 461     if (C4::Context->preference('Version')) {
 462         warn "UPDATE Version";
 463         my $finish=$self->{'dbh'}->prepare("UPDATE systempreferences SET value=? WHERE variable='Version'");
 464         $finish->execute($kohaversion);
 465     } else {
 466         warn "INSERT Version";
 467         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')");
 468         $finish->execute($kohaversion);
 469     }
 470     C4::Context->clear_syspref_cache();
 471 }
 472
 473 =head2 set_languages_syspref
 474
 475   $installer->set_languages_syspref();
 476
 477 Add the installation language to 'language' and 'OPACLanguages' system preferences
 478 if different from 'en'
 479
 480 =cut
 481
 482 sub set_languages_syspref {
 483     my $self     = shift;
 484     my $language = shift;
 485
 486     return if ( not $language or $language eq 'en' );
 487
 488     warn "UPDATE Languages";
 489     # intranet
 490     my $pref = $self->{'dbh'}->prepare("UPDATE systempreferences SET value=? WHERE variable='language'");
 491     $pref->execute("en,$language");
 492     # opac
 493     $pref = $self->{'dbh'}->prepare("UPDATE systempreferences SET value=? WHERE variable='OPACLanguages'");
 494     $pref->execute("en,$language");
 495
 496     C4::Context->clear_syspref_cache();
 497 }
 498
 499 =head2 process_yml_table
 500
 501   my $query_info   = $installer->process_yml_table($table);
 502
 503 Analyzes a table loaded in YAML format.
 504 Returns the values required to build an insert statement.
 505
 506 =cut
 507
 508 sub process_yml_table {
 509     my ($table) = @_;
 510     my $table_name   = ( keys %$table )[0];                          # table name
 511     my @rows         = @{ $table->{$table_name}->{rows} };           #
 512     my @columns      = ( sort keys %{$rows[0]} );                    # column names
 513     my $fields       = join ",", map{sprintf("`%s`", $_)} @columns;  # idem, joined
 514     my $query        = "INSERT INTO $table_name ( $fields ) VALUES ";
 515     my @multiline    = @{ $table->{$table_name}->{'multiline'} };    # to check multiline values;
 516     my $placeholders = '(' . join ( ",", map { "?" } @columns ) . ')'; # '(?,..,?)' string
 517     my @values;
 518     foreach my $row ( @rows ) {
 519         push @values, [ map {
 520                         my $col = $_;
 521                         ( @multiline and grep { $_ eq $col } @multiline )
 522                         ? join "\r\n", @{$row->{$col}}                # join multiline values
 523                         : $row->{$col};
 524                      } @columns ];
 525     }
 526     return { query => $query, placeholders => $placeholders, values => \@values };
 527 }
 528
 529 =head2 load_sql
 530
 531   my $error = $installer->load_sql($filename);
 532
 533 Runs the specified input file using a sql loader DBIx::RunSQL, or a yaml loader
 534 Returns any strings sent to STDERR
 535
 536 # FIXME This should be improved: sometimes the caller and load_sql warn the same
 537 error.
 538
 539 =cut
 540
 541 sub load_sql {
 542     my $self = shift;
 543     my $filename = shift;
 544     my $error;
 545
 546     my $dbh = $self->{ dbh };
 547
 548     my $dup_stderr;
 549     do {
 550         local *STDERR;
 551         open STDERR, ">>", \$dup_stderr;
 552
 553         if ( $filename =~ /sql$/ ) {                                                        # SQL files
 554             eval {
 555                 DBIx::RunSQL->run_sql_file(
 556                     dbh     => $dbh,
 557                     sql     => $filename,
 558                 );
 559             };
 560         }
 561         else {                                                                       # YAML files
 562             eval {
 563                 my $yaml         = YAML::XS::LoadFile( $filename );                            # Load YAML
 564                 for my $table ( @{ $yaml->{'tables'} } ) {
 565                     my $query_info   = process_yml_table($table);
 566                     my $query        = $query_info->{query};
 567                     my $placeholders = $query_info->{placeholders};
 568                     my $values       = $query_info->{values};
 569                     # Doing only 1 INSERT query for the whole table
 570                     my @all_rows_values = map { @$_ } @$values;
 571                     $query .= join ', ', ( $placeholders ) x scalar @$values;
 572                     $dbh->do( $query, undef, @all_rows_values );
 573                 }
 574                 for my $statement ( @{ $yaml->{'sql_statements'} } ) {               # extra SQL statements
 575                     $dbh->do($statement);
 576                 }
 577             };
 578         }
 579         if ($@){
 580             warn "Something went wrong loading file $filename ($@)";
 581         }
 582     };
 583     #   errors thrown while loading installer data should be logged
 584     if( $dup_stderr ) {
 585         warn "C4::Installer::load_sql returned the following errors while attempting to load $filename:\n";
 586         $error = $dup_stderr;
 587     }
 588
 589     return $error;
 590 }
 591
 592 =head2 get_file_path_from_name
 593
 594   my $filename = $installer->get_file_path_from_name('script_name');
 595
 596 searches through the set of known SQL scripts and finds the fully
 597 qualified path name for the script that mathches the input.
 598
 599 returns undef if no match was found.
 600
 601
 602 =cut
 603
 604 sub get_file_path_from_name {
 605     my $self = shift;
 606     my $partialname = shift;
 607
 608     my $lang = 'en'; # FIXME: how do I know what language I want?
 609
 610     my ($defaulted_to_en, $list) = $self->sample_data_sql_list($lang);
 611     # warn( Data::Dumper->Dump( [ $list ], [ 'list' ] ) );
 612
 613     my @found;
 614     foreach my $frameworklist ( @$list ) {
 615         push @found, grep { $_->{'fwkfile'} =~ /$partialname$/ } @{$frameworklist->{'frameworks'}};
 616     }
 617
 618     # warn( Data::Dumper->Dump( [ \@found ], [ 'found' ] ) );
 619     if ( 0 == scalar @found ) {
 620         return;
 621     } elsif ( 1 < scalar @found ) {
 622         warn "multiple results found for $partialname";
 623         return;
 624     } else {
 625         return $found[0]->{'fwkfile'};
 626     }
 627
 628 }
 629
 630 sub primary_key_exists {
 631     my ( $table_name, $key_name ) = @_;
 632     my $dbh = C4::Context->dbh;
 633     my ($exists) = $dbh->selectrow_array(
 634         qq|
 635         SHOW INDEX FROM $table_name
 636         WHERE key_name = 'PRIMARY' AND column_name = ?
 637         |, undef, $key_name
 638     );
 639     return $exists;
 640 }
 641
 642 sub foreign_key_exists {
 643     my ( $table_name, $constraint_name ) = @_;
 644     my $dbh = C4::Context->dbh;
 645     my (undef, $infos) = $dbh->selectrow_array(qq|SHOW CREATE TABLE $table_name|);
 646     return $infos =~ m|CONSTRAINT `$constraint_name` FOREIGN KEY|;
 647 }
 648
 649 sub index_exists {
 650     my ( $table_name, $key_name ) = @_;
 651     my $dbh = C4::Context->dbh;
 652     my ($exists) = $dbh->selectrow_array(
 653         qq|
 654         SHOW INDEX FROM $table_name
 655         WHERE key_name = ?
 656         |, undef, $key_name
 657     );
 658     return $exists;
 659 }
 660
 661 sub column_exists {
 662     my ( $table_name, $column_name ) = @_;
 663     return unless TableExists($table_name);
 664     my $dbh = C4::Context->dbh;
 665     my ($exists) = $dbh->selectrow_array(
 666         qq|
 667         SHOW COLUMNS FROM $table_name
 668         WHERE Field = ?
 669         |, undef, $column_name
 670     );
 671     return $exists;
 672 }
 673
 674 sub TableExists { # Could be renamed table_exists for consistency
 675     my $table = shift;
 676     eval {
 677                 my $dbh = C4::Context->dbh;
 678                 local $dbh->{PrintError} = 0;
 679                 local $dbh->{RaiseError} = 1;
 680                 $dbh->do(qq{SELECT * FROM $table WHERE 1 = 0 });
 681             };
 682     return 1 unless $@;
 683     return 0;
 684 }
 685
 686
 687 =head1 AUTHOR
 688
 689 C4::Installer is a refactoring of logic originally from installer/installer.pl, which was
 690 originally written by Henri-Damien Laurant.
 691
 692 Koha Development Team <http://koha-community.org/>
 693
 694 Galen Charlton <galen.charlton@liblime.com>
 695
 696 =cut
 697
 698 1;