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