|
Lines 19-28
package C4::Installer;
Link Here
|
| 19 |
|
19 |
|
| 20 |
use Modern::Perl; |
20 |
use Modern::Perl; |
| 21 |
|
21 |
|
| 22 |
use Encode; |
22 |
use Try::Tiny; |
|
|
23 |
use Encode qw( encode is_utf8 ); |
| 23 |
use DBIx::RunSQL; |
24 |
use DBIx::RunSQL; |
| 24 |
use YAML::XS; |
25 |
use YAML::XS; |
| 25 |
use C4::Context; |
26 |
use C4::Context; |
|
|
27 |
use Koha::Schema; |
| 26 |
use DBI; |
28 |
use DBI; |
| 27 |
use Koha; |
29 |
use Koha; |
| 28 |
|
30 |
|
|
Lines 30-36
use vars qw(@ISA @EXPORT);
Link Here
|
| 30 |
BEGIN { |
32 |
BEGIN { |
| 31 |
require Exporter; |
33 |
require Exporter; |
| 32 |
@ISA = qw( Exporter ); |
34 |
@ISA = qw( Exporter ); |
| 33 |
push @EXPORT, qw( primary_key_exists foreign_key_exists index_exists column_exists TableExists marc_framework_sql_list); |
35 |
push @EXPORT, qw( primary_key_exists foreign_key_exists index_exists column_exists TableExists marc_framework_sql_list TransformToNum CheckVersion sanitize_zero_date update get_db_entries ); |
| 34 |
}; |
36 |
}; |
| 35 |
|
37 |
|
| 36 |
=head1 NAME |
38 |
=head1 NAME |
|
Lines 683-688
sub TableExists { # Could be renamed table_exists for consistency
Link Here
|
| 683 |
return 0; |
685 |
return 0; |
| 684 |
} |
686 |
} |
| 685 |
|
687 |
|
|
|
688 |
sub version_from_file { |
| 689 |
my $file = shift; |
| 690 |
return unless $file =~ m|(^\|/)(\d{2})(\d{2})(\d{2})(\d{3}).pl$|; |
| 691 |
return sprintf "%s.%s.%s.%s", $2, $3, $4, $5; |
| 692 |
} |
| 693 |
|
| 694 |
sub get_db_entries { |
| 695 |
my $db_revs_dir = C4::Context->config('intranetdir') . '/installer/data/mysql/db_revs'; |
| 696 |
opendir my $dh, $db_revs_dir or die "Cannot open $db_revs_dir dir ($!)"; |
| 697 |
my @files = sort grep { m|\.pl$| && ! m|skeleton\.pl$| } readdir $dh; |
| 698 |
my @need_update; |
| 699 |
for my $file ( @files ) { |
| 700 |
my $version = version_from_file( $file ); |
| 701 |
|
| 702 |
unless ( $version ) { |
| 703 |
warn "Invalid db_rev found: " . $file; |
| 704 |
next |
| 705 |
} |
| 706 |
|
| 707 |
next unless CheckVersion( $version ); |
| 708 |
|
| 709 |
push @need_update, sprintf( "%s/%s", $db_revs_dir, $file ); |
| 710 |
} |
| 711 |
return \@need_update; |
| 712 |
} |
| 713 |
|
| 714 |
sub update { |
| 715 |
my ( $files, $params ) = @_; |
| 716 |
|
| 717 |
my $force = $params->{force} || 0; |
| 718 |
|
| 719 |
my $schema = Koha::Database->new->schema; |
| 720 |
my ( @done, @errors ); |
| 721 |
for my $file ( @$files ) { |
| 722 |
|
| 723 |
my $db_rev = do $file; |
| 724 |
|
| 725 |
my $error; |
| 726 |
|
| 727 |
try { |
| 728 |
$schema->txn_do( |
| 729 |
sub { |
| 730 |
$db_rev->{up}->(); |
| 731 |
} |
| 732 |
); |
| 733 |
} catch { |
| 734 |
$error = $_; |
| 735 |
}; |
| 736 |
|
| 737 |
my $db_entry = { |
| 738 |
bug_number => $db_rev->{bug_number}, |
| 739 |
description => ( ref $db_rev->{description} eq 'CODE' ) |
| 740 |
? $db_rev->{description}->() |
| 741 |
: $db_rev->{description}, |
| 742 |
version => version_from_file($file), |
| 743 |
time => POSIX::strftime( "%H:%M:%S", localtime ), |
| 744 |
}; |
| 745 |
$db_entry->{output} = output_version( { %$db_entry, done => !$error } ); |
| 746 |
|
| 747 |
if ( $error ) { |
| 748 |
push @errors, { %$db_entry, error => $error }; |
| 749 |
$force ? next : last ; |
| 750 |
# We stop the update if an error occurred! |
| 751 |
} |
| 752 |
|
| 753 |
SetVersion($db_entry->{version}); |
| 754 |
push @done, $db_entry; |
| 755 |
} |
| 756 |
return { success => \@done, error => \@errors }; |
| 757 |
} |
| 758 |
|
| 759 |
sub output_version { |
| 760 |
my ( $db_entry ) = @_; |
| 761 |
|
| 762 |
my $descriptions = $db_entry->{description}; |
| 763 |
my $DBversion = $db_entry->{version}; |
| 764 |
my $bug_number = $db_entry->{bug_number}; |
| 765 |
my $time = $db_entry->{time}; |
| 766 |
my $done = $db_entry->{done} ? "done" : "failed"; |
| 767 |
|
| 768 |
unless ( ref($descriptions) ) { |
| 769 |
$descriptions = [ $descriptions ]; |
| 770 |
} |
| 771 |
|
| 772 |
my $first = 1; |
| 773 |
my @output; |
| 774 |
for my $description ( @$descriptions ) { |
| 775 |
if ( @$descriptions > 1 ) { |
| 776 |
if ( $first ) { |
| 777 |
unless ( $bug_number ) { |
| 778 |
push @output, sprintf "Upgrade to %s %s [%s]:", $DBversion, $done, $time; |
| 779 |
} else { |
| 780 |
push @output, sprintf "Upgrade to %s %s [%s]: Bug %5s", $DBversion, $done, $time, $bug_number; |
| 781 |
} |
| 782 |
} |
| 783 |
push @output, sprintf "\t\t\t\t\t\t - %s", $description; |
| 784 |
} else { |
| 785 |
unless ( $bug_number ) { |
| 786 |
push @output, sprintf "Upgrade to %s %s [%s]: %s", $DBversion, $done, $time, $description; |
| 787 |
} else { |
| 788 |
push @output, sprintf "Upgrade to %s %s [%s]: Bug %5s - %s", $DBversion, $done, $time, $bug_number, $description; |
| 789 |
} |
| 790 |
} |
| 791 |
$first = 0; |
| 792 |
} |
| 793 |
return \@output; |
| 794 |
} |
| 795 |
|
| 796 |
=head2 DropAllForeignKeys($table) |
| 797 |
|
| 798 |
Drop all foreign keys of the table $table |
| 799 |
|
| 800 |
=cut |
| 801 |
|
| 802 |
sub DropAllForeignKeys { |
| 803 |
my ($table) = @_; |
| 804 |
# get the table description |
| 805 |
my $dbh = C4::Context->dbh; |
| 806 |
my $sth = $dbh->prepare("SHOW CREATE TABLE $table"); |
| 807 |
$sth->execute; |
| 808 |
my $vsc_structure = $sth->fetchrow; |
| 809 |
# split on CONSTRAINT keyword |
| 810 |
my @fks = split /CONSTRAINT /,$vsc_structure; |
| 811 |
# parse each entry |
| 812 |
foreach (@fks) { |
| 813 |
# isolate what is before FOREIGN KEY, if there is something, it's a foreign key to drop |
| 814 |
$_ = /(.*) FOREIGN KEY.*/; |
| 815 |
my $id = $1; |
| 816 |
if ($id) { |
| 817 |
# we have found 1 foreign, drop it |
| 818 |
$dbh->do("ALTER TABLE $table DROP FOREIGN KEY $id"); |
| 819 |
$id=""; |
| 820 |
} |
| 821 |
} |
| 822 |
} |
| 823 |
|
| 824 |
|
| 825 |
=head2 TransformToNum |
| 826 |
|
| 827 |
Transform the Koha version from a 4 parts string |
| 828 |
to a number, with just 1 . |
| 829 |
|
| 830 |
=cut |
| 831 |
|
| 832 |
sub TransformToNum { |
| 833 |
my $version = shift; |
| 834 |
# remove the 3 last . to have a Perl number |
| 835 |
$version =~ s/(.*\..*)\.(.*)\.(.*)/$1$2$3/; |
| 836 |
# three X's at the end indicate that you are testing patch with dbrev |
| 837 |
# change it into 999 |
| 838 |
# prevents error on a < comparison between strings (should be: lt) |
| 839 |
$version =~ s/XXX$/999/; |
| 840 |
return $version; |
| 841 |
} |
| 842 |
|
| 843 |
=head2 SetVersion |
| 844 |
|
| 845 |
set the DBversion in the systempreferences |
| 846 |
|
| 847 |
=cut |
| 848 |
|
| 849 |
sub SetVersion { |
| 850 |
return if $_[0]=~ /XXX$/; |
| 851 |
#you are testing a patch with a db revision; do not change version |
| 852 |
my $kohaversion = TransformToNum($_[0]); |
| 853 |
my $dbh = C4::Context->dbh; |
| 854 |
if (C4::Context->preference('Version')) { |
| 855 |
my $finish=$dbh->prepare("UPDATE systempreferences SET value=? WHERE variable='Version'"); |
| 856 |
$finish->execute($kohaversion); |
| 857 |
} else { |
| 858 |
my $finish=$dbh->prepare("INSERT into systempreferences (variable,value,explanation) values ('Version',?,'The Koha database version. WARNING: Do not change this value manually, it is maintained by the webinstaller')"); |
| 859 |
$finish->execute($kohaversion); |
| 860 |
} |
| 861 |
C4::Context::clear_syspref_cache(); # invalidate cached preferences |
| 862 |
} |
| 863 |
|
| 864 |
sub NewVersion { |
| 865 |
# void FIXME replace me |
| 866 |
} |
| 867 |
|
| 868 |
=head2 CheckVersion |
| 869 |
|
| 870 |
Check whether a given update should be run when passed the proposed version |
| 871 |
number. The update will always be run if the proposed version is greater |
| 872 |
than the current database version and less than or equal to the version in |
| 873 |
kohaversion.pl. The update is also run if the version contains XXX, though |
| 874 |
this behavior will be changed following the adoption of non-linear updates |
| 875 |
as implemented in bug 7167. |
| 876 |
|
| 877 |
=cut |
| 878 |
|
| 879 |
sub CheckVersion { |
| 880 |
my ($proposed_version) = @_; |
| 881 |
my $version_number = TransformToNum($proposed_version); |
| 882 |
|
| 883 |
# The following line should be deleted when bug 7167 is pushed |
| 884 |
return 1 if ( $proposed_version =~ m/XXX/ ); |
| 885 |
|
| 886 |
if ( C4::Context->preference("Version") < $version_number |
| 887 |
&& $version_number <= TransformToNum( $Koha::VERSION ) ) |
| 888 |
{ |
| 889 |
return 1; |
| 890 |
} |
| 891 |
|
| 892 |
return 0; |
| 893 |
} |
| 894 |
|
| 895 |
sub sanitize_zero_date { |
| 896 |
my ( $table_name, $column_name ) = @_; |
| 897 |
|
| 898 |
my $dbh = C4::Context->dbh; |
| 899 |
|
| 900 |
my (undef, $datatype) = $dbh->selectrow_array(qq| |
| 901 |
SHOW COLUMNS FROM $table_name WHERE Field = ?|, undef, $column_name); |
| 902 |
|
| 903 |
if ( $datatype eq 'date' ) { |
| 904 |
$dbh->do(qq| |
| 905 |
UPDATE $table_name |
| 906 |
SET $column_name = NULL |
| 907 |
WHERE CAST($column_name AS CHAR(10)) = '0000-00-00'; |
| 908 |
|); |
| 909 |
} else { |
| 910 |
$dbh->do(qq| |
| 911 |
UPDATE $table_name |
| 912 |
SET $column_name = NULL |
| 913 |
WHERE CAST($column_name AS CHAR(19)) = '0000-00-00 00:00:00'; |
| 914 |
|); |
| 915 |
} |
| 916 |
} |
| 686 |
|
917 |
|
| 687 |
=head1 AUTHOR |
918 |
=head1 AUTHOR |
| 688 |
|
919 |
|