|
Lines 23-38
use Try::Tiny;
Link Here
|
| 23 |
use Encode qw( encode decode is_utf8 ); |
23 |
use Encode qw( encode decode is_utf8 ); |
| 24 |
use DBIx::RunSQL; |
24 |
use DBIx::RunSQL; |
| 25 |
use YAML::XS; |
25 |
use YAML::XS; |
|
|
26 |
use File::Slurp qw( read_file ); |
| 27 |
use DBI; |
| 28 |
|
| 26 |
use C4::Context; |
29 |
use C4::Context; |
| 27 |
use Koha::Schema; |
30 |
use Koha::Schema; |
| 28 |
use DBI; |
|
|
| 29 |
use Koha; |
31 |
use Koha; |
| 30 |
|
32 |
|
| 31 |
use vars qw(@ISA @EXPORT); |
33 |
use vars qw(@ISA @EXPORT); |
| 32 |
BEGIN { |
34 |
BEGIN { |
| 33 |
require Exporter; |
35 |
require Exporter; |
| 34 |
@ISA = qw( Exporter ); |
36 |
@ISA = qw( Exporter ); |
| 35 |
push @EXPORT, qw( primary_key_exists foreign_key_exists index_exists column_exists TableExists TransformToNum CheckVersion NewVersion SetVersion sanitize_zero_date update get_db_entries ); |
37 |
push @EXPORT, qw( primary_key_exists foreign_key_exists index_exists column_exists TableExists TransformToNum CheckVersion NewVersion SetVersion sanitize_zero_date update get_db_entries get_atomic_updates run_atomic_updates ); |
| 36 |
}; |
38 |
}; |
| 37 |
|
39 |
|
| 38 |
=head1 NAME |
40 |
=head1 NAME |
|
Lines 711-754
sub get_db_entries {
Link Here
|
| 711 |
return \@need_update; |
713 |
return \@need_update; |
| 712 |
} |
714 |
} |
| 713 |
|
715 |
|
|
|
716 |
sub run_db_rev { |
| 717 |
my ($file) = @_; |
| 718 |
|
| 719 |
my $db_rev = do $file; |
| 720 |
|
| 721 |
my $error; |
| 722 |
my $out = ''; |
| 723 |
open my $outfh, '>', \$out; |
| 724 |
try { |
| 725 |
my $schema = Koha::Database->new->schema; |
| 726 |
$schema->txn_do( |
| 727 |
sub { |
| 728 |
$db_rev->{up}->( { dbh => $schema->storage->dbh, out => $outfh } ); |
| 729 |
} |
| 730 |
); |
| 731 |
} |
| 732 |
catch { |
| 733 |
$error = $_; |
| 734 |
}; |
| 735 |
|
| 736 |
close $outfh; |
| 737 |
$out = decode( 'UTF-8', $out ); |
| 738 |
|
| 739 |
my $db_entry = { |
| 740 |
filepath => $file, |
| 741 |
bug_number => $db_rev->{bug_number}, |
| 742 |
description => $db_rev->{description}, |
| 743 |
exec_output => $out, |
| 744 |
version => scalar version_from_file($file), |
| 745 |
time => POSIX::strftime( "%H:%M:%S", localtime ), |
| 746 |
error => $error |
| 747 |
}; |
| 748 |
$db_entry->{output} = generate_output_db_entry($db_entry, $out); |
| 749 |
return $db_entry; |
| 750 |
} |
| 751 |
|
| 714 |
sub update { |
752 |
sub update { |
| 715 |
my ( $files, $params ) = @_; |
753 |
my ( $files, $params ) = @_; |
| 716 |
|
754 |
|
| 717 |
my $force = $params->{force} || 0; |
755 |
my $force = $params->{force} || 0; |
| 718 |
|
756 |
|
| 719 |
my $schema = Koha::Database->new->schema; |
|
|
| 720 |
my ( @done, @errors ); |
757 |
my ( @done, @errors ); |
| 721 |
for my $file ( @$files ) { |
758 |
for my $file ( @$files ) { |
| 722 |
|
759 |
|
| 723 |
my $db_rev = do $file; |
760 |
my $db_entry = run_db_rev($file); |
| 724 |
|
|
|
| 725 |
my $error; |
| 726 |
|
| 727 |
my $out = ''; |
| 728 |
open my $outfh, '>', \$out; |
| 729 |
try { |
| 730 |
$schema->txn_do( |
| 731 |
sub { |
| 732 |
$db_rev->{up}->({ dbh => $schema->storage->dbh, out => $outfh }); |
| 733 |
} |
| 734 |
); |
| 735 |
} catch { |
| 736 |
$error = $_; |
| 737 |
}; |
| 738 |
|
| 739 |
close $outfh; |
| 740 |
$out = decode('UTF-8', $out); |
| 741 |
|
| 742 |
my $db_entry = { |
| 743 |
bug_number => $db_rev->{bug_number}, |
| 744 |
description => $db_rev->{description}, |
| 745 |
version => version_from_file($file), |
| 746 |
time => POSIX::strftime( "%H:%M:%S", localtime ), |
| 747 |
}; |
| 748 |
$db_entry->{output} = output_version( { %$db_entry, done => !$error, report => $out } ); |
| 749 |
|
761 |
|
| 750 |
if ( $error ) { |
762 |
if ( $db_entry->{error} ) { |
| 751 |
push @errors, { %$db_entry, error => $error }; |
763 |
push @errors, $db_entry; |
| 752 |
$force ? next : last ; |
764 |
$force ? next : last ; |
| 753 |
# We stop the update if an error occurred! |
765 |
# We stop the update if an error occurred! |
| 754 |
} |
766 |
} |
|
Lines 759-788
sub update {
Link Here
|
| 759 |
return { success => \@done, error => \@errors }; |
771 |
return { success => \@done, error => \@errors }; |
| 760 |
} |
772 |
} |
| 761 |
|
773 |
|
| 762 |
sub output_version { |
774 |
sub generate_output_db_entry { |
| 763 |
my ( $db_entry ) = @_; |
775 |
my ( $db_entry ) = @_; |
| 764 |
|
776 |
|
| 765 |
my $description = $db_entry->{description}; |
777 |
my $description = $db_entry->{description}; |
| 766 |
my $report = $db_entry->{report}; |
778 |
my $output = $db_entry->{output}; |
| 767 |
my $DBversion = $db_entry->{version}; |
779 |
my $DBversion = $db_entry->{version}; |
| 768 |
my $bug_number = $db_entry->{bug_number}; |
780 |
my $bug_number = $db_entry->{bug_number}; |
| 769 |
my $time = $db_entry->{time}; |
781 |
my $time = $db_entry->{time}; |
| 770 |
my $done = defined $db_entry->{done} |
782 |
my $exec_output = $db_entry->{exec_output}; |
| 771 |
? $db_entry->{done} |
783 |
my $done = defined $db_entry->{done} |
| 772 |
? " done" |
784 |
? $db_entry->{done} |
| 773 |
: " failed" |
785 |
? " done" |
| 774 |
: ""; # For old versions, we don't know if we succeed or failed |
786 |
: " failed" |
|
|
787 |
: ""; # For old versions, we don't know if we succeed or failed |
| 775 |
|
788 |
|
| 776 |
my @output; |
789 |
my @output; |
| 777 |
|
790 |
|
| 778 |
if ($bug_number) { |
791 |
if ( $DBversion ) { |
| 779 |
push @output, sprintf('Upgrade to %s %s [%s]: Bug %5s - %s', $DBversion, $done, $time, $bug_number, $description); |
792 |
if ($bug_number) { |
| 780 |
} else { |
793 |
push @output, sprintf('Upgrade to %s %s [%s]: Bug %5s - %s', $DBversion, $done, $time, $bug_number, $description); |
| 781 |
push @output, sprintf('Upgrade to %s %s [%s]: %s', $DBversion, $done, $time, $description); |
794 |
} else { |
|
|
795 |
push @output, sprintf('Upgrade to %s %s [%s]: %s', $DBversion, $done, $time, $description); |
| 796 |
} |
| 797 |
} else { # Atomic update |
| 798 |
if ($bug_number) { |
| 799 |
push @output, sprintf('DEV atomic update %s %s [%s]: Bug %5s - %s', $db_entry->{filepath}, $done, $time, $bug_number, $description); |
| 800 |
} else { # Old atomic update syntax |
| 801 |
push @output, sprintf('DEV atomic update %s %s [%s]', $db_entry->{filepath}, $done, $time); |
| 802 |
} |
| 782 |
} |
803 |
} |
| 783 |
|
804 |
|
| 784 |
if ($report) { |
805 |
if ($exec_output) { |
| 785 |
foreach my $line (split /\n/, $report) { |
806 |
foreach my $line (split /\n/, $exec_output) { |
| 786 |
push @output, sprintf "\t\t\t\t\t\t - %s", $line; |
807 |
push @output, sprintf "\t\t\t\t\t\t - %s", $line; |
| 787 |
} |
808 |
} |
| 788 |
} |
809 |
} |
|
Lines 790-795
sub output_version {
Link Here
|
| 790 |
return \@output; |
811 |
return \@output; |
| 791 |
} |
812 |
} |
| 792 |
|
813 |
|
|
|
814 |
sub get_atomic_updates { |
| 815 |
my @atomic_upate_files; |
| 816 |
# if there is anything in the atomicupdate, read and execute it. |
| 817 |
my $update_dir = C4::Context->config('intranetdir') . '/installer/data/mysql/atomicupdate/'; |
| 818 |
opendir( my $dirh, $update_dir ); |
| 819 |
foreach my $file ( sort readdir $dirh ) { |
| 820 |
next if $file !~ /\.(perl|pl)$/; #skip other files |
| 821 |
next if $file eq 'skeleton.perl' || $file eq 'skeleton.pl'; # skip the skeleton files |
| 822 |
|
| 823 |
push @atomic_upate_files, $file; |
| 824 |
} |
| 825 |
return \@atomic_upate_files; |
| 826 |
} |
| 827 |
|
| 828 |
sub run_atomic_updates { |
| 829 |
my ( $files ) = @_; |
| 830 |
|
| 831 |
my $update_dir = C4::Context->config('intranetdir') . '/installer/data/mysql/atomicupdate/'; |
| 832 |
my ( @done, @errors ); |
| 833 |
for my $file ( @$files ) { |
| 834 |
my $filepath = $update_dir . $file; |
| 835 |
|
| 836 |
my $atomic_update; |
| 837 |
if ( $file =~ m{\.perl$} ) { |
| 838 |
my $code = read_file( $filepath ); |
| 839 |
my ( $out, $err ) = ('', ''); |
| 840 |
{ |
| 841 |
open my $oldout, ">&STDOUT"; |
| 842 |
close STDOUT; |
| 843 |
open STDOUT,'>:encoding(utf8)', \$out; |
| 844 |
my $DBversion = Koha::version; # We need $DBversion and $dbh for the eval |
| 845 |
my $dbh = C4::Context->dbh; |
| 846 |
eval $code; ## no critic (StringyEval) |
| 847 |
$err = $@; |
| 848 |
warn $err if $err; |
| 849 |
close STDOUT; |
| 850 |
open STDOUT, ">&", $oldout; |
| 851 |
} |
| 852 |
|
| 853 |
$atomic_update = { |
| 854 |
filepath => $filepath, |
| 855 |
description => '', |
| 856 |
version => undef, |
| 857 |
time => POSIX::strftime( "%H:%M:%S", localtime ), |
| 858 |
}; |
| 859 |
|
| 860 |
|
| 861 |
$atomic_update->{output} = |
| 862 |
$out |
| 863 |
? [ split "\n", $out ] |
| 864 |
: generate_output_db_entry($atomic_update); # There wad an error, we didn't reach NewVersion) |
| 865 |
|
| 866 |
$atomic_update->{error} = $err if $err; |
| 867 |
} elsif ( $file =~ m{\.pl$} ) { |
| 868 |
$atomic_update = run_db_rev($filepath); |
| 869 |
} else { |
| 870 |
warn "Atomic update must be .perl or .pl ($file)"; |
| 871 |
} |
| 872 |
|
| 873 |
if ( $atomic_update->{error} ) { |
| 874 |
push @errors, $atomic_update; |
| 875 |
} else { |
| 876 |
push @done, $atomic_update; |
| 877 |
} |
| 878 |
} |
| 879 |
|
| 880 |
return { success => \@done, error => \@errors }; |
| 881 |
} |
| 882 |
|
| 793 |
=head2 DropAllForeignKeys($table) |
883 |
=head2 DropAllForeignKeys($table) |
| 794 |
|
884 |
|
| 795 |
Drop all foreign keys of the table $table |
885 |
Drop all foreign keys of the table $table |
|
Lines 874-880
sub NewVersion {
Link Here
|
| 874 |
$description = $descriptions; |
964 |
$description = $descriptions; |
| 875 |
} |
965 |
} |
| 876 |
|
966 |
|
| 877 |
my $output = output_version( { |
967 |
my $output = generate_output_db_entry( { |
| 878 |
bug_number => $bug_number, |
968 |
bug_number => $bug_number, |
| 879 |
description => $description, |
969 |
description => $description, |
| 880 |
report => $report, |
970 |
report => $report, |