X-Git-Url: http://git.rot13.org/?a=blobdiff_plain;f=C4%2FInstaller.pm;h=a1c47149f82375a2f0703a21b67208aed5f711c6;hb=9922d2bf40e2b7429f300d4d73134f9fef3b8c65;hp=5fe2e16982fe3da1708dc6d33d48b0f18099c67f;hpb=a39910ecb638cb15ddbbd96874bd48720b54e6e1;p=koha.git diff --git a/C4/Installer.pm b/C4/Installer.pm index 5fe2e16982..a1c47149f8 100644 --- a/C4/Installer.pm +++ b/C4/Installer.pm @@ -17,16 +17,22 @@ package C4::Installer; # You should have received a copy of the GNU General Public License # along with Koha; if not, see . -use strict; -#use warnings; FIXME - Bug 2505 +use Modern::Perl; use Encode qw( encode is_utf8 ); -our $VERSION = 3.07.00.049; +use DBIx::RunSQL; use C4::Context; use C4::Installer::PerlModules; use DBI; use Koha; +use vars qw(@ISA @EXPORT); +BEGIN { + require Exporter; + @ISA = qw( Exporter ); + push @EXPORT, qw( foreign_key_exists index_exists column_exists ); +}; + =head1 NAME C4::Installer @@ -69,8 +75,17 @@ sub new { $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->{port} ? ";port=$self->{port}" : "" ). + ( $self->{tlsoptions} ? $self->{tlsoptions} : ""), $self->{'user'}, $self->{'password'}); $self->{'language'} = undef; $self->{'marcflavour'} = undef; @@ -137,15 +152,15 @@ sub marc_framework_sql_list { map { my $name = substr( $_, 0, -4 ); open my $fh, "<:encoding(UTF-8)", "$dir/$requirelevel/$name.txt"; - my $lines = <$fh>; - $lines =~ s/\n|\r/
/g; - $lines = Encode::encode('UTF-8', $lines) unless ( Encode::is_utf8($lines) ); + my $line = <$fh>; + $line = Encode::encode('UTF-8', $line) unless ( Encode::is_utf8($line) ); + my @lines = split /\n/, $line; my $mandatory = ($requirelevel =~ /(mandatory|requi|oblig|necess)/i); push @frameworklist, { 'fwkname' => $name, 'fwkfile' => "$dir/$requirelevel/$_", - 'fwkdescription' => $lines, + 'fwkdescription' => \@lines, 'checked' => ( ( $frameworksloaded{$_} || $mandatory ) ? 1 : 0 ), 'mandatory' => $mandatory, }; @@ -214,15 +229,15 @@ sub sample_data_sql_list { map { my $name = substr( $_, 0, -4 ); open my $fh , "<:encoding(UTF-8)", "$dir/$requirelevel/$name.txt"; - my $lines = <$fh>; - $lines =~ s/\n|\r/
/g; - $lines = Encode::encode('UTF-8', $lines) unless ( Encode::is_utf8($lines) ); + my $line = <$fh>; + $line = Encode::encode('UTF-8', $line) unless ( Encode::is_utf8($line) ); + my @lines = split /\n/, $line; my $mandatory = ($requirelevel =~ /(mandatory|requi|oblig|necess)/i); push @frameworklist, { 'fwkname' => $name, 'fwkfile' => "$dir/$requirelevel/$_", - 'fwkdescription' => $lines, + 'fwkdescription' => \@lines, 'checked' => ( ( $frameworksloaded{$_} || $mandatory ) ? 1 : 0 ), 'mandatory' => $mandatory, }; @@ -302,12 +317,16 @@ sub load_sql_in_order { # Make sure subtag_registry.sql is loaded second my $subtag_registry = C4::Context->config('intranetdir') . "/installer/data/$self->{dbms}/mandatory/subtag_registry.sql"; unshift(@fnames, $subtag_registry); + # Make sure authorised value categories are loaded at the beginning + my $av_cat = C4::Context->config('intranetdir') . "/installer/data/$self->{dbms}/mandatory/auth_val_cat.sql"; + unshift(@fnames, $av_cat); # Make sure the global sysprefs.sql file is loaded first my $globalsysprefs = C4::Context->config('intranetdir') . "/installer/data/$self->{dbms}/sysprefs.sql"; unshift(@fnames, $globalsysprefs); push @fnames, C4::Context->config('intranetdir') . "/installer/data/mysql/userflags.sql"; push @fnames, C4::Context->config('intranetdir') . "/installer/data/mysql/userpermissions.sql"; push @fnames, C4::Context->config('intranetdir') . "/installer/data/mysql/audio_alerts.sql"; + push @fnames, C4::Context->config('intranetdir') . "/installer/data/mysql/account_offset_types.sql"; foreach my $file (@fnames) { # warn $file; undef $/; @@ -413,62 +432,39 @@ sub set_version_syspref { my $error = $installer->load_sql($filename); -Runs a the specified SQL using the DB's command-line -SQL tool, and returns any strings sent to STDERR -by the command-line tool. +Runs a the specified SQL file using a sql loader DBIx::RunSQL +Returns any strings sent to STDERR -B there has been a long-standing desire to -replace this with an SQL loader that goes -through DBI; partly for portability issues -and partly to improve error handling. - -B even using the command-line loader, some more -basic error handling should be added - deal -with missing files, e.g. +# 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 $datadir = C4::Context->config('intranetdir') . "/installer/data/$self->{dbms}"; my $error; - my $strcmd; - my $cmd; - if ( $self->{dbms} eq 'mysql' ) { - $cmd = qx(which mysql 2>/dev/null || whereis mysql 2>/dev/null); - chomp $cmd; - $cmd = $1 if ($cmd && $cmd =~ /^(.+?)[\r\n]+$/); - $cmd = 'mysql' if (!$cmd || !-x $cmd); - $strcmd = "$cmd " - . ( $self->{hostname} ? " -h $self->{hostname} " : "" ) - . ( $self->{port} ? " -P $self->{port} " : "" ) - . ( $self->{user} ? " -u $self->{user} " : "" ) - . ( $self->{password} ? " -p'$self->{password}'" : "" ) - . " $self->{dbname} "; - $error = qx($strcmd --default-character-set=utf8 <$filename 2>&1 1>/dev/null); - } elsif ( $self->{dbms} eq 'Pg' ) { - $cmd = qx(which psql 2>/dev/null || whereis psql 2>/dev/null); - chomp $cmd; - $cmd = $1 if ($cmd && $cmd =~ /^(.+?)[\r\n]+$/); - $cmd = 'psql' if (!$cmd || !-x $cmd); - $strcmd = "$cmd " - . ( $self->{hostname} ? " -h $self->{hostname} " : "" ) - . ( $self->{port} ? " -p $self->{port} " : "" ) - . ( $self->{user} ? " -U $self->{user} " : "" ) -# . ( $self->{password} ? " -W $self->{password}" : "" ) # psql will NOT accept a password, but prompts... - . " $self->{dbname} "; # Therefore, be sure to run 'trust' on localhost in pg_hba.conf -fbcit - $error = qx($strcmd -f $filename 2>&1 1>/dev/null); - # Be sure to set 'client_min_messages = error' in postgresql.conf - # so that only true errors are returned to stderr or else the installer will - # report the import as a failure although it really succeeded -fbcit - } -# errors thrown while loading installer data should be logged - if($error) { - warn "C4::Installer::load_sql returned the following errors while attempting to load $filename:\n"; - warn "$error"; + + my $dbh = $self->{ dbh }; + + my $dup_stderr; + do { + local *STDERR; + open STDERR, ">>", \$dup_stderr; + + eval { + DBIx::RunSQL->run_sql_file( + dbh => $dbh, + sql => $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; } @@ -510,6 +506,36 @@ sub get_file_path_from_name { } +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 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 ) = @_; + my $dbh = C4::Context->dbh; + my ($exists) = $dbh->selectrow_array( + qq| + SHOW COLUMNS FROM $table_name + WHERE Field = ? + |, undef, $column_name + ); + return $exists; +} =head1 AUTHOR