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