View | Details | Raw Unified | Return to bug 14698
Collapse All | Expand All

(-)a/installer/data/mysql/updatedatabase.pl (-16 / +93 lines)
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
- 

Return to bug 14698