@@ -, +, @@ --- C4/Auth.pm | 84 ++------- C4/Config/File/YAML.pm | 60 ++++++ C4/Installer.pm | 19 ++- C4/Update/Database.pm | 196 +++++++++++++++++--- about.pl | 2 +- installer/data/mysql/kohastructure.sql | 21 ++ koha-tmpl/intranet-tmpl/prog/en/modules/about.tt | 2 +- .../prog/en/modules/admin/updatedatabase.tt | 2 +- 8 files changed, 284 insertions(+), 102 deletions(-) create mode 100644 C4/Config/File/YAML.pm --- a/C4/Auth.pm +++ a/C4/Auth.pm @@ -35,7 +35,7 @@ use POSIX qw/strftime/; use List::MoreUtils qw/ any /; # use utf8; -use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $debug $ldap $cas $caslogout $servers $memcached); +use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $debug $ldap $cas $caslogout $servers $memcached); BEGIN { sub psgi_env { any { /^psgi\./ } keys %ENV } @@ -44,7 +44,6 @@ BEGIN { else { exit } } - $VERSION = 3.02; # set version for version checking $debug = $ENV{DEBUG}; @ISA = qw(Exporter); @EXPORT = qw(&checkauth &get_template_and_user &haspermission &get_user_subpermissions); @@ -580,49 +579,6 @@ has authenticated. =cut -sub _version_check ($$) { - my $type = shift; - my $query = shift; - my $version; - # If Version syspref is unavailable, it means Koha is beeing installed, - # and so we must redirect to OPAC maintenance page or to the WebInstaller - # also, if OpacMaintenance is ON, OPAC should redirect to maintenance - if (C4::Context->preference('OpacMaintenance') && $type eq 'opac') { - warn "OPAC Install required, redirecting to maintenance"; - print $query->redirect("/cgi-bin/koha/maintenance.pl"); - } - unless ( $version = C4::Context->preference('Version') ) { # assignment, not comparison - if ( $type ne 'opac' ) { - warn "Install required, redirecting to Installer"; - print $query->redirect("/cgi-bin/koha/installer/install.pl"); - } else { - warn "OPAC Install required, redirecting to maintenance"; - print $query->redirect("/cgi-bin/koha/maintenance.pl"); - } - safe_exit; - } - - # check that database and koha version are the same - # there is no DB version, it's a fresh install, - # go to web installer - # there is a DB version, compare it to the code version - my $kohaversion=C4::Context::KOHAVERSION; - # remove the 3 last . to have a Perl number - $kohaversion =~ s/(.*\..*)\.(.*)\.(.*)/$1$2$3/; - $debug and print STDERR "kohaversion : $kohaversion\n"; - if ($version < $kohaversion){ - my $warning = "Database update needed, redirecting to %s. Database is $version and Koha is $kohaversion"; - if ($type ne 'opac'){ - warn sprintf($warning, 'Installer'); - print $query->redirect("/cgi-bin/koha/installer/install.pl?step=3"); - } else { - warn sprintf("OPAC: " . $warning, 'maintenance'); - print $query->redirect("/cgi-bin/koha/maintenance.pl"); - } - safe_exit; - } -} - sub _session_log { (@_) or return 0; open L, ">>/tmp/sessionlog" or warn "ERROR: Cannot append to /tmp/sessionlog"; @@ -646,8 +602,18 @@ sub checkauth { $timeout = $1 * 86400; }; $timeout = 600 unless $timeout; + # check we have a Version. Otherwise => go to installer + unless ( C4::Context->preference('Version') ) { # assignment, not comparison + if ( $type ne 'opac' ) { + warn "Install required, redirecting to Installer"; + print $query->redirect("/cgi-bin/koha/installer/install.pl"); + } else { + warn "OPAC Install required, redirecting to maintenance"; + print $query->redirect("/cgi-bin/koha/maintenance.pl"); + } + safe_exit; + } - _version_check($type,$query); # state variables my $loggedin = 0; my %info; @@ -1089,19 +1055,6 @@ sub check_api_auth { my $timeout = C4::Context->preference('timeout'); $timeout = 600 unless $timeout; - unless (C4::Context->preference('Version')) { - # database has not been installed yet - return ("maintenance", undef, undef); - } - my $kohaversion=C4::Context::KOHAVERSION; - $kohaversion =~ s/(.*\..*)\.(.*)\.(.*)/$1$2$3/; - if (C4::Context->preference('Version') < $kohaversion) { - # database in need of version update; assume that - # no API should be called while databsae is in - # this condition. - return ("maintenance", undef, undef); - } - # FIXME -- most of what follows is a copy-and-paste # of code from checkauth. There is an obvious need # for refactoring to separate the various parts of @@ -1322,19 +1275,6 @@ sub check_cookie_auth { my $timeout = C4::Context->preference('timeout'); $timeout = 600 unless $timeout; - unless (C4::Context->preference('Version')) { - # database has not been installed yet - return ("maintenance", undef); - } - my $kohaversion=C4::Context::KOHAVERSION; - $kohaversion =~ s/(.*\..*)\.(.*)\.(.*)/$1$2$3/; - if (C4::Context->preference('Version') < $kohaversion) { - # database in need of version update; assume that - # no API should be called while databsae is in - # this condition. - return ("maintenance", undef); - } - # FIXME -- most of what follows is a copy-and-paste # of code from checkauth. There is an obvious need # for refactoring to separate the various parts of --- a/C4/Config/File/YAML.pm +++ a/C4/Config/File/YAML.pm @@ -0,0 +1,60 @@ +package C4::Config::File::YAML; +# Copyright 2011 BibLibre +# +# This file is part of Koha. +# +# Koha is free software; you can redistribute it and/or modify it under the +# terms of the GNU General Public License as published by the Free Software +# Foundation; either version 2 of the License, or (at your option) any later +# version. +# +# Koha is distributed in the hope that it will be useful, but WITHOUT ANY +# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR +# A PARTICULAR PURPOSE. See the GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License along +# with Koha; if not, write to the Free Software Foundation, Inc., +# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. + +use Modern::Perl; +use YAML; + +sub _fileload{ + my ($filename)=shift; + return YAML::LoadFile($filename); +} + +sub _dirload{ + my $dirname=shift; + my $result; + opendir D, $dirname; + for my $name (readdir(D)){ + next if $name=~/^\./; + if (-d $name){ + $result->{$name}=_dirload($dirname."/".$name); + } + if ((-e $dirname."/".$name) and ($name=~/\.ya?ml/) ){ + $result=($result + ? [%$result,%{_fileload($dirname."/".$name)}] + : _fileload($dirname."/".$name)); + } + } + close D; + return $result; +} + + +sub new{ + my $config; + my $self=shift; + my $name=shift; + if (-f $name){ + $config=_fileload($name); + } + if (-d $name){ + $config->{$name}=_dirload($name); + } + return $config; +} +1; + --- a/C4/Installer.pm +++ a/C4/Installer.pm @@ -22,6 +22,7 @@ use strict; our $VERSION = 3.00; use C4::Context; +use C4::Update::Database; use C4::Installer::PerlModules 1.000000; =head1 NAME @@ -466,10 +467,20 @@ Koha software version. sub set_version_syspref { my $self = shift; - - my $kohaversion=C4::Context::KOHAVERSION; - # remove the 3 last . to have a Perl number - $kohaversion =~ s/(.*\..*)\.(.*)\.(.*)/$1$2$3/; + # get all updatedatabase, and mark them as passed, as it's a fresh install + my $versions = C4::Update::Database::list_versions_availables(); + my $kohaversion=0; + for my $v ( @$versions ) { + my $queries; + $queries->{queries} = ["initial setup"]; + $queries->{comments} = ["initial setup"]; + C4::Update::Database::set_infos($v,$queries,undef,undef); + # remove the 3 last . to have a Perl number + $v =~ s/(.*\..*)\.(.*)\.(.*)/$1$2$3/; + if ($v>$kohaversion) { + $kohaversion = $v; + } + } if (C4::Context->preference('Version')) { warn "UPDATE Version"; my $finish=$self->{'dbh'}->prepare("UPDATE systempreferences SET value=? WHERE variable='Version'"); --- a/C4/Update/Database.pm +++ a/C4/Update/Database.pm @@ -1,5 +1,22 @@ package C4::Update::Database; +# Copyright 2011 BibLibre +# +# This file is part of Koha. +# +# Koha is free software; you can redistribute it and/or modify it under the +# terms of the GNU General Public License as published by the Free Software +# Foundation; either version 2 of the License, or (at your option) any later +# version. +# +# Koha is distributed in the hope that it will be useful, but WITHOUT ANY +# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR +# A PARTICULAR PURPOSE. See the GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License along +# with Koha; if not, write to the Free Software Foundation, Inc., +# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. + use Modern::Perl; use C4::Context; @@ -9,7 +26,20 @@ use File::Basename; use Digest::MD5; use List::MoreUtils qw/uniq/; -my $config = C4::Config::File::YAML->new( C4::Context->config("installdir") . qq{/etc/update/database/config.yaml} ); +=head1 NAME + +C4::Update::Database.pm + +=head1 SYNOPSIS + + use C4::Update::Database; + + This package is used by admin/updatedatabase.pl, to manage DB updates + +=head1 FUNCTIONS + +=cut +my $config = C4::Config::File::YAML->new( C4::Context->config("intranetdir") . qq{/etc/update/database/config.yaml} ); my $VERSIONS_PATH = C4::Context->config('intranetdir') . '/' . $config->{versions_dir}; my $version; @@ -17,16 +47,30 @@ my $list; my $dbh = C4::Context->dbh; +=head2 + + my $file = get_filepath($version); + this sub will return the full path of a given DB update number + +=cut + sub get_filepath { my ( $version ) = @_; my @files = <$VERSIONS_PATH/$version*>; if ( scalar @files != 1 ) { - die "This version ($version) returned more than one file (or any) corresponding!"; + die "This version ($version) returned has ".scalar @files." corresponding, need only 1"; } return $files[0]; } +=head2 get_md5 + + my $md5 = get_md5($filepath) + returns the md5sum of the selected file. + This is used to check consistency of updates + +=cut sub get_md5 { my ( $filepath ) = @_; open(FILE, $filepath); @@ -38,6 +82,17 @@ sub get_md5 { return $md5; } +=head2 execute_version + + $result = execute_version($version_number); + Execute an update. + This sub will detect if the number is made through a .pl or a .sql, and behave accordingly + if there is more than 1 file with the same number, an error will be issued + if you try to execute a version_number that has already be executed, then it will also issue an error + the sub return an result hash, with the version number and the result + +=cut + sub execute_version { my ( $version ) = @_; my $report; @@ -58,7 +113,7 @@ sub execute_version { my $r = md5_already_exists( $md5 ); if ( scalar @$r ) { my $p = @$r[0]; - $$report{$version} = "This file ( $filepath ) still already execute in version " . @$r[0]->{version} . " : same md5 (" . @$r[0]->{md5} . ")"; + $report->{$version} = "This file ( $filepath ) still already execute in version " . @$r[0]->{version} . " : same md5 (" . @$r[0]->{md5} . ")"; return $report; } @@ -73,19 +128,24 @@ sub execute_version { if ( do $version_file ) { $queries = _get_queries(); } else { - $$report{$version} = "Load functions in $filename failed"; + $report->{$version} = "Load functions in $filename failed"; } } default { - $$report{$version} = "This extension ($extension) is not take into account (only .pl or .sql)"; + $report->{$version} = "This extension ($extension) is not take into account (only .pl or .sql)"; } } + # check Koha version, and if this patch has a higher number, update it + warn "VERSION : ".C4::Context->preference("Version")." against < ".TransformToNum($version); + if (C4::Context->preference("Version") < TransformToNum($version)) { + SetVersion(TransformToNum($version)); + } return $report - if ( defined $$report{$version} ); + if ( defined $report->{$version} ); my $errors; - for my $query ( @{$$queries{queries}} ) { + for my $query ( @{$queries->{queries}} ) { eval { check_coherency( $query ); }; @@ -96,17 +156,24 @@ sub execute_version { if ( $errors ) { $_ =~ s/at [^ ]* line \d*\.$// for @$errors; - $$report{$version} = $errors; + $report->{$version} = $errors; return $report; } $errors = execute ( $queries ); - $$report{$version} = scalar( @$errors ) ? $errors : "OK"; + $report->{$version} = scalar( @$errors ) ? $errors : "OK"; set_infos ( $version, $queries, $errors, $md5 ); - return $report; } +=head2 list_versions_availables + + my @versions = list_versions_availables; + return an array with all version available + This list is retrieved from the directory defined in the etc/update/database/config.yaml, versions_dir parameter + +=cut + sub list_versions_availables { my @versions; opendir DH, $VERSIONS_PATH or die "Cannot open directory ($!)"; @@ -120,37 +187,63 @@ sub list_versions_availables { return \@versions; } +=head2 list_versions_already_knows + + my @versions = list_versions_availables; + return an array with all version that have already been applied + This sub check first that the updatedb tables exist and create them if needed + +=cut + sub list_versions_already_knows { + # 1st check if tables exist, otherwise create them + $dbh->do(qq{ + CREATE TABLE IF NOT EXISTS `updatedb_error` ( `version` varchar(32) DEFAULT NULL, `error` text ) ENGINE=InnoDB CHARSET=utf8; + }); + $dbh->do(qq{ + CREATE TABLE IF NOT EXISTS `updatedb_query` ( `version` varchar(32) DEFAULT NULL, `query` text ) ENGINE=InnoDB CHARSET=utf8; + }); + $dbh->do(qq{ + CREATE TABLE IF NOT EXISTS `updatedb_report` ( `version` text, `md5` varchar(50) DEFAULT NULL, `comment` text, `status` int(1) DEFAULT NULL ) ENGINE=InnoDB CHARSET=utf8; + }); + my $query = qq/ SELECT version, comment, status FROM updatedb_report /; my $sth = $dbh->prepare( $query ); $sth->execute; my $versions = $sth->fetchall_arrayref( {} ); map { my $version = $_; - my @comments = defined $$_{comment} ? split '\\\n', $$_{comment} : ""; - push @{ $$version{comments} }, { comment => $_ } for @comments; - delete $$version{comment}; + my @comments = defined $_->{comment} ? split '\\\n', $_->{comment} : ""; + push @{ $version->{comments} }, { comment => $_ } for @comments; + delete $version->{comment}; } @$versions; $sth->finish; for my $version ( @$versions ) { $query = qq/ SELECT query FROM updatedb_query WHERE version = ? /; $sth = $dbh->prepare( $query ); - $sth->execute( $$version{version} ); - $$version{queries} = $sth->fetchall_arrayref( {} ); + $sth->execute( $version->{version} ); + $version->{queries} = $sth->fetchall_arrayref( {} ); $sth->finish; $query = qq/ SELECT error FROM updatedb_error WHERE version = ? /; $sth = $dbh->prepare( $query ); - $sth->execute( $$version{version} ); - $$version{errors} = $sth->fetchall_arrayref( {} ); + $sth->execute( $version->{version} ); + $version->{errors} = $sth->fetchall_arrayref( {} ); $sth->finish; } return $versions; } +=head2 execute + + my @errors = $execute(\@queries); + This sub will execute queries coming from an execute_version based on a .sql file + +=cut + sub execute { my ( $queries ) = @_; my @errors; - for my $query ( @{$$queries{queries}} ) { + for my $query ( @{$queries->{queries}} ) { eval { $dbh->do( $query ); }; @@ -159,6 +252,13 @@ sub execute { return \@errors; } +=head2 get_tables_name + + my $tables = get_tables_name; + return an array with all Koha mySQL table names + +=cut + sub get_tables_name { my $sth = $dbh->prepare("SHOW TABLES"); $sth->execute(); @@ -169,6 +269,19 @@ sub get_tables_name { return \@tables; } my $tables; + +=head2 check_coherency + + my $errors = check_coherency($query); + This sub will try to check if a SQL query is useless or no. + for queries that are CREATE TABLE, it will check if the table already exists + for queries that are ALTER TABLE, it will search if the modification has already been made + for queries that are INSERT, it will search if the insert has already been made if it's a syspref or a permission + + Those test cover 90% of the updatedatabases cases. That will help finding duplicate or inconsistencies + +=cut + sub check_coherency { my ( $query ) = @_; $tables = get_tables_name() if not $tables; @@ -226,6 +339,13 @@ sub check_coherency { return 1; } +=head2 get_error + + my $errors = get_error() + This sub will return any mySQL error that occured during an update + +=cut + sub get_error { my @errors = $dbh->selectrow_array(qq{SHOW ERRORS}); # Get errors my @warnings = $dbh->selectrow_array(qq{SHOW WARNINGS}); # Get warnings @@ -238,6 +358,15 @@ sub get_error { return; } +=head2 + + my $result = get_queries($filepath); + this sub will return a hashref with 2 entries: + $result->{queries} is an array with all queries to execute + $result->{comments} is an array with all comments in the .sql file + +=cut + sub get_queries { my ( $filepath ) = @_; open my $fh, "<", $filepath; @@ -265,6 +394,14 @@ sub get_queries { return { queries => \@queries, comments => \@comments }; } +=head2 md5_already_exists + + my $result = md5_already_exists($md5); + check if the md5 of an update has already been applied on the database. + If yes, it will return a hash with the version related to this md5 + +=cut + sub md5_already_exists { my ( $md5 ) = @_; my $query = qq/SELECT version, md5 FROM updatedb_report WHERE md5 = ?/; @@ -278,10 +415,16 @@ sub md5_already_exists { return \@r; } +=head2 set_infos + + set_info($version,$queries, $error, $md5); + this sub will insert into the updatedb tables what has been made on the database (queries, errors, result) + +=cut sub set_infos { my ( $version, $queries, $errors, $md5 ) = @_; #SetVersion($DBversion) if not -s $errors; - for my $query ( @{ $$queries{queries} } ) { + for my $query ( @{ $queries->{queries} } ) { my $sth = $dbh->prepare("INSERT INTO updatedb_query(version, query) VALUES (?, ?)"); $sth->execute( $version, $query ); $sth->finish; @@ -294,11 +437,18 @@ sub set_infos { $sth->execute( $version, $md5, - join ('\n', @{ $$queries{comments} }), + join ('\n', @{ $queries->{comments} }), ( @$errors > 0 ) ? 0 : 1 ); } +=head2 mark_as_ok + + $mark_as_ok($version); + this sub will force to mark as "OK" an update that has failed + once this has been made, the status will look as "forced OK", and appear in green like versions that have been applied without any problem + +=cut sub mark_as_ok { my ( $version ) = @_; my $sth = $dbh->prepare( "UPDATE updatedb_report SET status = 2 WHERE version=?" ); @@ -308,7 +458,7 @@ sub mark_as_ok { my $filepath = get_filepath $version; my $queries = get_queries $filepath; my $errors; - for my $query ( @{$$queries{queries}} ) { + for my $query ( @{$queries->{queries}} ) { eval { check_coherency( $query ); }; @@ -326,10 +476,10 @@ sub mark_as_ok { $sth->finish; } -=item TransformToNum +=head2 TransformToNum Transform the Koha version from a 4 parts string - to a number, with just 1 . + to a number, with just 1 . (ie: it's a number) =cut --- a/about.pl +++ a/about.pl @@ -45,7 +45,7 @@ my ( $template, $loggedinuser, $cookie ) = get_template_and_user( } ); -my $kohaVersion = C4::Context::KOHAVERSION; +my $kohaVersion = C4::Context->preference("Version"); my $osVersion = `uname -a`; my $perl_path = $^X; if ($^O ne 'VMS') { --- a/installer/data/mysql/kohastructure.sql +++ a/installer/data/mysql/kohastructure.sql @@ -1955,6 +1955,27 @@ CREATE TABLE `tags_index` ( REFERENCES `biblio` (`biblionumber`) ON DELETE CASCADE ON UPDATE CASCADE ) ENGINE=InnoDB DEFAULT CHARSET=utf8; + +-- +-- Table structure for database updates +-- +CREATE TABLE`updatedb_error` ( + `version` varchar(32) DEFAULT NULL, + `error` text +) ENGINE=InnoDB CHARSET=utf8; + +CREATE TABLE `updatedb_query` ( + `version` varchar(32) DEFAULT NULL, + `query` text +) ENGINE=InnoDB CHARSET=utf8; + +CREATE TABLE `updatedb_report` ( + `version` text, + `md5` varchar(50) DEFAULT NULL, + `comment` text, + `status` int(1) DEFAULT NULL +) ENGINE=InnoDB CHARSET=utf8; + -- -- Table structure for table `userflags` -- --- a/koha-tmpl/intranet-tmpl/prog/en/modules/about.tt +++ a/koha-tmpl/intranet-tmpl/prog/en/modules/about.tt @@ -35,7 +35,7 @@ - + --- a/koha-tmpl/intranet-tmpl/prog/en/modules/admin/updatedatabase.tt +++ a/koha-tmpl/intranet-tmpl/prog/en/modules/admin/updatedatabase.tt @@ -57,7 +57,7 @@ [% r.error %]; [% END %] [% IF report_loo.coherency %] - [Mark as OK] + [Mark as OK] [% END %] [% END %] --
Server information
Koha version: [% kohaVersion |html %]
Koha version: [% kohaVersion |html %] (IMPORTANT: this number is the number of the highest update added. Since Koha 3.8, updates are non-linear. Go to admin section to check if every update has been added)
OS version ('uname -a'): [% osVersion |html %]
Perl interpreter: [% perlPath |html %]
Perl version: [% perlVersion |html %]