Jonathan Druart
fd829dbdcb
The atomicupdate directory will contain all the atomic update files (old and new version). That will ease job for the RM and RMaints, no file (except skeletons) must be in this directory before push. This patch also fixes an inconsistency we had: the atomic update was run before the other db revs on the UI but after when the CLI script was used. Now we make sure that the CLI does not deal with the atomic update files when called from the installer (UI) Signed-off-by: Kyle M Hall <kyle@bywatersolutions.com> Signed-off-by: Jonathan Druart <jonathan.druart@bugs.koha-community.org>
1047 lines
34 KiB
Perl
1047 lines
34 KiB
Perl
package C4::Installer;
|
|
|
|
# Copyright (C) 2008 LibLime
|
|
#
|
|
# This file is part of Koha.
|
|
#
|
|
# Koha is free software; you can redistribute it and/or modify it
|
|
# under the terms of the GNU General Public License as published by
|
|
# the Free Software Foundation; either version 3 of the License, or
|
|
# (at your option) any later version.
|
|
#
|
|
# Koha is distributed in the hope that it will be useful, but
|
|
# WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
# GNU General Public License for more details.
|
|
#
|
|
# You should have received a copy of the GNU General Public License
|
|
# along with Koha; if not, see <http://www.gnu.org/licenses>.
|
|
|
|
use Modern::Perl;
|
|
|
|
use Try::Tiny;
|
|
use Encode qw( encode decode is_utf8 );
|
|
use DBIx::RunSQL;
|
|
use YAML::XS;
|
|
use File::Slurp qw( read_file );
|
|
use DBI;
|
|
|
|
use C4::Context;
|
|
use Koha::Schema;
|
|
use Koha;
|
|
|
|
use vars qw(@ISA @EXPORT);
|
|
BEGIN {
|
|
require Exporter;
|
|
@ISA = qw( Exporter );
|
|
push @EXPORT, qw( primary_key_exists unique_key_exists foreign_key_exists index_exists column_exists TableExists marc_framework_sql_list TransformToNum CheckVersion NewVersion SetVersion sanitize_zero_date update get_db_entries get_atomic_updates run_atomic_updates );
|
|
};
|
|
|
|
=head1 NAME
|
|
|
|
C4::Installer
|
|
|
|
=head1 SYNOPSIS
|
|
|
|
use C4::Installer;
|
|
my $installer = C4::Installer->new();
|
|
my $all_languages = getAllLanguages();
|
|
my $error = $installer->load_db_schema();
|
|
my $list;
|
|
#fill $list with list of sql files
|
|
my ($fwk_language, $error_list) = $installer->load_sql_in_order($all_languages, @$list);
|
|
$installer->set_version_syspref();
|
|
$installer->set_marcflavour_syspref('MARC21');
|
|
|
|
=head1 DESCRIPTION
|
|
|
|
=cut
|
|
|
|
=head1 METHODS
|
|
|
|
=head2 new
|
|
|
|
my $installer = C4::Installer->new();
|
|
|
|
Creates a new installer.
|
|
|
|
=cut
|
|
|
|
sub new {
|
|
my $class = shift;
|
|
|
|
my $self = {};
|
|
|
|
# get basic information from context
|
|
$self->{'dbname'} = C4::Context->config("database");
|
|
$self->{'dbms'} = C4::Context->config("db_scheme") ? C4::Context->config("db_scheme") : "mysql";
|
|
$self->{'hostname'} = C4::Context->config("hostname");
|
|
$self->{'port'} = C4::Context->config("port");
|
|
$self->{'user'} = C4::Context->config("user");
|
|
$self->{'password'} = C4::Context->config("pass");
|
|
$self->{'tls'} = C4::Context->config("tls");
|
|
if( $self->{'tls'} && $self->{'tls'} eq 'yes' ) {
|
|
$self->{'ca'} = C4::Context->config('ca');
|
|
$self->{'cert'} = C4::Context->config('cert');
|
|
$self->{'key'} = C4::Context->config('key');
|
|
$self->{'tlsoptions'} = ";mysql_ssl=1;mysql_ssl_client_key=".$self->{key}.";mysql_ssl_client_cert=".$self->{cert}.";mysql_ssl_ca_file=".$self->{ca};
|
|
$self->{'tlscmdline'} = " --ssl-cert ". $self->{cert} . " --ssl-key " . $self->{key} . " --ssl-ca ".$self->{ca}." "
|
|
}
|
|
$self->{'dbh'} = DBI->connect("DBI:$self->{dbms}:dbname=$self->{dbname};host=$self->{hostname}" .
|
|
( $self->{port} ? ";port=$self->{port}" : "" ).
|
|
( $self->{tlsoptions} ? $self->{tlsoptions} : ""),
|
|
$self->{'user'}, $self->{'password'});
|
|
$self->{'language'} = undef;
|
|
$self->{'marcflavour'} = undef;
|
|
$self->{'dbh'}->do('set NAMES "utf8"');
|
|
$self->{'dbh'}->{'mysql_enable_utf8'}=1;
|
|
|
|
bless $self, $class;
|
|
return $self;
|
|
}
|
|
|
|
=head2 marc_framework_sql_list
|
|
|
|
my ($defaulted_to_en, $list) =
|
|
$installer->marc_framework_sql_list($lang, $marcflavour);
|
|
|
|
Returns in C<$list> a structure listing the filename, description, section,
|
|
and mandatory/optional status of MARC framework scripts available for C<$lang>
|
|
and C<$marcflavour>.
|
|
|
|
If the C<$defaulted_to_en> return value is true, no scripts are available
|
|
for language C<$lang> and the 'en' ones are returned.
|
|
|
|
=cut
|
|
|
|
sub marc_framework_sql_list {
|
|
my $self = shift;
|
|
my $lang = shift;
|
|
my $marcflavour = shift;
|
|
|
|
my $defaulted_to_en = 0;
|
|
|
|
undef $/;
|
|
my $dir = C4::Context->config('intranetdir') . "/installer/data/$self->{dbms}/$lang/marcflavour/".lc($marcflavour);
|
|
unless (opendir( MYDIR, $dir )) {
|
|
if ($lang eq 'en') {
|
|
warn "cannot open MARC frameworks directory $dir";
|
|
} else {
|
|
# if no translated MARC framework is available,
|
|
# default to English
|
|
$dir = C4::Context->config('intranetdir') . "/installer/data/$self->{dbms}/en/marcflavour/".lc($marcflavour);
|
|
opendir(MYDIR, $dir) or warn "cannot open English MARC frameworks directory $dir";
|
|
$defaulted_to_en = 1;
|
|
}
|
|
}
|
|
my @listdir = sort grep { !/^\.|marcflavour/ && -d "$dir/$_" } readdir(MYDIR);
|
|
closedir MYDIR;
|
|
|
|
my @fwklist;
|
|
my $request = $self->{'dbh'}->prepare("SELECT value FROM systempreferences WHERE variable='FrameworksLoaded'");
|
|
$request->execute;
|
|
my ($frameworksloaded) = $request->fetchrow;
|
|
$frameworksloaded = '' unless defined $frameworksloaded; # avoid warning
|
|
my %frameworksloaded;
|
|
foreach ( split( /\|/, $frameworksloaded ) ) {
|
|
$frameworksloaded{$_} = 1;
|
|
}
|
|
|
|
foreach my $requirelevel (@listdir) {
|
|
opendir( MYDIR, "$dir/$requirelevel" );
|
|
my @listname = grep { !/^\./ && -f "$dir/$requirelevel/$_" && $_ =~ m/\.(sql|yml)$/ } readdir(MYDIR);
|
|
closedir MYDIR;
|
|
my %cell;
|
|
my @frameworklist;
|
|
map {
|
|
my ( $name, $ext ) = split /\./, $_;
|
|
my @lines;
|
|
if ( $ext =~ /yml/ ) {
|
|
my $yaml = YAML::XS::LoadFile("$dir/$requirelevel/$name\.$ext");
|
|
@lines = @{ $yaml->{'description'} };
|
|
} else {
|
|
open my $fh, "<:encoding(UTF-8)", "$dir/$requirelevel/$name.txt";
|
|
my $line = <$fh>;
|
|
$line = Encode::encode('UTF-8', $line) unless ( Encode::is_utf8($line) );
|
|
@lines = split /\n/, $line;
|
|
}
|
|
my $mandatory = ($requirelevel =~ /(mandatory|requi|oblig|necess)/i);
|
|
push @frameworklist,
|
|
{
|
|
'fwkname' => $name,
|
|
'fwkfile' => "$dir/$requirelevel/$_",
|
|
'fwkdescription' => \@lines,
|
|
'checked' => ( ( $frameworksloaded{$_} || $mandatory ) ? 1 : 0 ),
|
|
'mandatory' => $mandatory,
|
|
};
|
|
} @listname;
|
|
my @fwks =
|
|
sort { $a->{'fwkname'} cmp $b->{'fwkname'} } @frameworklist;
|
|
|
|
$cell{"frameworks"} = \@fwks;
|
|
$cell{"label"} = ($requirelevel =~ /(mandatory|requi|oblig|necess)/i)?'mandatory':'optional';
|
|
$cell{"code"} = lc($requirelevel);
|
|
push @fwklist, \%cell;
|
|
}
|
|
|
|
return ($defaulted_to_en, \@fwklist);
|
|
}
|
|
|
|
=head2 sample_data_sql_list
|
|
|
|
my ($defaulted_to_en, $list) = $installer->sample_data_sql_list($lang);
|
|
|
|
Returns in C<$list> a structure listing the filename, description, section,
|
|
and mandatory/optional status of sample data scripts available for C<$lang>.
|
|
If the C<$defaulted_to_en> return value is true, no scripts are available
|
|
for language C<$lang> and the 'en' ones are returned.
|
|
|
|
=cut
|
|
|
|
sub sample_data_sql_list {
|
|
my $self = shift;
|
|
my $lang = shift;
|
|
|
|
my $defaulted_to_en = 0;
|
|
|
|
undef $/;
|
|
my $dir = C4::Context->config('intranetdir') . "/installer/data/$self->{dbms}/$lang";
|
|
unless (opendir( MYDIR, $dir )) {
|
|
if ($lang eq 'en') {
|
|
warn "cannot open sample data directory $dir";
|
|
} else {
|
|
# if no sample data is available,
|
|
# default to English
|
|
$dir = C4::Context->config('intranetdir') . "/installer/data/$self->{dbms}/en";
|
|
opendir(MYDIR, $dir) or warn "cannot open English sample data directory $dir";
|
|
$defaulted_to_en = 1;
|
|
}
|
|
}
|
|
my @listdir = sort grep { !/^\.|marcflavour/ && -d "$dir/$_" } readdir(MYDIR);
|
|
closedir MYDIR;
|
|
|
|
my @levellist;
|
|
my $request = $self->{'dbh'}->prepare("SELECT value FROM systempreferences WHERE variable='FrameworksLoaded'");
|
|
$request->execute;
|
|
my ($frameworksloaded) = $request->fetchrow;
|
|
$frameworksloaded = '' unless defined $frameworksloaded; # avoid warning
|
|
my %frameworksloaded;
|
|
foreach ( split( /\|/, $frameworksloaded ) ) {
|
|
$frameworksloaded{$_} = 1;
|
|
}
|
|
|
|
foreach my $requirelevel (@listdir) {
|
|
opendir( MYDIR, "$dir/$requirelevel" );
|
|
my @listname = grep { !/^\./ && -f "$dir/$requirelevel/$_" && $_ =~ m/\.(sql|yml)$/ } readdir(MYDIR);
|
|
closedir MYDIR;
|
|
my %cell;
|
|
my @frameworklist;
|
|
map {
|
|
my ( $name, $ext ) = split /\./, $_;
|
|
my @lines;
|
|
if ( $ext =~ /yml/ ) {
|
|
my $yaml = YAML::XS::LoadFile("$dir/$requirelevel/$name\.$ext");
|
|
@lines = @{ $yaml->{'description'} };
|
|
} else {
|
|
open my $fh, "<:encoding(UTF-8)", "$dir/$requirelevel/$name.txt";
|
|
my $line = <$fh>;
|
|
$line = Encode::encode('UTF-8', $line) unless ( Encode::is_utf8($line) );
|
|
@lines = split /\n/, $line;
|
|
}
|
|
my $mandatory = ($requirelevel =~ /(mandatory|requi|oblig|necess)/i);
|
|
push @frameworklist,
|
|
{
|
|
'fwkname' => $name,
|
|
'fwkfile' => "$dir/$requirelevel/$_",
|
|
'fwkdescription' => \@lines,
|
|
'checked' => ( ( $frameworksloaded{$_} || $mandatory ) ? 1 : 0 ),
|
|
'mandatory' => $mandatory,
|
|
};
|
|
} @listname;
|
|
my @fwks = sort { $a->{'fwkname'} cmp $b->{'fwkname'} } @frameworklist;
|
|
|
|
$cell{"frameworks"} = \@fwks;
|
|
$cell{"label"} = ($requirelevel =~ /(mandatory|requi|oblig|necess)/i)?'mandatory':'optional';
|
|
$cell{"code"} = lc($requirelevel);
|
|
push @levellist, \%cell;
|
|
}
|
|
|
|
return ($defaulted_to_en, \@levellist);
|
|
}
|
|
|
|
=head2 load_db_schema
|
|
|
|
my $error = $installer->load_db_schema();
|
|
|
|
Loads the SQL script that creates Koha's tables and indexes. The
|
|
return value is a string containing error messages reported by the
|
|
load.
|
|
|
|
=cut
|
|
|
|
sub load_db_schema {
|
|
my $self = shift;
|
|
|
|
my $datadir = C4::Context->config('intranetdir') . "/installer/data/$self->{dbms}";
|
|
|
|
# Disable checks before load
|
|
$self->{'dbh'}->do(q{SET NAMES utf8mb4});
|
|
$self->{'dbh'}->do(q{SET @OLD_UNIQUE_CHECKS=@@UNIQUE_CHECKS, UNIQUE_CHECKS=0});
|
|
$self->{'dbh'}->do(q{SET @OLD_FOREIGN_KEY_CHECKS=@@FOREIGN_KEY_CHECKS, FOREIGN_KEY_CHECKS=0});
|
|
$self->{'dbh'}->do(q{SET @OLD_SQL_MODE=@@SQL_MODE, SQL_MODE='NO_AUTO_VALUE_ON_ZERO'});
|
|
$self->{'dbh'}->do(q{SET @OLD_SQL_NOTES=@@SQL_NOTES, SQL_NOTES=0});
|
|
|
|
# Load kohastructure
|
|
my $error = $self->load_sql("$datadir/kohastructure.sql");
|
|
|
|
# Re-enable checks after load
|
|
$self->{'dbh'}->do(q{SET SQL_MODE=@OLD_SQL_MODE});
|
|
$self->{'dbh'}->do(q{SET FOREIGN_KEY_CHECKS=@OLD_FOREIGN_KEY_CHECKS});
|
|
$self->{'dbh'}->do(q{SET UNIQUE_CHECKS=@OLD_UNIQUE_CHECKS});
|
|
$self->{'dbh'}->do(q{SET SQL_NOTES=@OLD_SQL_NOTES});
|
|
|
|
return $error;
|
|
|
|
}
|
|
|
|
=head2 load_sql_in_order
|
|
|
|
my ($fwk_language, $list) = $installer->load_sql_in_order($all_languages, @sql_list);
|
|
|
|
Given a list of SQL scripts supplied in C<@sql_list>, loads each of them
|
|
into the database and sets the FrameworksLoaded system preference to names
|
|
of the scripts that were loaded.
|
|
|
|
The SQL files are loaded in alphabetical order by filename (not including
|
|
directory path). This means that dependencies among the scripts are to
|
|
be resolved by carefully naming them, keeping in mind that the directory name
|
|
does *not* currently count.
|
|
|
|
B<FIXME:> this is a rather delicate way of dealing with dependencies between
|
|
the install scripts.
|
|
|
|
The return value C<$list> is an arrayref containing a hashref for each
|
|
"level" or directory containing SQL scripts; the hashref in turns contains
|
|
a list of hashrefs containing a list of each script load and any error
|
|
messages associated with the loading of each script.
|
|
|
|
B<FIXME:> The C<$fwk_language> code probably doesn't belong and needs to be
|
|
moved to a different method.
|
|
|
|
=cut
|
|
|
|
sub load_sql_in_order {
|
|
my $self = shift;
|
|
my $langchoice = shift;
|
|
my $all_languages = shift;
|
|
my @sql_list = @_;
|
|
|
|
my $lang;
|
|
my %hashlevel;
|
|
my @fnames = sort {
|
|
my @aa = split /\/|\\/, ($a);
|
|
my @bb = split /\/|\\/, ($b);
|
|
$aa[-1] cmp $bb[-1]
|
|
} @sql_list;
|
|
my $request = $self->{'dbh'}->prepare( "SELECT value FROM systempreferences WHERE variable='FrameworksLoaded'" );
|
|
$request->execute;
|
|
my ($systempreference) = $request->fetchrow;
|
|
$systempreference = '' unless defined $systempreference; # avoid warning
|
|
|
|
my $global_mandatory_dir = C4::Context->config('intranetdir') . "/installer/data/$self->{dbms}/mandatory";
|
|
|
|
# Make sure some stuffs are loaded first
|
|
unshift(@fnames,
|
|
"$global_mandatory_dir/sysprefs.sql",
|
|
"$global_mandatory_dir/subtag_registry.sql",
|
|
"$global_mandatory_dir/auth_val_cat.sql",
|
|
"$global_mandatory_dir/message_transport_types.sql",
|
|
"$global_mandatory_dir/sample_notices_message_attributes.sql",
|
|
"$global_mandatory_dir/sample_notices_message_transports.sql",
|
|
"$global_mandatory_dir/keyboard_shortcuts.sql",
|
|
);
|
|
|
|
push @fnames, "$global_mandatory_dir/userflags.sql",
|
|
"$global_mandatory_dir/userpermissions.sql",
|
|
"$global_mandatory_dir/audio_alerts.sql",
|
|
"$global_mandatory_dir/account_offset_types.sql",
|
|
"$global_mandatory_dir/account_credit_types.sql",
|
|
"$global_mandatory_dir/account_debit_types.sql",
|
|
;
|
|
my $localization_file = C4::Context->config('intranetdir') .
|
|
"/installer/data/$self->{dbms}/localization/$langchoice/custom.sql";
|
|
if ( $langchoice ne 'en' and -f $localization_file ) {
|
|
push @fnames, $localization_file;
|
|
}
|
|
foreach my $file (@fnames) {
|
|
# warn $file;
|
|
undef $/;
|
|
my $error = $self->load_sql($file);
|
|
my @file = split qr(\/|\\), $file;
|
|
$lang = $file[ scalar(@file) - 3 ] unless ($lang);
|
|
my $level = ( $file =~ /(localization)/ ) ? $1 : $file[ scalar(@file) - 2 ];
|
|
unless ($error) {
|
|
$systempreference .= "$file[scalar(@file)-1]|"
|
|
unless ( index( $systempreference, $file[ scalar(@file) - 1 ] ) >= 0 );
|
|
}
|
|
|
|
#Bulding here a hierarchy to display files by level.
|
|
push @{ $hashlevel{$level} },
|
|
{ "fwkname" => $file[ scalar(@file) - 1 ], "error" => $error };
|
|
}
|
|
|
|
#systempreference contains an ending |
|
|
chop $systempreference;
|
|
my @list;
|
|
map { push @list, { "level" => $_, "fwklist" => $hashlevel{$_} } } keys %hashlevel;
|
|
my $fwk_language;
|
|
for my $each_language (@$all_languages) {
|
|
|
|
# warn "CODE".$each_language->{'language_code'};
|
|
# warn "LANG:".$lang;
|
|
if ( $lang eq $each_language->{'language_code'} ) {
|
|
$fwk_language = $each_language->{language_locale_name};
|
|
}
|
|
}
|
|
my $updateflag =
|
|
$self->{'dbh'}->do(
|
|
"UPDATE systempreferences set value=\"$systempreference\" where variable='FrameworksLoaded'"
|
|
);
|
|
|
|
unless ( $updateflag == 1 ) {
|
|
my $string =
|
|
"INSERT INTO systempreferences (value, variable, explanation, type) VALUES (\"$systempreference\",'FrameworksLoaded','Frameworks loaded through webinstaller','choice')";
|
|
my $rq = $self->{'dbh'}->prepare($string);
|
|
$rq->execute;
|
|
}
|
|
return ($fwk_language, \@list);
|
|
}
|
|
|
|
=head2 set_marcflavour_syspref
|
|
|
|
$installer->set_marcflavour_syspref($marcflavour);
|
|
|
|
Set the 'marcflavour' system preference. The incoming
|
|
C<$marcflavour> references to a subdirectory of
|
|
installer/data/$dbms/$lang/marcflavour, and is
|
|
normalized to MARC21, UNIMARC or NORMARC.
|
|
|
|
FIXME: this method assumes that the MARC flavour will be either
|
|
MARC21, UNIMARC or NORMARC.
|
|
|
|
=cut
|
|
|
|
sub set_marcflavour_syspref {
|
|
my $self = shift;
|
|
my $marcflavour = shift;
|
|
|
|
# we can have some variants of marc flavour, by having different directories, like : unimarc_small and unimarc_full, for small and complete unimarc frameworks.
|
|
# marc_cleaned finds the marcflavour, without the variant.
|
|
my $marc_cleaned = 'MARC21';
|
|
$marc_cleaned = 'UNIMARC' if $marcflavour =~ /unimarc/i;
|
|
$marc_cleaned = 'NORMARC' if $marcflavour =~ /normarc/i;
|
|
my $request =
|
|
$self->{'dbh'}->prepare(
|
|
"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');"
|
|
);
|
|
$request->execute;
|
|
}
|
|
|
|
=head2 set_version_syspref
|
|
|
|
$installer->set_version_syspref();
|
|
|
|
Set or update the 'Version' system preference to the current
|
|
Koha software version.
|
|
|
|
=cut
|
|
|
|
sub set_version_syspref {
|
|
my $self = shift;
|
|
|
|
my $kohaversion = Koha::version();
|
|
# remove the 3 last . to have a Perl number
|
|
$kohaversion =~ s/(.*\..*)\.(.*)\.(.*)/$1$2$3/;
|
|
if (C4::Context->preference('Version')) {
|
|
warn "UPDATE Version";
|
|
my $finish=$self->{'dbh'}->prepare("UPDATE systempreferences SET value=? WHERE variable='Version'");
|
|
$finish->execute($kohaversion);
|
|
} else {
|
|
warn "INSERT Version";
|
|
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')");
|
|
$finish->execute($kohaversion);
|
|
}
|
|
C4::Context->clear_syspref_cache();
|
|
}
|
|
|
|
=head2 set_languages_syspref
|
|
|
|
$installer->set_languages_syspref();
|
|
|
|
Add the installation language to 'language' and 'OPACLanguages' system preferences
|
|
if different from 'en'
|
|
|
|
=cut
|
|
|
|
sub set_languages_syspref {
|
|
my $self = shift;
|
|
my $language = shift;
|
|
|
|
return if ( not $language or $language eq 'en' );
|
|
|
|
warn "UPDATE Languages";
|
|
# intranet
|
|
my $pref = $self->{'dbh'}->prepare("UPDATE systempreferences SET value=? WHERE variable='language'");
|
|
$pref->execute("en,$language");
|
|
# opac
|
|
$pref = $self->{'dbh'}->prepare("UPDATE systempreferences SET value=? WHERE variable='OPACLanguages'");
|
|
$pref->execute("en,$language");
|
|
|
|
C4::Context->clear_syspref_cache();
|
|
}
|
|
|
|
=head2 process_yml_table
|
|
|
|
my $query_info = $installer->process_yml_table($table);
|
|
|
|
Analyzes a table loaded in YAML format.
|
|
Returns the values required to build an insert statement.
|
|
|
|
=cut
|
|
|
|
sub process_yml_table {
|
|
my ($table) = @_;
|
|
my $table_name = ( keys %$table )[0]; # table name
|
|
my @rows = @{ $table->{$table_name}->{rows} }; #
|
|
my @columns = ( sort keys %{$rows[0]} ); # column names
|
|
my $fields = join ",", map{sprintf("`%s`", $_)} @columns; # idem, joined
|
|
my $query = "INSERT INTO $table_name ( $fields ) VALUES ";
|
|
my @multiline = @{ $table->{$table_name}->{'multiline'} }; # to check multiline values;
|
|
my $placeholders = '(' . join ( ",", map { "?" } @columns ) . ')'; # '(?,..,?)' string
|
|
my @values;
|
|
foreach my $row ( @rows ) {
|
|
push @values, [ map {
|
|
my $col = $_;
|
|
( @multiline and grep { $_ eq $col } @multiline )
|
|
? join "\r\n", @{$row->{$col}} # join multiline values
|
|
: $row->{$col};
|
|
} @columns ];
|
|
}
|
|
return { query => $query, placeholders => $placeholders, values => \@values };
|
|
}
|
|
|
|
=head2 load_sql
|
|
|
|
my $error = $installer->load_sql($filename);
|
|
|
|
Runs the specified input file using a sql loader DBIx::RunSQL, or a yaml loader
|
|
Returns any strings sent to STDERR
|
|
|
|
# FIXME This should be improved: sometimes the caller and load_sql warn the same
|
|
error.
|
|
|
|
=cut
|
|
|
|
sub load_sql {
|
|
my $self = shift;
|
|
my $filename = shift;
|
|
my $error;
|
|
|
|
my $dbh = $self->{ dbh };
|
|
|
|
my $dup_stderr;
|
|
do {
|
|
local *STDERR;
|
|
open STDERR, ">>", \$dup_stderr;
|
|
|
|
if ( $filename =~ /sql$/ ) { # SQL files
|
|
eval {
|
|
DBIx::RunSQL->run_sql_file(
|
|
dbh => $dbh,
|
|
sql => $filename,
|
|
);
|
|
};
|
|
}
|
|
else { # YAML files
|
|
eval {
|
|
my $yaml = YAML::XS::LoadFile( $filename ); # Load YAML
|
|
for my $table ( @{ $yaml->{'tables'} } ) {
|
|
my $query_info = process_yml_table($table);
|
|
my $query = $query_info->{query};
|
|
my $placeholders = $query_info->{placeholders};
|
|
my $values = $query_info->{values};
|
|
# Doing only 1 INSERT query for the whole table
|
|
my @all_rows_values = map { @$_ } @$values;
|
|
$query .= join ', ', ( $placeholders ) x scalar @$values;
|
|
$dbh->do( $query, undef, @all_rows_values );
|
|
}
|
|
for my $statement ( @{ $yaml->{'sql_statements'} } ) { # extra SQL statements
|
|
$dbh->do($statement);
|
|
}
|
|
};
|
|
}
|
|
if ($@){
|
|
warn "Something went wrong loading file $filename ($@)";
|
|
}
|
|
};
|
|
# errors thrown while loading installer data should be logged
|
|
if( $dup_stderr ) {
|
|
warn "C4::Installer::load_sql returned the following errors while attempting to load $filename:\n";
|
|
$error = $dup_stderr;
|
|
}
|
|
|
|
return $error;
|
|
}
|
|
|
|
=head2 get_file_path_from_name
|
|
|
|
my $filename = $installer->get_file_path_from_name('script_name');
|
|
|
|
searches through the set of known SQL scripts and finds the fully
|
|
qualified path name for the script that mathches the input.
|
|
|
|
returns undef if no match was found.
|
|
|
|
|
|
=cut
|
|
|
|
sub get_file_path_from_name {
|
|
my $self = shift;
|
|
my $partialname = shift;
|
|
|
|
my $lang = 'en'; # FIXME: how do I know what language I want?
|
|
|
|
my ($defaulted_to_en, $list) = $self->sample_data_sql_list($lang);
|
|
# warn( Data::Dumper->Dump( [ $list ], [ 'list' ] ) );
|
|
|
|
my @found;
|
|
foreach my $frameworklist ( @$list ) {
|
|
push @found, grep { $_->{'fwkfile'} =~ /$partialname$/ } @{$frameworklist->{'frameworks'}};
|
|
}
|
|
|
|
# warn( Data::Dumper->Dump( [ \@found ], [ 'found' ] ) );
|
|
if ( 0 == scalar @found ) {
|
|
return;
|
|
} elsif ( 1 < scalar @found ) {
|
|
warn "multiple results found for $partialname";
|
|
return;
|
|
} else {
|
|
return $found[0]->{'fwkfile'};
|
|
}
|
|
|
|
}
|
|
|
|
sub primary_key_exists {
|
|
my ( $table_name, $key_name ) = @_;
|
|
my $dbh = C4::Context->dbh;
|
|
my ($exists) = $dbh->selectrow_array(
|
|
qq|
|
|
SHOW INDEX FROM $table_name
|
|
WHERE key_name = 'PRIMARY' AND column_name = ?
|
|
|, undef, $key_name
|
|
);
|
|
return $exists;
|
|
}
|
|
|
|
sub foreign_key_exists {
|
|
my ( $table_name, $constraint_name ) = @_;
|
|
my $dbh = C4::Context->dbh;
|
|
my (undef, $infos) = $dbh->selectrow_array(qq|SHOW CREATE TABLE $table_name|);
|
|
return $infos =~ m|CONSTRAINT `$constraint_name` FOREIGN KEY|;
|
|
}
|
|
|
|
sub unique_key_exists {
|
|
my ( $table_name, $constraint_name ) = @_;
|
|
my $dbh = C4::Context->dbh;
|
|
my (undef, $infos) = $dbh->selectrow_array(qq|SHOW CREATE TABLE $table_name|);
|
|
return $infos =~ m|UNIQUE KEY `$constraint_name`|;
|
|
}
|
|
|
|
sub index_exists {
|
|
my ( $table_name, $key_name ) = @_;
|
|
my $dbh = C4::Context->dbh;
|
|
my ($exists) = $dbh->selectrow_array(
|
|
qq|
|
|
SHOW INDEX FROM $table_name
|
|
WHERE key_name = ?
|
|
|, undef, $key_name
|
|
);
|
|
return $exists;
|
|
}
|
|
|
|
sub column_exists {
|
|
my ( $table_name, $column_name ) = @_;
|
|
return unless TableExists($table_name);
|
|
my $dbh = C4::Context->dbh;
|
|
my ($exists) = $dbh->selectrow_array(
|
|
qq|
|
|
SHOW COLUMNS FROM $table_name
|
|
WHERE Field = ?
|
|
|, undef, $column_name
|
|
);
|
|
return $exists;
|
|
}
|
|
|
|
sub TableExists { # Could be renamed table_exists for consistency
|
|
my $table = shift;
|
|
eval {
|
|
my $dbh = C4::Context->dbh;
|
|
local $dbh->{PrintError} = 0;
|
|
local $dbh->{RaiseError} = 1;
|
|
$dbh->do(qq{SELECT * FROM $table WHERE 1 = 0 });
|
|
};
|
|
return 1 unless $@;
|
|
return 0;
|
|
}
|
|
|
|
sub version_from_file {
|
|
my $file = shift;
|
|
return unless $file =~ m|(^\|/)(\d{2})(\d{2})(\d{2})(\d{3}).pl$|;
|
|
return sprintf "%s.%s.%s.%s", $2, $3, $4, $5;
|
|
}
|
|
|
|
sub get_db_entries {
|
|
my $db_revs_dir = C4::Context->config('intranetdir') . '/installer/data/mysql/db_revs';
|
|
opendir my $dh, $db_revs_dir or die "Cannot open $db_revs_dir dir ($!)";
|
|
my @files = sort grep { m|\.pl$| && ! m|skeleton\.pl$| } readdir $dh;
|
|
my @need_update;
|
|
for my $file ( @files ) {
|
|
my $version = version_from_file( $file );
|
|
|
|
unless ( $version ) {
|
|
warn "Invalid db_rev found: " . $file;
|
|
next
|
|
}
|
|
|
|
next unless CheckVersion( $version );
|
|
|
|
push @need_update, sprintf( "%s/%s", $db_revs_dir, $file );
|
|
}
|
|
return \@need_update;
|
|
}
|
|
|
|
sub run_db_rev {
|
|
my ($file) = @_;
|
|
|
|
my $db_rev = do $file;
|
|
|
|
my $error;
|
|
my $out = '';
|
|
open my $outfh, '>', \$out;
|
|
try {
|
|
my $schema = Koha::Database->new->schema;
|
|
$schema->txn_do(
|
|
sub {
|
|
$db_rev->{up}->( { dbh => $schema->storage->dbh, out => $outfh } );
|
|
}
|
|
);
|
|
}
|
|
catch {
|
|
$error = $_;
|
|
};
|
|
|
|
close $outfh;
|
|
$out = decode( 'UTF-8', $out );
|
|
|
|
my $db_entry = {
|
|
filepath => $file,
|
|
bug_number => $db_rev->{bug_number},
|
|
description => $db_rev->{description},
|
|
exec_output => $out,
|
|
version => scalar version_from_file($file),
|
|
time => POSIX::strftime( "%H:%M:%S", localtime ),
|
|
error => $error
|
|
};
|
|
$db_entry->{output} = generate_output_db_entry($db_entry, $out);
|
|
return $db_entry;
|
|
}
|
|
|
|
sub update {
|
|
my ( $files, $params ) = @_;
|
|
|
|
my $force = $params->{force} || 0;
|
|
|
|
my ( @done, @errors );
|
|
for my $file ( @$files ) {
|
|
|
|
my $db_entry = run_db_rev($file);
|
|
|
|
if ( $db_entry->{error} ) {
|
|
push @errors, $db_entry;
|
|
$force ? next : last ;
|
|
# We stop the update if an error occurred!
|
|
}
|
|
|
|
SetVersion($db_entry->{version});
|
|
push @done, $db_entry;
|
|
}
|
|
return { success => \@done, error => \@errors };
|
|
}
|
|
|
|
sub generate_output_db_entry {
|
|
my ( $db_entry ) = @_;
|
|
|
|
my $description = $db_entry->{description};
|
|
my $output = $db_entry->{output};
|
|
my $DBversion = $db_entry->{version};
|
|
my $bug_number = $db_entry->{bug_number};
|
|
my $time = $db_entry->{time};
|
|
my $exec_output = $db_entry->{exec_output};
|
|
my $done = defined $db_entry->{done}
|
|
? $db_entry->{done}
|
|
? " done"
|
|
: " failed"
|
|
: ""; # For old versions, we don't know if we succeed or failed
|
|
|
|
my @output;
|
|
|
|
if ( $DBversion ) {
|
|
if ($bug_number) {
|
|
push @output, sprintf('Upgrade to %s %s [%s]: Bug %5s - %s', $DBversion, $done, $time, $bug_number, $description);
|
|
} else {
|
|
push @output, sprintf('Upgrade to %s %s [%s]: %s', $DBversion, $done, $time, $description);
|
|
}
|
|
} else { # Atomic update
|
|
if ($bug_number) {
|
|
push @output, sprintf('DEV atomic update %s %s [%s]: Bug %5s - %s', $db_entry->{filepath}, $done, $time, $bug_number, $description);
|
|
} else { # Old atomic update syntax
|
|
push @output, sprintf('DEV atomic update %s %s [%s]', $db_entry->{filepath}, $done, $time);
|
|
}
|
|
}
|
|
|
|
if ($exec_output) {
|
|
foreach my $line (split /\n/, $exec_output) {
|
|
push @output, sprintf "\t\t\t\t\t\t - %s", $line;
|
|
}
|
|
}
|
|
|
|
return \@output;
|
|
}
|
|
|
|
sub get_atomic_updates {
|
|
my @atomic_upate_files;
|
|
# if there is anything in the atomicupdate, read and execute it.
|
|
my $update_dir = C4::Context->config('intranetdir') . '/installer/data/mysql/atomicupdate/';
|
|
opendir( my $dirh, $update_dir );
|
|
foreach my $file ( sort readdir $dirh ) {
|
|
next if $file !~ /\.(perl|pl)$/; #skip other files
|
|
next if $file eq 'skeleton.perl' || $file eq 'skeleton.pl'; # skip the skeleton files
|
|
|
|
push @atomic_upate_files, $file;
|
|
}
|
|
return \@atomic_upate_files;
|
|
}
|
|
|
|
sub run_atomic_updates {
|
|
my ( $files ) = @_;
|
|
|
|
my $update_dir = C4::Context->config('intranetdir') . '/installer/data/mysql/atomicupdate/';
|
|
my ( @done, @errors );
|
|
for my $file ( @$files ) {
|
|
my $filepath = $update_dir . $file;
|
|
|
|
my $atomic_update;
|
|
if ( $file =~ m{\.perl$} ) {
|
|
my $code = read_file( $filepath );
|
|
my ( $out, $err ) = ('', '');
|
|
{
|
|
open my $oldout, ">&STDOUT";
|
|
close STDOUT;
|
|
open STDOUT,'>:encoding(utf8)', \$out;
|
|
my $DBversion = Koha::version; # We need $DBversion and $dbh for the eval
|
|
my $dbh = C4::Context->dbh;
|
|
eval $code; ## no critic (StringyEval)
|
|
$err = $@;
|
|
warn $err if $err;
|
|
close STDOUT;
|
|
open STDOUT, ">&", $oldout;
|
|
}
|
|
|
|
$atomic_update = {
|
|
filepath => $filepath,
|
|
description => '',
|
|
version => undef,
|
|
time => POSIX::strftime( "%H:%M:%S", localtime ),
|
|
};
|
|
|
|
|
|
$atomic_update->{output} =
|
|
$out
|
|
? [ split "\n", $out ]
|
|
: generate_output_db_entry($atomic_update); # There wad an error, we didn't reach NewVersion)
|
|
|
|
$atomic_update->{error} = $err if $err;
|
|
} elsif ( $file =~ m{\.pl$} ) {
|
|
$atomic_update = run_db_rev($filepath);
|
|
} else {
|
|
warn "Atomic update must be .perl or .pl ($file)";
|
|
}
|
|
|
|
if ( $atomic_update->{error} ) {
|
|
push @errors, $atomic_update;
|
|
} else {
|
|
push @done, $atomic_update;
|
|
}
|
|
}
|
|
|
|
return { success => \@done, error => \@errors };
|
|
}
|
|
|
|
=head2 DropAllForeignKeys($table)
|
|
|
|
Drop all foreign keys of the table $table
|
|
|
|
=cut
|
|
|
|
sub DropAllForeignKeys {
|
|
my ($table) = @_;
|
|
# get the table description
|
|
my $dbh = C4::Context->dbh;
|
|
my $sth = $dbh->prepare("SHOW CREATE TABLE $table");
|
|
$sth->execute;
|
|
my $vsc_structure = $sth->fetchrow;
|
|
# split on CONSTRAINT keyword
|
|
my @fks = split /CONSTRAINT /,$vsc_structure;
|
|
# parse each entry
|
|
foreach (@fks) {
|
|
# isolate what is before FOREIGN KEY, if there is something, it's a foreign key to drop
|
|
$_ = /(.*) FOREIGN KEY.*/;
|
|
my $id = $1;
|
|
if ($id) {
|
|
# we have found 1 foreign, drop it
|
|
$dbh->do("ALTER TABLE $table DROP FOREIGN KEY $id");
|
|
$id="";
|
|
}
|
|
}
|
|
}
|
|
|
|
|
|
=head2 TransformToNum
|
|
|
|
Transform the Koha version from a 4 parts string
|
|
to a number, with just 1 .
|
|
|
|
=cut
|
|
|
|
sub TransformToNum {
|
|
my $version = shift;
|
|
# remove the 3 last . to have a Perl number
|
|
$version =~ s/(.*\..*)\.(.*)\.(.*)/$1$2$3/;
|
|
# three X's at the end indicate that you are testing patch with dbrev
|
|
# change it into 999
|
|
# prevents error on a < comparison between strings (should be: lt)
|
|
$version =~ s/XXX$/999/;
|
|
return $version;
|
|
}
|
|
|
|
=head2 SetVersion
|
|
|
|
set the DBversion in the systempreferences
|
|
|
|
=cut
|
|
|
|
sub SetVersion {
|
|
return if $_[0]=~ /XXX$/;
|
|
#you are testing a patch with a db revision; do not change version
|
|
my $kohaversion = TransformToNum($_[0]);
|
|
my $dbh = C4::Context->dbh;
|
|
if (C4::Context->preference('Version')) {
|
|
my $finish=$dbh->prepare("UPDATE systempreferences SET value=? WHERE variable='Version'");
|
|
$finish->execute($kohaversion);
|
|
} else {
|
|
my $finish=$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')");
|
|
$finish->execute($kohaversion);
|
|
}
|
|
C4::Context::clear_syspref_cache(); # invalidate cached preferences
|
|
}
|
|
|
|
# DEPRECATED Don't use it!
|
|
# Used for compatibility with older versions (from updatedatabase.pl)
|
|
sub NewVersion {
|
|
my ( $DBversion, $bug_number, $descriptions ) = @_;
|
|
|
|
SetVersion($DBversion);
|
|
|
|
my ( $description, $report );
|
|
if ( ref($descriptions) ) {
|
|
$description = shift @$descriptions;
|
|
$report = join( "\n", @{$descriptions} );
|
|
}
|
|
else {
|
|
$description = $descriptions;
|
|
}
|
|
|
|
my $output = generate_output_db_entry( {
|
|
bug_number => $bug_number,
|
|
description => $description,
|
|
report => $report,
|
|
version => $DBversion,
|
|
time => POSIX::strftime( "%H:%M:%S", localtime ),
|
|
});
|
|
|
|
say join "\n", @$output;
|
|
|
|
}
|
|
|
|
=head2 CheckVersion
|
|
|
|
Check whether a given update should be run when passed the proposed version
|
|
number. The update will always be run if the proposed version is greater
|
|
than the current database version and less than or equal to the version in
|
|
kohaversion.pl. The update is also run if the version contains XXX, though
|
|
this behavior will be changed following the adoption of non-linear updates
|
|
as implemented in bug 7167.
|
|
|
|
=cut
|
|
|
|
sub CheckVersion {
|
|
my ($proposed_version) = @_;
|
|
my $version_number = TransformToNum($proposed_version);
|
|
|
|
# The following line should be deleted when bug 7167 is pushed
|
|
return 1 if ( $proposed_version =~ m/XXX/ );
|
|
|
|
if ( C4::Context->preference("Version") < $version_number
|
|
&& $version_number <= TransformToNum( $Koha::VERSION ) )
|
|
{
|
|
return 1;
|
|
}
|
|
|
|
return 0;
|
|
}
|
|
|
|
sub sanitize_zero_date {
|
|
my ( $table_name, $column_name ) = @_;
|
|
|
|
my $dbh = C4::Context->dbh;
|
|
|
|
my (undef, $datatype) = $dbh->selectrow_array(qq|
|
|
SHOW COLUMNS FROM $table_name WHERE Field = ?|, undef, $column_name);
|
|
|
|
if ( $datatype eq 'date' ) {
|
|
$dbh->do(qq|
|
|
UPDATE $table_name
|
|
SET $column_name = NULL
|
|
WHERE CAST($column_name AS CHAR(10)) = '0000-00-00';
|
|
|);
|
|
} else {
|
|
$dbh->do(qq|
|
|
UPDATE $table_name
|
|
SET $column_name = NULL
|
|
WHERE CAST($column_name AS CHAR(19)) = '0000-00-00 00:00:00';
|
|
|);
|
|
}
|
|
}
|
|
|
|
=head1 AUTHOR
|
|
|
|
C4::Installer is a refactoring of logic originally from installer/installer.pl, which was
|
|
originally written by Henri-Damien Laurant.
|
|
|
|
Koha Development Team <http://koha-community.org/>
|
|
|
|
Galen Charlton <galen.charlton@liblime.com>
|
|
|
|
=cut
|
|
|
|
1;
|