Koha/misc/maintenance/fix_mysql_constraints.pl
Jonathan Druart 46f7239b08 Bug 27673: Replace YAML with YAML::XS
From tht YAML pod:

"""
This module has been released to CPAN as YAML::Old, and soon YAML.pm will be changed to just be a frontend interface module for all the various Perl YAML implementation modules, including YAML::Old.

If you want robust and fast YAML processing using the normal Dump/Load API, please consider switching to YAML::XS. It is by far the best Perl module for YAML at this time. It requires that you have a C compiler, since it is written in C.
"""

See also
https://gitlab.com/koha-community/qa-test-tools/-/merge_requests/35

Test plan:
Try some place where YAML::XS is not used and confirm that it works
correctly

QA note: This patch removes some uses of YAML that were not useful

Signed-off-by: Kyle M Hall <kyle@bywatersolutions.com>
Signed-off-by: Joonas Kylmälä <joonas.kylmala@helsinki.fi>

Signed-off-by: Jonathan Druart <jonathan.druart@bugs.koha-community.org>
2021-02-16 14:54:50 +01:00

166 lines
4.3 KiB
Perl
Executable file

#!/usr/bin/perl
#
# Copyright (C) 2012 Tamil s.a.r.l.
#
# 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;
BEGIN {
# find Koha's Perl modules
# test carefully before changing this
use FindBin;
my $lib = "$FindBin::Bin/../kohalib.pl";
eval { require $lib };
}
use Getopt::Long;
use Pod::Usage;
use Try::Tiny;
use Koha::Script;
use C4::Context;
my ($doit, $alterengine, $help);
my $result = GetOptions(
'doit' => \$doit,
'alterengine' => \$alterengine,
'help|h' => \$help,
);
sub usage {
pod2usage( -verbose => 2 );
exit;
}
sub fix_mysql_constraints {
my ($doit) = @_;
# Get all current DB constraints
my $dbh = C4::Context->dbh;
$dbh->{RaiseError} = 1;
$dbh->{ShowErrorStatement} = 1;
my $database = C4::Context->config('database');
my %db_constraint = map { $_->[0] => undef } @{$dbh->selectall_arrayref(
"SELECT CONSTRAINT_NAME
FROM information_schema.table_constraints
WHERE constraint_schema = '$database'
AND CONSTRAINT_TYPE != 'PRIMARY KEY' ")};
my $base_dir = C4::Context->config('intranetdir');
open my $fh, "<", "$base_dir/installer/data/mysql/kohastructure.sql"
or die "Unable to open kohastructure.sql file";
my $table_name;
my $engine_altered;
# FIXME: This hide problem. But if you run this script, it means that you
# have already identified issues with your Koha DB integrity, and will fix
# any necessary tables requiring records deleting.
$dbh->do("SET FOREIGN_KEY_CHECKS=0");
my $line = <$fh>;
while ( $line ) {
if ( $line =~ /CREATE TABLE (.*?) / ) {
$table_name = $1;
$table_name =~ s/\`//g;
$engine_altered = 0;
$line = <$fh>;
next;
}
unless ( $line =~ /CONSTRAINT /i ) {
$line = <$fh>;
next;
}
my $constraint = $line;
CONTRAINT_LOOP:
while ( $constraint !~ /,/ ) {
$line = <$fh>;
last CONTRAINT_LOOP if $line =~ /ENGINE/i;
$line =~ s/^ */ /;
$constraint .= $line;
}
$constraint =~ s/^ *//;
$constraint =~ s/\n//g;
$constraint =~ s/ *$//;
$constraint =~ s/,$//;
my ($name) = $constraint =~ /CONSTRAINT (.*?) /;
$name =~ s/\`//g;
unless ( exists($db_constraint{$name}) ) {
if ( $alterengine && !$engine_altered ) {
my $sql = "ALTER TABLE $table_name ENGINE = 'InnoDB'";
say $sql;
if ( $doit ) {
try {
$dbh->do($sql) if $doit;
$engine_altered = 1;
} catch {
say "Error: $_;";
};
}
}
my $sql = "ALTER TABLE $table_name ADD $constraint";
say $sql;
if ( $doit ) {
try {
$dbh->do($sql) if $doit;
} catch {
say "Error: $_";
}
}
}
$line = <$fh> if $line =~ /CONSTRAINT/i;
}
}
usage() if $help;
fix_mysql_constraints($doit);
=head1 NAME
fix_mysql_constraints.pl
=head1 SYNOPSIS
fix_mysql_constraints.pl --help
fix_mysql_constraints.pl
fix_mysql_constraints.pl --doit
=head1 DESCRIPTION
See bug #8915
Alter tables to add missing constraints. Prior to altering tables, it may be
necessary to alter tables storage engine from MyISAM to InnoDB.
=over 8
=item B<--help>
Prints this help
=item B<--doit>
Alter tables effectively, otherwise just display the ALTER TABLE directives.
=item B<--alterengine>
Prior to add missing constraints, alter table engine to InnoDB.
=back
=cut