Lines 47-52
use MARC::File::XML ( BinaryEncoding => 'utf8' );
Link Here
|
47 |
use File::Path qw[remove_tree]; # perl core module |
47 |
use File::Path qw[remove_tree]; # perl core module |
48 |
use File::Slurp; |
48 |
use File::Slurp; |
49 |
|
49 |
|
|
|
50 |
use Koha::AtomicUpdater; |
51 |
|
50 |
# FIXME - The user might be installing a new database, so can't rely |
52 |
# FIXME - The user might be installing a new database, so can't rely |
51 |
# on /etc/koha.conf anyway. |
53 |
# on /etc/koha.conf anyway. |
52 |
|
54 |
|
Lines 21434-21454
if( CheckVersion( $DBversion ) ) {
Link Here
|
21434 |
|
21436 |
|
21435 |
# SEE bug 13068 |
21437 |
# SEE bug 13068 |
21436 |
# if there is anything in the atomicupdate, read and execute it. |
21438 |
# if there is anything in the atomicupdate, read and execute it. |
21437 |
my $update_dir = C4::Context->config('intranetdir') . '/installer/data/mysql/atomicupdate/'; |
21439 |
# |
21438 |
opendir( my $dirh, $update_dir ); |
21440 |
#my $update_dir = C4::Context->config('intranetdir') . '/installer/data/mysql/atomicupdate/'; |
21439 |
foreach my $file ( sort readdir $dirh ) { |
21441 |
# |
21440 |
next if $file !~ /\.(sql|perl)$/; #skip other files |
21442 |
#opendir( my $dirh, $update_dir ); |
21441 |
next if $file eq 'skeleton.perl'; # skip the skeleton file |
21443 |
#foreach my $file ( sort readdir $dirh ) { |
21442 |
print "DEV atomic update: $file\n"; |
21444 |
# next if $file !~ /\.(sql|perl)$/; #skip other files |
21443 |
if ( $file =~ /\.sql$/ ) { |
21445 |
# next if $file eq 'skeleton.perl'; # skip the skeleton file |
21444 |
my $installer = C4::Installer->new(); |
21446 |
# print "DEV atomic update: $file\n"; |
21445 |
my $rv = $installer->load_sql( $update_dir . $file ) ? 0 : 1; |
21447 |
# if ( $file =~ /\.sql$/ ) { |
21446 |
} elsif ( $file =~ /\.perl$/ ) { |
21448 |
# my $installer = C4::Installer->new(); |
21447 |
my $code = read_file( $update_dir . $file ); |
21449 |
# my $rv = $installer->load_sql( $update_dir . $file ) ? 0 : 1; |
21448 |
eval $code; |
21450 |
# } elsif ( $file =~ /\.perl$/ ) { |
21449 |
say "Atomic update generated errors: $@" if $@; |
21451 |
# my $code = read_file( $update_dir . $file ); |
21450 |
} |
21452 |
# eval $code; |
21451 |
} |
21453 |
# say "Atomic update generated errors: $@" if $@; |
|
|
21454 |
# } |
21455 |
#} |
21456 |
|
21457 |
#Use Koha::AtomicUpdater instead to prevent reinstalling DB upgrades |
21458 |
my $atomicUpdater = Koha::AtomicUpdater->new({ |
21459 |
verbose => 2, |
21460 |
scriptDir => C4::Context->config('intranetdir') . '/installer/data/mysql/atomicupdate/', |
21461 |
}); |
21462 |
$atomicUpdater->buildUpdateOrderFromGit(1000); |
21463 |
$atomicUpdater->applyAtomicUpdates(); |
21464 |
|
21452 |
|
21465 |
|
21453 |
=head1 FUNCTIONS |
21466 |
=head1 FUNCTIONS |
21454 |
|
21467 |
|
Lines 21561-21566
as implemented in bug 7167.
Link Here
|
21561 |
=cut |
21574 |
=cut |
21562 |
|
21575 |
|
21563 |
sub CheckVersion { |
21576 |
sub CheckVersion { |
|
|
21577 |
#Check if we have already applied this update as an atomicupdate |
21578 |
my $bug = eval { _getBugNumber() } || 0; |
21579 |
warn $@ if $@; |
21580 |
my $atomicUpdate = Koha::AtomicUpdater->find( $bug ); |
21581 |
return 0 if $atomicUpdate; |
21582 |
|
21564 |
my ($proposed_version) = @_; |
21583 |
my ($proposed_version) = @_; |
21565 |
my $version_number = TransformToNum($proposed_version); |
21584 |
my $version_number = TransformToNum($proposed_version); |
21566 |
|
21585 |
|
Lines 21577-21580
sub CheckVersion {
Link Here
|
21577 |
} |
21596 |
} |
21578 |
} |
21597 |
} |
21579 |
|
21598 |
|
|
|
21599 |
my $skipped = 0; |
21600 |
sub _getBugNumber { |
21601 |
my $skip = 100; |
21602 |
return 0 if $skip >= ++$skipped; |
21603 |
require File::Slurp; |
21604 |
my ($package, $filename, $line) = caller(2); #Get the second caller from the stack trace |
21605 |
my $updatedatabase = File::Slurp::read_file(__FILE__, binmode => ':utf8', array_ref => 1); |
21606 |
|
21607 |
my ($err, @err); |
21608 |
|
21609 |
my $linePointer = $line; |
21610 |
##Look for the block-ending '}' |
21611 |
do { |
21612 |
$linePointer+=1; |
21613 |
} while ($updatedatabase->[$linePointer] !~ /^\}/); |
21614 |
my $blockEndLine = $linePointer; |
21615 |
|
21616 |
|
21617 |
##Look for 'SetVersion', fail if it is missing, just for safety's sake. |
21618 |
($err, @err) = (undef, undef); |
21619 |
my $getSetVersion = sub { |
21620 |
my $i = shift; |
21621 |
unless ($updatedatabase->[$i] =~ /^\s{2,5}SetVersion ?\( ?\$DBversion ?\);\s+$/) { |
21622 |
return "_getBugNumber():> Line: $i: Malformed SetVersion. Unsafe to proceed.\n".$updatedatabase->[$i]; |
21623 |
} |
21624 |
return undef; |
21625 |
}; |
21626 |
foreach my $step (1..5) { |
21627 |
$err = &$getSetVersion($blockEndLine-$step); |
21628 |
last unless $err; |
21629 |
push(@err, $err); |
21630 |
} |
21631 |
die join("",@err) if $err; |
21632 |
|
21633 |
|
21634 |
##Look for 'Upgrade done'-message |
21635 |
($err, @err) = (undef, undef); |
21636 |
my $getUpgradeMsg = sub { |
21637 |
my $i = shift; |
21638 |
unless ($updatedatabase->[$i] =~ /print "Upgraded? to \$DBversion done/ || |
21639 |
$updatedatabase->[$i] =~ /print "Upgrade done \(/ ) { |
21640 |
return "_getBugNumber():> Line: $i: Malformed Bug message. Unsafe to proceed.\n".$updatedatabase->[$i]; |
21641 |
} |
21642 |
return undef; |
21643 |
}; |
21644 |
$linePointer = $blockEndLine; |
21645 |
foreach my $step ((1..5)) { |
21646 |
$err = &$getUpgradeMsg( --$linePointer ); |
21647 |
last unless $err; |
21648 |
push(@err, $err); |
21649 |
} |
21650 |
die join("",@err) if $err; |
21651 |
|
21652 |
if ($updatedatabase->[$linePointer] =~ /Bug (\d{4,5})/) { |
21653 |
return $1; |
21654 |
} |
21655 |
die "_getBugNumber():> Failed for line '$line' looking at row:\n".$updatedatabase->[$linePointer]; |
21656 |
} |
21657 |
|
21580 |
exit; |
21658 |
exit; |
21581 |
- |
|
|