3 # Copyright (C) 2008 LibLime
5 # This file is part of Koha.
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.
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.
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>.
23 use Encode qw( encode is_utf8 );
31 use vars qw(@ISA @EXPORT);
34 @ISA = qw( Exporter );
35 push @EXPORT, qw( primary_key_exists unique_key_exists foreign_key_exists index_exists column_exists TableExists marc_framework_sql_list TransformToNum CheckVersion NewVersion sanitize_zero_date update get_db_entries );
45 my $installer = C4::Installer->new();
46 my $all_languages = getAllLanguages();
47 my $error = $installer->load_db_schema();
49 #fill $list with list of sql files
50 my ($fwk_language, $error_list) = $installer->load_sql_in_order($all_languages, @$list);
51 $installer->set_version_syspref();
52 $installer->set_marcflavour_syspref('MARC21');
62 my $installer = C4::Installer->new();
64 Creates a new installer.
73 # get basic information from context
74 $self->{'dbname'} = C4::Context->config("database");
75 $self->{'dbms'} = C4::Context->config("db_scheme") ? C4::Context->config("db_scheme") : "mysql";
76 $self->{'hostname'} = C4::Context->config("hostname");
77 $self->{'port'} = C4::Context->config("port");
78 $self->{'user'} = C4::Context->config("user");
79 $self->{'password'} = C4::Context->config("pass");
80 $self->{'tls'} = C4::Context->config("tls");
81 if( $self->{'tls'} && $self->{'tls'} eq 'yes' ) {
82 $self->{'ca'} = C4::Context->config('ca');
83 $self->{'cert'} = C4::Context->config('cert');
84 $self->{'key'} = C4::Context->config('key');
85 $self->{'tlsoptions'} = ";mysql_ssl=1;mysql_ssl_client_key=".$self->{key}.";mysql_ssl_client_cert=".$self->{cert}.";mysql_ssl_ca_file=".$self->{ca};
86 $self->{'tlscmdline'} = " --ssl-cert ". $self->{cert} . " --ssl-key " . $self->{key} . " --ssl-ca ".$self->{ca}." "
88 $self->{'dbh'} = DBI->connect("DBI:$self->{dbms}:dbname=$self->{dbname};host=$self->{hostname}" .
89 ( $self->{port} ? ";port=$self->{port}" : "" ).
90 ( $self->{tlsoptions} ? $self->{tlsoptions} : ""),
91 $self->{'user'}, $self->{'password'});
92 $self->{'language'} = undef;
93 $self->{'marcflavour'} = undef;
94 $self->{'dbh'}->do('set NAMES "utf8"');
95 $self->{'dbh'}->{'mysql_enable_utf8'}=1;
101 =head2 marc_framework_sql_list
103 my ($defaulted_to_en, $list) =
104 $installer->marc_framework_sql_list($lang, $marcflavour);
106 Returns in C<$list> a structure listing the filename, description, section,
107 and mandatory/optional status of MARC framework scripts available for C<$lang>
110 If the C<$defaulted_to_en> return value is true, no scripts are available
111 for language C<$lang> and the 'en' ones are returned.
115 sub marc_framework_sql_list {
118 my $marcflavour = shift;
120 my $defaulted_to_en = 0;
123 my $dir = C4::Context->config('intranetdir') . "/installer/data/$self->{dbms}/$lang/marcflavour/".lc($marcflavour);
124 unless (opendir( MYDIR, $dir )) {
126 warn "cannot open MARC frameworks directory $dir";
128 # if no translated MARC framework is available,
130 $dir = C4::Context->config('intranetdir') . "/installer/data/$self->{dbms}/en/marcflavour/".lc($marcflavour);
131 opendir(MYDIR, $dir) or warn "cannot open English MARC frameworks directory $dir";
132 $defaulted_to_en = 1;
135 my @listdir = sort grep { !/^\.|marcflavour/ && -d "$dir/$_" } readdir(MYDIR);
139 my $request = $self->{'dbh'}->prepare("SELECT value FROM systempreferences WHERE variable='FrameworksLoaded'");
141 my ($frameworksloaded) = $request->fetchrow;
142 $frameworksloaded = '' unless defined $frameworksloaded; # avoid warning
143 my %frameworksloaded;
144 foreach ( split( /\|/, $frameworksloaded ) ) {
145 $frameworksloaded{$_} = 1;
148 foreach my $requirelevel (@listdir) {
149 opendir( MYDIR, "$dir/$requirelevel" );
150 my @listname = grep { !/^\./ && -f "$dir/$requirelevel/$_" && $_ =~ m/\.(sql|yml)$/ } readdir(MYDIR);
155 my ( $name, $ext ) = split /\./, $_;
157 if ( $ext =~ /yml/ ) {
158 my $yaml = YAML::XS::LoadFile("$dir/$requirelevel/$name\.$ext");
159 @lines = @{ $yaml->{'description'} };
161 open my $fh, "<:encoding(UTF-8)", "$dir/$requirelevel/$name.txt";
163 $line = Encode::encode('UTF-8', $line) unless ( Encode::is_utf8($line) );
164 @lines = split /\n/, $line;
166 my $mandatory = ($requirelevel =~ /(mandatory|requi|oblig|necess)/i);
170 'fwkfile' => "$dir/$requirelevel/$_",
171 'fwkdescription' => \@lines,
172 'checked' => ( ( $frameworksloaded{$_} || $mandatory ) ? 1 : 0 ),
173 'mandatory' => $mandatory,
177 sort { $a->{'fwkname'} cmp $b->{'fwkname'} } @frameworklist;
179 $cell{"frameworks"} = \@fwks;
180 $cell{"label"} = ($requirelevel =~ /(mandatory|requi|oblig|necess)/i)?'mandatory':'optional';
181 $cell{"code"} = lc($requirelevel);
182 push @fwklist, \%cell;
185 return ($defaulted_to_en, \@fwklist);
188 =head2 sample_data_sql_list
190 my ($defaulted_to_en, $list) = $installer->sample_data_sql_list($lang);
192 Returns in C<$list> a structure listing the filename, description, section,
193 and mandatory/optional status of sample data scripts available for C<$lang>.
194 If the C<$defaulted_to_en> return value is true, no scripts are available
195 for language C<$lang> and the 'en' ones are returned.
199 sub sample_data_sql_list {
203 my $defaulted_to_en = 0;
206 my $dir = C4::Context->config('intranetdir') . "/installer/data/$self->{dbms}/$lang";
207 unless (opendir( MYDIR, $dir )) {
209 warn "cannot open sample data directory $dir";
211 # if no sample data is available,
213 $dir = C4::Context->config('intranetdir') . "/installer/data/$self->{dbms}/en";
214 opendir(MYDIR, $dir) or warn "cannot open English sample data directory $dir";
215 $defaulted_to_en = 1;
218 my @listdir = sort grep { !/^\.|marcflavour/ && -d "$dir/$_" } readdir(MYDIR);
222 my $request = $self->{'dbh'}->prepare("SELECT value FROM systempreferences WHERE variable='FrameworksLoaded'");
224 my ($frameworksloaded) = $request->fetchrow;
225 $frameworksloaded = '' unless defined $frameworksloaded; # avoid warning
226 my %frameworksloaded;
227 foreach ( split( /\|/, $frameworksloaded ) ) {
228 $frameworksloaded{$_} = 1;
231 foreach my $requirelevel (@listdir) {
232 opendir( MYDIR, "$dir/$requirelevel" );
233 my @listname = grep { !/^\./ && -f "$dir/$requirelevel/$_" && $_ =~ m/\.(sql|yml)$/ } readdir(MYDIR);
238 my ( $name, $ext ) = split /\./, $_;
240 if ( $ext =~ /yml/ ) {
241 my $yaml = YAML::XS::LoadFile("$dir/$requirelevel/$name\.$ext");
242 @lines = @{ $yaml->{'description'} };
244 open my $fh, "<:encoding(UTF-8)", "$dir/$requirelevel/$name.txt";
246 $line = Encode::encode('UTF-8', $line) unless ( Encode::is_utf8($line) );
247 @lines = split /\n/, $line;
249 my $mandatory = ($requirelevel =~ /(mandatory|requi|oblig|necess)/i);
253 'fwkfile' => "$dir/$requirelevel/$_",
254 'fwkdescription' => \@lines,
255 'checked' => ( ( $frameworksloaded{$_} || $mandatory ) ? 1 : 0 ),
256 'mandatory' => $mandatory,
259 my @fwks = sort { $a->{'fwkname'} cmp $b->{'fwkname'} } @frameworklist;
261 $cell{"frameworks"} = \@fwks;
262 $cell{"label"} = ($requirelevel =~ /(mandatory|requi|oblig|necess)/i)?'mandatory':'optional';
263 $cell{"code"} = lc($requirelevel);
264 push @levellist, \%cell;
267 return ($defaulted_to_en, \@levellist);
270 =head2 load_db_schema
272 my $error = $installer->load_db_schema();
274 Loads the SQL script that creates Koha's tables and indexes. The
275 return value is a string containing error messages reported by the
283 my $datadir = C4::Context->config('intranetdir') . "/installer/data/$self->{dbms}";
285 # Disable checks before load
286 $self->{'dbh'}->do(q{SET NAMES utf8mb4});
287 $self->{'dbh'}->do(q{SET @OLD_UNIQUE_CHECKS=@@UNIQUE_CHECKS, UNIQUE_CHECKS=0});
288 $self->{'dbh'}->do(q{SET @OLD_FOREIGN_KEY_CHECKS=@@FOREIGN_KEY_CHECKS, FOREIGN_KEY_CHECKS=0});
289 $self->{'dbh'}->do(q{SET @OLD_SQL_MODE=@@SQL_MODE, SQL_MODE='NO_AUTO_VALUE_ON_ZERO'});
290 $self->{'dbh'}->do(q{SET @OLD_SQL_NOTES=@@SQL_NOTES, SQL_NOTES=0});
293 my $error = $self->load_sql("$datadir/kohastructure.sql");
295 # Re-enable checks after load
296 $self->{'dbh'}->do(q{SET SQL_MODE=@OLD_SQL_MODE});
297 $self->{'dbh'}->do(q{SET FOREIGN_KEY_CHECKS=@OLD_FOREIGN_KEY_CHECKS});
298 $self->{'dbh'}->do(q{SET UNIQUE_CHECKS=@OLD_UNIQUE_CHECKS});
299 $self->{'dbh'}->do(q{SET SQL_NOTES=@OLD_SQL_NOTES});
305 =head2 load_sql_in_order
307 my ($fwk_language, $list) = $installer->load_sql_in_order($all_languages, @sql_list);
309 Given a list of SQL scripts supplied in C<@sql_list>, loads each of them
310 into the database and sets the FrameworksLoaded system preference to names
311 of the scripts that were loaded.
313 The SQL files are loaded in alphabetical order by filename (not including
314 directory path). This means that dependencies among the scripts are to
315 be resolved by carefully naming them, keeping in mind that the directory name
316 does *not* currently count.
318 B<FIXME:> this is a rather delicate way of dealing with dependencies between
321 The return value C<$list> is an arrayref containing a hashref for each
322 "level" or directory containing SQL scripts; the hashref in turns contains
323 a list of hashrefs containing a list of each script load and any error
324 messages associated with the loading of each script.
326 B<FIXME:> The C<$fwk_language> code probably doesn't belong and needs to be
327 moved to a different method.
331 sub load_sql_in_order {
333 my $langchoice = shift;
334 my $all_languages = shift;
340 my @aa = split /\/|\\/, ($a);
341 my @bb = split /\/|\\/, ($b);
344 my $request = $self->{'dbh'}->prepare( "SELECT value FROM systempreferences WHERE variable='FrameworksLoaded'" );
346 my ($systempreference) = $request->fetchrow;
347 $systempreference = '' unless defined $systempreference; # avoid warning
349 my $global_mandatory_dir = C4::Context->config('intranetdir') . "/installer/data/$self->{dbms}/mandatory";
351 # Make sure some stuffs are loaded first
353 "$global_mandatory_dir/sysprefs.sql",
354 "$global_mandatory_dir/subtag_registry.sql",
355 "$global_mandatory_dir/auth_val_cat.sql",
356 "$global_mandatory_dir/message_transport_types.sql",
357 "$global_mandatory_dir/sample_notices_message_attributes.sql",
358 "$global_mandatory_dir/sample_notices_message_transports.sql",
359 "$global_mandatory_dir/keyboard_shortcuts.sql",
362 push @fnames, "$global_mandatory_dir/userflags.sql",
363 "$global_mandatory_dir/userpermissions.sql",
364 "$global_mandatory_dir/audio_alerts.sql",
365 "$global_mandatory_dir/account_offset_types.sql",
366 "$global_mandatory_dir/account_credit_types.sql",
367 "$global_mandatory_dir/account_debit_types.sql",
369 my $localization_file = C4::Context->config('intranetdir') .
370 "/installer/data/$self->{dbms}/localization/$langchoice/custom.sql";
371 if ( $langchoice ne 'en' and -f $localization_file ) {
372 push @fnames, $localization_file;
374 foreach my $file (@fnames) {
377 my $error = $self->load_sql($file);
378 my @file = split qr(\/|\\), $file;
379 $lang = $file[ scalar(@file) - 3 ] unless ($lang);
380 my $level = ( $file =~ /(localization)/ ) ? $1 : $file[ scalar(@file) - 2 ];
382 $systempreference .= "$file[scalar(@file)-1]|"
383 unless ( index( $systempreference, $file[ scalar(@file) - 1 ] ) >= 0 );
386 #Bulding here a hierarchy to display files by level.
387 push @{ $hashlevel{$level} },
388 { "fwkname" => $file[ scalar(@file) - 1 ], "error" => $error };
391 #systempreference contains an ending |
392 chop $systempreference;
394 map { push @list, { "level" => $_, "fwklist" => $hashlevel{$_} } } keys %hashlevel;
396 for my $each_language (@$all_languages) {
398 # warn "CODE".$each_language->{'language_code'};
399 # warn "LANG:".$lang;
400 if ( $lang eq $each_language->{'language_code'} ) {
401 $fwk_language = $each_language->{language_locale_name};
406 "UPDATE systempreferences set value=\"$systempreference\" where variable='FrameworksLoaded'"
409 unless ( $updateflag == 1 ) {
411 "INSERT INTO systempreferences (value, variable, explanation, type) VALUES (\"$systempreference\",'FrameworksLoaded','Frameworks loaded through webinstaller','choice')";
412 my $rq = $self->{'dbh'}->prepare($string);
415 return ($fwk_language, \@list);
418 =head2 set_marcflavour_syspref
420 $installer->set_marcflavour_syspref($marcflavour);
422 Set the 'marcflavour' system preference. The incoming
423 C<$marcflavour> references to a subdirectory of
424 installer/data/$dbms/$lang/marcflavour, and is
425 normalized to MARC21, UNIMARC or NORMARC.
427 FIXME: this method assumes that the MARC flavour will be either
428 MARC21, UNIMARC or NORMARC.
432 sub set_marcflavour_syspref {
434 my $marcflavour = shift;
436 # we can have some variants of marc flavour, by having different directories, like : unimarc_small and unimarc_full, for small and complete unimarc frameworks.
437 # marc_cleaned finds the marcflavour, without the variant.
438 my $marc_cleaned = 'MARC21';
439 $marc_cleaned = 'UNIMARC' if $marcflavour =~ /unimarc/i;
440 $marc_cleaned = 'NORMARC' if $marcflavour =~ /normarc/i;
442 $self->{'dbh'}->prepare(
443 "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');"
448 =head2 set_version_syspref
450 $installer->set_version_syspref();
452 Set or update the 'Version' system preference to the current
453 Koha software version.
457 sub set_version_syspref {
460 my $kohaversion = Koha::version();
461 # remove the 3 last . to have a Perl number
462 $kohaversion =~ s/(.*\..*)\.(.*)\.(.*)/$1$2$3/;
463 if (C4::Context->preference('Version')) {
464 warn "UPDATE Version";
465 my $finish=$self->{'dbh'}->prepare("UPDATE systempreferences SET value=? WHERE variable='Version'");
466 $finish->execute($kohaversion);
468 warn "INSERT Version";
469 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')");
470 $finish->execute($kohaversion);
472 C4::Context->clear_syspref_cache();
475 =head2 set_languages_syspref
477 $installer->set_languages_syspref();
479 Add the installation language to 'language' and 'OPACLanguages' system preferences
480 if different from 'en'
484 sub set_languages_syspref {
486 my $language = shift;
488 return if ( not $language or $language eq 'en' );
490 warn "UPDATE Languages";
492 my $pref = $self->{'dbh'}->prepare("UPDATE systempreferences SET value=? WHERE variable='language'");
493 $pref->execute("en,$language");
495 $pref = $self->{'dbh'}->prepare("UPDATE systempreferences SET value=? WHERE variable='OPACLanguages'");
496 $pref->execute("en,$language");
498 C4::Context->clear_syspref_cache();
501 =head2 process_yml_table
503 my $query_info = $installer->process_yml_table($table);
505 Analyzes a table loaded in YAML format.
506 Returns the values required to build an insert statement.
510 sub process_yml_table {
512 my $table_name = ( keys %$table )[0]; # table name
513 my @rows = @{ $table->{$table_name}->{rows} }; #
514 my @columns = ( sort keys %{$rows[0]} ); # column names
515 my $fields = join ",", map{sprintf("`%s`", $_)} @columns; # idem, joined
516 my $query = "INSERT INTO $table_name ( $fields ) VALUES ";
517 my @multiline = @{ $table->{$table_name}->{'multiline'} }; # to check multiline values;
518 my $placeholders = '(' . join ( ",", map { "?" } @columns ) . ')'; # '(?,..,?)' string
520 foreach my $row ( @rows ) {
521 push @values, [ map {
523 ( @multiline and grep { $_ eq $col } @multiline )
524 ? join "\r\n", @{$row->{$col}} # join multiline values
528 return { query => $query, placeholders => $placeholders, values => \@values };
533 my $error = $installer->load_sql($filename);
535 Runs the specified input file using a sql loader DBIx::RunSQL, or a yaml loader
536 Returns any strings sent to STDERR
538 # FIXME This should be improved: sometimes the caller and load_sql warn the same
545 my $filename = shift;
548 my $dbh = $self->{ dbh };
553 open STDERR, ">>", \$dup_stderr;
555 if ( $filename =~ /sql$/ ) { # SQL files
557 DBIx::RunSQL->run_sql_file(
565 my $yaml = YAML::XS::LoadFile( $filename ); # Load YAML
566 for my $table ( @{ $yaml->{'tables'} } ) {
567 my $query_info = process_yml_table($table);
568 my $query = $query_info->{query};
569 my $placeholders = $query_info->{placeholders};
570 my $values = $query_info->{values};
571 # Doing only 1 INSERT query for the whole table
572 my @all_rows_values = map { @$_ } @$values;
573 $query .= join ', ', ( $placeholders ) x scalar @$values;
574 $dbh->do( $query, undef, @all_rows_values );
576 for my $statement ( @{ $yaml->{'sql_statements'} } ) { # extra SQL statements
577 $dbh->do($statement);
582 warn "Something went wrong loading file $filename ($@)";
585 # errors thrown while loading installer data should be logged
587 warn "C4::Installer::load_sql returned the following errors while attempting to load $filename:\n";
588 $error = $dup_stderr;
594 =head2 get_file_path_from_name
596 my $filename = $installer->get_file_path_from_name('script_name');
598 searches through the set of known SQL scripts and finds the fully
599 qualified path name for the script that mathches the input.
601 returns undef if no match was found.
606 sub get_file_path_from_name {
608 my $partialname = shift;
610 my $lang = 'en'; # FIXME: how do I know what language I want?
612 my ($defaulted_to_en, $list) = $self->sample_data_sql_list($lang);
613 # warn( Data::Dumper->Dump( [ $list ], [ 'list' ] ) );
616 foreach my $frameworklist ( @$list ) {
617 push @found, grep { $_->{'fwkfile'} =~ /$partialname$/ } @{$frameworklist->{'frameworks'}};
620 # warn( Data::Dumper->Dump( [ \@found ], [ 'found' ] ) );
621 if ( 0 == scalar @found ) {
623 } elsif ( 1 < scalar @found ) {
624 warn "multiple results found for $partialname";
627 return $found[0]->{'fwkfile'};
632 sub primary_key_exists {
633 my ( $table_name, $key_name ) = @_;
634 my $dbh = C4::Context->dbh;
635 my ($exists) = $dbh->selectrow_array(
637 SHOW INDEX FROM $table_name
638 WHERE key_name = 'PRIMARY' AND column_name = ?
644 sub foreign_key_exists {
645 my ( $table_name, $constraint_name ) = @_;
646 my $dbh = C4::Context->dbh;
647 my (undef, $infos) = $dbh->selectrow_array(qq|SHOW CREATE TABLE $table_name|);
648 return $infos =~ m|CONSTRAINT `$constraint_name` FOREIGN KEY|;
651 sub unique_key_exists {
652 my ( $table_name, $constraint_name ) = @_;
653 my $dbh = C4::Context->dbh;
654 my (undef, $infos) = $dbh->selectrow_array(qq|SHOW CREATE TABLE $table_name|);
655 return $infos =~ m|UNIQUE KEY `$constraint_name`|;
659 my ( $table_name, $key_name ) = @_;
660 my $dbh = C4::Context->dbh;
661 my ($exists) = $dbh->selectrow_array(
663 SHOW INDEX FROM $table_name
671 my ( $table_name, $column_name ) = @_;
672 return unless TableExists($table_name);
673 my $dbh = C4::Context->dbh;
674 my ($exists) = $dbh->selectrow_array(
676 SHOW COLUMNS FROM $table_name
678 |, undef, $column_name
683 sub TableExists { # Could be renamed table_exists for consistency
686 my $dbh = C4::Context->dbh;
687 local $dbh->{PrintError} = 0;
688 local $dbh->{RaiseError} = 1;
689 $dbh->do(qq{SELECT * FROM $table WHERE 1 = 0 });
695 sub version_from_file {
697 return unless $file =~ m|(^\|/)(\d{2})(\d{2})(\d{2})(\d{3}).pl$|;
698 return sprintf "%s.%s.%s.%s", $2, $3, $4, $5;
702 my $db_revs_dir = C4::Context->config('intranetdir') . '/installer/data/mysql/db_revs';
703 opendir my $dh, $db_revs_dir or die "Cannot open $db_revs_dir dir ($!)";
704 my @files = sort grep { m|\.pl$| && ! m|skeleton\.pl$| } readdir $dh;
706 for my $file ( @files ) {
707 my $version = version_from_file( $file );
709 unless ( $version ) {
710 warn "Invalid db_rev found: " . $file;
714 next unless CheckVersion( $version );
716 push @need_update, sprintf( "%s/%s", $db_revs_dir, $file );
718 return \@need_update;
722 my ( $files, $params ) = @_;
724 my $force = $params->{force} || 0;
726 my $schema = Koha::Database->new->schema;
727 my ( @done, @errors );
728 for my $file ( @$files ) {
730 my $db_rev = do $file;
735 open my $outfh, '>', \$out;
739 $db_rev->{up}->({ dbh => $schema->storage->dbh, out => $outfh });
749 bug_number => $db_rev->{bug_number},
750 description => $db_rev->{description},
751 version => version_from_file($file),
752 time => POSIX::strftime( "%H:%M:%S", localtime ),
754 $db_entry->{output} = output_version( { %$db_entry, done => !$error, report => $out } );
757 push @errors, { %$db_entry, error => $error };
758 $force ? next : last ;
759 # We stop the update if an error occurred!
762 SetVersion($db_entry->{version});
763 push @done, $db_entry;
765 return { success => \@done, error => \@errors };
769 my ( $db_entry ) = @_;
771 my $description = $db_entry->{description};
772 my $report = $db_entry->{report};
773 my $DBversion = $db_entry->{version};
774 my $bug_number = $db_entry->{bug_number};
775 my $time = $db_entry->{time};
776 my $done = defined $db_entry->{done}
780 : ""; # For old versions, we don't know if we succeed or failed
785 push @output, sprintf('Upgrade to %s %s [%s]: Bug %5s - %s', $DBversion, $done, $time, $bug_number, $description);
787 push @output, sprintf('Upgrade to %s %s [%s]: %s', $DBversion, $done, $time, $description);
791 foreach my $line (split /\n/, $report) {
792 push @output, sprintf "\t\t\t\t\t\t - %s", $line;
799 =head2 DropAllForeignKeys($table)
801 Drop all foreign keys of the table $table
805 sub DropAllForeignKeys {
807 # get the table description
808 my $dbh = C4::Context->dbh;
809 my $sth = $dbh->prepare("SHOW CREATE TABLE $table");
811 my $vsc_structure = $sth->fetchrow;
812 # split on CONSTRAINT keyword
813 my @fks = split /CONSTRAINT /,$vsc_structure;
816 # isolate what is before FOREIGN KEY, if there is something, it's a foreign key to drop
817 $_ = /(.*) FOREIGN KEY.*/;
820 # we have found 1 foreign, drop it
821 $dbh->do("ALTER TABLE $table DROP FOREIGN KEY $id");
828 =head2 TransformToNum
830 Transform the Koha version from a 4 parts string
831 to a number, with just 1 .
837 # remove the 3 last . to have a Perl number
838 $version =~ s/(.*\..*)\.(.*)\.(.*)/$1$2$3/;
839 # three X's at the end indicate that you are testing patch with dbrev
841 # prevents error on a < comparison between strings (should be: lt)
842 $version =~ s/XXX$/999/;
848 set the DBversion in the systempreferences
853 return if $_[0]=~ /XXX$/;
854 #you are testing a patch with a db revision; do not change version
855 my $kohaversion = TransformToNum($_[0]);
856 my $dbh = C4::Context->dbh;
857 if (C4::Context->preference('Version')) {
858 my $finish=$dbh->prepare("UPDATE systempreferences SET value=? WHERE variable='Version'");
859 $finish->execute($kohaversion);
861 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')");
862 $finish->execute($kohaversion);
864 C4::Context::clear_syspref_cache(); # invalidate cached preferences
867 # DEPRECATED Don't use it!
868 # Used for compatibility with older versions (from updatedatabase.pl)
870 my ( $DBversion, $bug_number, $descriptions ) = @_;
872 SetVersion($DBversion);
874 my ( $description, $report );
875 if ( ref($descriptions) ) {
876 $description = shift @$descriptions;
877 $report = join( "\n", @{$descriptions} );
880 $description = $descriptions;
883 my $output = output_version( {
884 bug_number => $bug_number,
885 description => $description,
887 version => $DBversion,
888 time => POSIX::strftime( "%H:%M:%S", localtime ),
891 say join "\n", @$output;
897 Check whether a given update should be run when passed the proposed version
898 number. The update will always be run if the proposed version is greater
899 than the current database version and less than or equal to the version in
900 kohaversion.pl. The update is also run if the version contains XXX, though
901 this behavior will be changed following the adoption of non-linear updates
902 as implemented in bug 7167.
907 my ($proposed_version) = @_;
908 my $version_number = TransformToNum($proposed_version);
910 # The following line should be deleted when bug 7167 is pushed
911 return 1 if ( $proposed_version =~ m/XXX/ );
913 if ( C4::Context->preference("Version") < $version_number
914 && $version_number <= TransformToNum( $Koha::VERSION ) )
922 sub sanitize_zero_date {
923 my ( $table_name, $column_name ) = @_;
925 my $dbh = C4::Context->dbh;
927 my (undef, $datatype) = $dbh->selectrow_array(qq|
928 SHOW COLUMNS FROM $table_name WHERE Field = ?|, undef, $column_name);
930 if ( $datatype eq 'date' ) {
933 SET $column_name = NULL
934 WHERE CAST($column_name AS CHAR(10)) = '0000-00-00';
939 SET $column_name = NULL
940 WHERE CAST($column_name AS CHAR(19)) = '0000-00-00 00:00:00';
947 C4::Installer is a refactoring of logic originally from installer/installer.pl, which was
948 originally written by Henri-Damien Laurant.
950 Koha Development Team <http://koha-community.org/>
952 Galen Charlton <galen.charlton@liblime.com>