|
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 |
- |
|
|