View | Details | Raw Unified | Return to bug 7167
Collapse All | Expand All

(-)a/C4/Auth.pm (-74 / +51 lines)
Lines 28-33 require Exporter; Link Here
28
use C4::Context;
28
use C4::Context;
29
use C4::Templates;    # to get the template
29
use C4::Templates;    # to get the template
30
use C4::Branch; # GetBranches
30
use C4::Branch; # GetBranches
31
use C4::Update::Database;
31
use C4::VirtualShelves;
32
use C4::VirtualShelves;
32
use POSIX qw/strftime/;
33
use POSIX qw/strftime/;
33
use List::MoreUtils qw/ any /;
34
use List::MoreUtils qw/ any /;
Lines 134-142 sub get_template_and_user { Link Here
134
    my $in       = shift;
135
    my $in       = shift;
135
    my $template =
136
    my $template =
136
      C4::Templates::gettemplate( $in->{'template_name'}, $in->{'type'}, $in->{'query'} );
137
      C4::Templates::gettemplate( $in->{'template_name'}, $in->{'type'}, $in->{'query'} );
137
    my ( $user, $cookie, $sessionID, $flags );
138
    my ( $user, $cookie, $sessionID, $flags, $new_session );
138
    if ( $in->{'template_name'} !~m/maintenance/ ) {
139
    if ( $in->{'template_name'} !~m/maintenance/ ) {
139
        ( $user, $cookie, $sessionID, $flags ) = checkauth(
140
        ( $user, $cookie, $sessionID, $flags, $new_session ) = checkauth(
140
            $in->{'query'},
141
            $in->{'query'},
141
            $in->{'authnotrequired'},
142
            $in->{'authnotrequired'},
142
            $in->{'flagsrequired'},
143
            $in->{'flagsrequired'},
Lines 466-471 sub get_template_and_user { Link Here
466
467
467
        $template->param(OpacPublic => '1') if ($user || C4::Context->preference("OpacPublic"));
468
        $template->param(OpacPublic => '1') if ($user || C4::Context->preference("OpacPublic"));
468
    }
469
    }
470
471
    if ( $new_session ) {
472
        # Check the version and redirect if DB is not up-to-date
473
        version_check($in->{query}, $in->{'type'}, $cookie);
474
    }
475
469
    return ( $template, $borrowernumber, $cookie, $flags);
476
    return ( $template, $borrowernumber, $cookie, $flags);
470
}
477
}
471
478
Lines 547-596 has authenticated. Link Here
547
554
548
=cut
555
=cut
549
556
550
sub _version_check {
551
    my $type = shift;
552
    my $query = shift;
553
    my $version;
554
    # If Version syspref is unavailable, it means Koha is beeing installed,
555
    # and so we must redirect to OPAC maintenance page or to the WebInstaller
556
	# also, if OpacMaintenance is ON, OPAC should redirect to maintenance
557
	if (C4::Context->preference('OpacMaintenance') && $type eq 'opac') {
558
        warn "OPAC Install required, redirecting to maintenance";
559
        print $query->redirect("/cgi-bin/koha/maintenance.pl");
560
        safe_exit;
561
    }
562
    unless ( $version = C4::Context->preference('Version') ) {    # assignment, not comparison
563
        if ( $type ne 'opac' ) {
564
            warn "Install required, redirecting to Installer";
565
            print $query->redirect("/cgi-bin/koha/installer/install.pl");
566
        } else {
567
            warn "OPAC Install required, redirecting to maintenance";
568
            print $query->redirect("/cgi-bin/koha/maintenance.pl");
569
        }
570
        safe_exit;
571
    }
572
573
    # check that database and koha version are the same
574
    # there is no DB version, it's a fresh install,
575
    # go to web installer
576
    # there is a DB version, compare it to the code version
577
    my $kohaversion=C4::Context::KOHAVERSION;
578
    # remove the 3 last . to have a Perl number
579
    $kohaversion =~ s/(.*\..*)\.(.*)\.(.*)/$1$2$3/;
580
    $debug and print STDERR "kohaversion : $kohaversion\n";
581
    if ($version < $kohaversion){
582
        my $warning = "Database update needed, redirecting to %s. Database is $version and Koha is $kohaversion";
583
        if ($type ne 'opac'){
584
            warn sprintf($warning, 'Installer');
585
            print $query->redirect("/cgi-bin/koha/installer/install.pl?step=3");
586
        } else {
587
            warn sprintf("OPAC: " . $warning, 'maintenance');
588
            print $query->redirect("/cgi-bin/koha/maintenance.pl");
589
        }
590
        safe_exit;
591
    }
592
}
593
594
sub _session_log {
557
sub _session_log {
595
    (@_) or return 0;
558
    (@_) or return 0;
596
    open my $fh, '>>', "/tmp/sessionlog" or warn "ERROR: Cannot append to /tmp/sessionlog";
559
    open my $fh, '>>', "/tmp/sessionlog" or warn "ERROR: Cannot append to /tmp/sessionlog";
Lines 607-612 sub _timeout_syspref { Link Here
607
    return $timeout;
570
    return $timeout;
608
}
571
}
609
572
573
sub version_check {
574
    my ( $query, $type, $cookie ) = @_;
575
    # check we have a Version. Otherwise => go to installer
576
    unless ( C4::Context->preference('Version') ) {
577
        if ( $type ne 'opac' ) {
578
            $debug && warn "Install required, redirecting to Installer";
579
            print $query->redirect("/cgi-bin/koha/installer/install.pl");
580
        } else {
581
            $debug && warn "OPAC Install required, redirecting to maintenance";
582
            print $query->redirect("/cgi-bin/koha/maintenance.pl");
583
        }
584
        safe_exit;
585
    }
586
587
    # check if you're uptodate, and if you're not, head to updater
588
    my $koha39 = "3.0900028";
589
590
    # Old updatedatabase method
591
    if (C4::Context->preference('Version') < $koha39) {
592
        print $query->redirect("/cgi-bin/koha/installer/install.pl?step=3");
593
        safe_exit;
594
    }
595
596
    # New updatedatabase method
597
    unless ( C4::Update::Database::is_uptodate() ) {
598
        # not up-to-date, redirect to updatedatabase page
599
        warn "redirect to updatedatabase";
600
        print $query->redirect(-location => "/cgi-bin/koha/admin/updatedatabase.pl", -cookie => $cookie);
601
        safe_exit;
602
    }
603
}
604
610
sub checkauth {
605
sub checkauth {
611
    my $query = shift;
606
    my $query = shift;
612
	$debug and warn "Checking Auth";
607
	$debug and warn "Checking Auth";
Lines 615-625 sub checkauth { Link Here
615
    my $flagsrequired   = shift;
610
    my $flagsrequired   = shift;
616
    my $type            = shift;
611
    my $type            = shift;
617
    $type = 'opac' unless $type;
612
    $type = 'opac' unless $type;
613
    my $new_session = 0;
618
614
619
    my $dbh     = C4::Context->dbh;
615
    my $dbh     = C4::Context->dbh;
620
    my $timeout = _timeout_syspref();
616
    my $timeout = _timeout_syspref();
617
    # days
618
    if ($timeout =~ /(\d+)[dD]/) {
619
        $timeout = $1 * 86400;
620
    };
621
    $timeout = 600 unless $timeout;
621
622
622
    _version_check($type,$query);
623
    # state variables
623
    # state variables
624
    my $loggedin = 0;
624
    my $loggedin = 0;
625
    my %info;
625
    my %info;
Lines 723-728 sub checkauth { Link Here
723
        my $sessionID = $session->id;
723
        my $sessionID = $session->id;
724
        C4::Context->_new_userenv($sessionID);
724
        C4::Context->_new_userenv($sessionID);
725
        $cookie = $query->cookie( CGISESSID => $sessionID );
725
        $cookie = $query->cookie( CGISESSID => $sessionID );
726
726
        $userid = $query->param('userid');
727
        $userid = $query->param('userid');
727
        if (   ( $cas && $query->param('ticket') )
728
        if (   ( $cas && $query->param('ticket') )
728
            || $userid
729
            || $userid
Lines 737-742 sub checkauth { Link Here
737
                  checkpw( $dbh, $userid, $password, $query );
738
                  checkpw( $dbh, $userid, $password, $query );
738
                $userid = $retuserid;
739
                $userid = $retuserid;
739
                $info{'invalidCasLogin'} = 1 unless ($return);
740
                $info{'invalidCasLogin'} = 1 unless ($return);
741
                $new_session = 1;
740
            }
742
            }
741
            elsif (
743
            elsif (
742
                ( $pki_field eq 'Common Name' && $ENV{'SSL_CLIENT_S_DN_CN'} )
744
                ( $pki_field eq 'Common Name' && $ENV{'SSL_CLIENT_S_DN_CN'} )
Lines 775-780 sub checkauth { Link Here
775
                ( $return, $cardnumber, $retuserid ) =
777
                ( $return, $cardnumber, $retuserid ) =
776
                  checkpw( $dbh, $userid, $password, $query );
778
                  checkpw( $dbh, $userid, $password, $query );
777
                $userid = $retuserid if ( $retuserid ne '' );
779
                $userid = $retuserid if ( $retuserid ne '' );
780
                $new_session = 1;
778
            }
781
            }
779
		if ($return) {
782
		if ($return) {
780
               #_session_log(sprintf "%20s from %16s logged in  at %30s.\n", $userid,$ENV{'REMOTE_ADDR'},(strftime '%c', localtime));
783
               #_session_log(sprintf "%20s from %16s logged in  at %30s.\n", $userid,$ENV{'REMOTE_ADDR'},(strftime '%c', localtime));
Lines 916-922 sub checkauth { Link Here
916
        unless ($cookie) {
919
        unless ($cookie) {
917
            $cookie = $query->cookie( CGISESSID => '' );
920
            $cookie = $query->cookie( CGISESSID => '' );
918
        }
921
        }
919
        return ( $userid, $cookie, $sessionID, $flags );
922
        return ( $userid, $cookie, $sessionID, $flags, $new_session );
920
    }
923
    }
921
924
922
#
925
#
Lines 1066-1084 sub check_api_auth { Link Here
1066
    my $dbh     = C4::Context->dbh;
1069
    my $dbh     = C4::Context->dbh;
1067
    my $timeout = _timeout_syspref();
1070
    my $timeout = _timeout_syspref();
1068
1071
1069
    unless (C4::Context->preference('Version')) {
1070
        # database has not been installed yet
1071
        return ("maintenance", undef, undef);
1072
    }
1073
    my $kohaversion=C4::Context::KOHAVERSION;
1074
    $kohaversion =~ s/(.*\..*)\.(.*)\.(.*)/$1$2$3/;
1075
    if (C4::Context->preference('Version') < $kohaversion) {
1076
        # database in need of version update; assume that
1077
        # no API should be called while databsae is in
1078
        # this condition.
1079
        return ("maintenance", undef, undef);
1080
    }
1081
1082
    # FIXME -- most of what follows is a copy-and-paste
1072
    # FIXME -- most of what follows is a copy-and-paste
1083
    # of code from checkauth.  There is an obvious need
1073
    # of code from checkauth.  There is an obvious need
1084
    # for refactoring to separate the various parts of
1074
    # for refactoring to separate the various parts of
Lines 1298-1316 sub check_cookie_auth { Link Here
1298
    my $dbh     = C4::Context->dbh;
1288
    my $dbh     = C4::Context->dbh;
1299
    my $timeout = _timeout_syspref();
1289
    my $timeout = _timeout_syspref();
1300
1290
1301
    unless (C4::Context->preference('Version')) {
1302
        # database has not been installed yet
1303
        return ("maintenance", undef);
1304
    }
1305
    my $kohaversion=C4::Context::KOHAVERSION;
1306
    $kohaversion =~ s/(.*\..*)\.(.*)\.(.*)/$1$2$3/;
1307
    if (C4::Context->preference('Version') < $kohaversion) {
1308
        # database in need of version update; assume that
1309
        # no API should be called while databsae is in
1310
        # this condition.
1311
        return ("maintenance", undef);
1312
    }
1313
1314
    # FIXME -- most of what follows is a copy-and-paste
1291
    # FIXME -- most of what follows is a copy-and-paste
1315
    # of code from checkauth.  There is an obvious need
1292
    # of code from checkauth.  There is an obvious need
1316
    # for refactoring to separate the various parts of
1293
    # for refactoring to separate the various parts of
(-)a/C4/Installer.pm (-1 / +10 lines)
Lines 23-28 use strict; Link Here
23
our $VERSION = 3.07.00.049;
23
our $VERSION = 3.07.00.049;
24
use C4::Context;
24
use C4::Context;
25
use C4::Installer::PerlModules;
25
use C4::Installer::PerlModules;
26
use C4::Update::Database;
26
27
27
=head1 NAME
28
=head1 NAME
28
29
Lines 466-472 Koha software version. Link Here
466
467
467
sub set_version_syspref {
468
sub set_version_syspref {
468
    my $self = shift;
469
    my $self = shift;
469
470
    # get all updatedatabase, and mark them as passed, as it's a fresh install
471
    my $versions = C4::Update::Database::list_versions_available();
472
    for my $v ( @$versions ) {
473
        my $queries;
474
        $queries->{queries} = ["initial setup"];
475
        $queries->{comments} = ["initial setup"];
476
        C4::Update::Database::set_infos($v,$queries,undef,undef);
477
    }
478
    # mark the "old" 3.6 version number
470
    my $kohaversion=C4::Context::KOHAVERSION;
479
    my $kohaversion=C4::Context::KOHAVERSION;
471
    # remove the 3 last . to have a Perl number
480
    # remove the 3 last . to have a Perl number
472
    $kohaversion =~ s/(.*\..*)\.(.*)\.(.*)/$1$2$3/;
481
    $kohaversion =~ s/(.*\..*)\.(.*)\.(.*)/$1$2$3/;
(-)a/C4/Installer/PerlDependencies.pm (+5 lines)
Lines 629-634 our $PERL_DEPS = { Link Here
629
        'required' => '0',
629
        'required' => '0',
630
        'min_ver'  => '1.09',
630
        'min_ver'  => '1.09',
631
      },
631
      },
632
    'File::Find::Rule' => {
633
        'usage'    => 'Core',
634
        'required' => '1',
635
        'min_ver'  => '0.33',
636
    },
632
};
637
};
633
638
634
1;
639
1;
(-)a/C4/Update/Database.pm (+554 lines)
Line 0 Link Here
1
package C4::Update::Database;
2
3
# Copyright Biblibre 2012
4
#
5
# This file is part of Koha.
6
#
7
# Koha is free software; you can redistribute it and/or modify it under the
8
# terms of the GNU General Public License as published by the Free Software
9
# Foundation; either version 2 of the License, or (at your option) any later
10
# version.
11
#
12
# Koha is distributed in the hope that it will be useful, but WITHOUT ANY
13
# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
14
# A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
15
#
16
# You should have received a copy of the GNU General Public License along
17
# with Koha; if not, write to the Free Software Foundation, Inc.,
18
# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
19
20
use Modern::Perl;
21
22
use C4::Context;
23
24
use File::Basename;
25
use File::Find::Rule;
26
use Digest::MD5;
27
use List::MoreUtils qw/uniq/;
28
use YAML;
29
30
=head1 NAME
31
32
C4::Update::Database.pm
33
34
=head1 SYNOPSIS
35
36
  use C4::Update::Database;
37
38
  This package is used by admin/updatedatabase.pl, to manage DB updates
39
40
=head1 FUNCTIONS
41
42
=cut
43
44
my $VERSIONS_PATH = C4::Context->config('intranetdir') . '/installer/data/mysql/versions';
45
46
my $version;
47
my $list;
48
49
my $dbh = C4::Context->dbh;
50
51
=head2 get_filepath
52
53
  my $file = get_filepath($version);
54
  this sub will return the full path of a given DB update number
55
56
=cut
57
58
sub get_filepath {
59
    my ( $version ) = @_;
60
    my @files = File::Find::Rule->file->name( "$version.sql", "$version.pl" ) ->in( ( $VERSIONS_PATH ) );
61
62
    if ( scalar @files != 1 ) {
63
        die "This version ($version) returned has ".scalar @files." corresponding, need only 1";
64
    }
65
66
    return $files[0];
67
}
68
69
=head2 get_md5
70
71
  my $md5 = get_md5($filepath)
72
  returns the md5sum of the selected file.
73
  This is used to check consistency of updates
74
75
=cut
76
77
sub get_md5 {
78
    my ( $filepath ) = @_;
79
    open(FILE, $filepath);
80
81
    my $ctx = Digest::MD5->new;
82
    $ctx->addfile(*FILE);
83
    my $md5 = $ctx->hexdigest;
84
    close(FILE);
85
    return $md5;
86
}
87
88
=head2 execute_version
89
90
  $result = execute_version($version_number);
91
  Execute an update.
92
  This sub will detect if the number is made through a .pl or a .sql, and behave accordingly
93
  if there is more than 1 file with the same number, an error will be issued
94
  if you try to execute a version_number that has already be executed, then it will also issue an error
95
  the sub return an result hash, with the version number and the result
96
97
=cut
98
99
sub execute_version {
100
    my ( $version ) = @_;
101
    my $report;
102
103
    my $filepath;
104
    eval {
105
        $filepath = get_filepath $version;
106
    };
107
    if ( $@ ) {
108
        return { $version => $@ };
109
    }
110
111
    my @file_infos = fileparse( $filepath, qr/\.[^.]*/ );
112
    my $extension = $file_infos[2];
113
    my $filename = $version . $extension;
114
115
    my $md5 = get_md5 $filepath;
116
    my $r = md5_already_exists( $md5 );
117
    if ( scalar @$r ) {
118
        my $p = @$r[0];
119
        $report->{$version} = {
120
            error => "ALREADY_EXISTS",
121
            filepath => $filepath,
122
            old_version => @$r[0]->{version},
123
            md5 => @$r[0]->{md5},
124
        };
125
        return $report;
126
    }
127
128
    my $queries;
129
    given ( $extension ) {
130
        when ( /.sql/ ) {
131
            $queries = get_queries ( $filepath );
132
        }
133
        when ( /.pl/ ) {
134
            eval {
135
                $queries = get_queries ( $filepath );
136
            };
137
            if ($@) {
138
                $report->{$version} = {
139
                    error => "LOAD_FUNCTIONS_FAILED",
140
                    filename => $filename,
141
                    error_str => $@,
142
                };
143
            }
144
        }
145
        default {
146
            $report->{$version} = {
147
                error => "BAD_EXTENSION",
148
                extension => $extension,
149
            };
150
        }
151
    }
152
153
    return $report
154
        if ( defined $report->{$version} );
155
156
    my $errors = execute ( $queries );
157
    $report->{$version} = scalar( @$errors ) ? $errors : "OK";
158
    set_infos ( $version, $queries, $errors, $md5 );
159
    return $report;
160
}
161
162
=head2 list_versions_available
163
164
  my @versions = list_versions_available;
165
  return an array with all version available
166
167
=cut
168
169
sub list_versions_available {
170
    my @versions;
171
172
    my @files = File::Find::Rule->file->name( "*.sql", "*.pl" ) ->in( ( $VERSIONS_PATH ) );
173
174
    for my $f ( @files ) {
175
        my @file_infos = fileparse( $f, qr/\.[^.]*/ );
176
        push @versions, $file_infos[0];
177
    }
178
    @versions = uniq @versions;
179
    return \@versions;
180
}
181
182
=head2 list_versions_already_applied
183
184
  my @versions = list_versions_available;
185
  return an array with all version that have already been applied
186
  This sub check first that the updatedb tables exist and create them if needed
187
188
=cut
189
190
sub list_versions_already_applied {
191
    # 1st check if tables exist, otherwise create them
192
        $dbh->do(qq{
193
                CREATE TABLE IF NOT EXISTS `updatedb_error` ( `version` varchar(32) DEFAULT NULL, `error` text ) ENGINE=InnoDB CHARSET=utf8;
194
        });
195
            $dbh->do(qq{
196
            CREATE TABLE  IF NOT EXISTS `updatedb_query` ( `version` varchar(32) DEFAULT NULL, `query` text ) ENGINE=InnoDB CHARSET=utf8;
197
        });
198
        $dbh->do(qq{
199
            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;
200
        });
201
202
    my $query = qq/ SELECT version, comment, status FROM updatedb_report ORDER BY version/;
203
    my $sth = $dbh->prepare( $query );
204
    $sth->execute;
205
    my $versions = $sth->fetchall_arrayref( {} );
206
    map {
207
        my $version = $_;
208
        my @comments = defined $_->{comment} ? split '\\\n', $_->{comment} : "";
209
        push @{ $version->{comments} }, { comment => $_ } for @comments;
210
        delete $version->{comment};
211
    } @$versions;
212
    $sth->finish;
213
    for my $version ( @$versions ) {
214
        $query = qq/ SELECT query FROM updatedb_query WHERE version = ? ORDER BY version/;
215
        $sth = $dbh->prepare( $query );
216
        $sth->execute( $version->{version} );
217
        $version->{queries} = $sth->fetchall_arrayref( {} );
218
        $sth->finish;
219
        $query = qq/ SELECT error FROM updatedb_error WHERE version = ? ORDER BY version/;
220
        $sth = $dbh->prepare( $query );
221
        $sth->execute( $version->{version} );
222
        $version->{errors} = $sth->fetchall_arrayref( {} );
223
        $sth->finish;
224
    }
225
    return $versions;
226
}
227
228
=head2 execute
229
230
  my @errors = $execute(\@queries);
231
  This sub will execute queries coming from an execute_version based on a .sql file
232
233
=cut
234
235
sub execute {
236
    my ( $queries ) = @_;
237
    my @errors;
238
    for my $query ( @{$queries->{queries}} ) {
239
        eval {
240
            $dbh->do( $query );
241
        };
242
        push @errors, get_error();
243
    }
244
    return \@errors;
245
}
246
247
=head2 get_tables_name
248
249
  my $tables = get_tables_name;
250
  return an array with all Koha mySQL table names
251
252
=cut
253
254
sub get_tables_name {
255
    my $sth = $dbh->prepare("SHOW TABLES");
256
    $sth->execute();
257
    my @tables;
258
    while ( my ( $table ) = $sth->fetchrow_array ) {
259
        push @tables, $table;
260
    }
261
    return \@tables;
262
}
263
my $tables;
264
265
=head2 check_coherency
266
267
  my $errors = check_coherency($query); UNUSED
268
  This sub will try to check if a SQL query is useless or no.
269
  for queries that are CREATE TABLE, it will check if the table already exists
270
  for queries that are ALTER TABLE, it will search if the modification has already been made
271
  for queries that are INSERT, it will search if the insert has already been made if it's a syspref or a permission
272
273
  Those test cover 90% of the updatedatabases cases. That will help finding duplicate or inconsistencies
274
275
=cut
276
277
#sub check_coherency {
278
#    my ( $query ) = @_;
279
#    $tables = get_tables_name() if not $tables;
280
#
281
#    given ( $query ) {
282
#        when ( /CREATE TABLE(?:.*?)? `?(\w+)`?/ ) {
283
#            my $table_name = $1;
284
#            if ( grep { /$table_name/ } @$tables ) {
285
#                die "COHERENCY: Table $table_name already exists";
286
#            }
287
#        }
288
#
289
#        when ( /ALTER TABLE *`?(\w+)`? *ADD *(?:COLUMN)? `?(\w+)`?/ ) {
290
#            my $table_name = $1;
291
#            my $column_name = $2;
292
#            next if $column_name =~ /(UNIQUE|CONSTRAINT|INDEX|KEY|FOREIGN)/;
293
#            if ( not grep { /$table_name/ } @$tables ) {
294
#                return "COHERENCY: Table $table_name does not exist";
295
#            } else {
296
#                my $sth = $dbh->prepare( "DESC $table_name $column_name" );
297
#                my $rv = $sth->execute;
298
#                if ( $rv > 0 ) {
299
#                    die "COHERENCY: Field $table_name.$column_name already exists";
300
#                }
301
#            }
302
#        }
303
#
304
#        when ( /INSERT INTO `?(\w+)`?.*?VALUES *\((.*?)\)/ ) {
305
#            my $table_name = $1;
306
#            my @values = split /,/, $2;
307
#            s/^ *'// foreach @values;
308
#            s/' *$// foreach @values;
309
#            given ( $table_name ) {
310
#                when ( /systempreferences/ ) {
311
#                    my $syspref = $values[0];
312
#                    my $sth = $dbh->prepare( "SELECT COUNT(*) FROM systempreferences WHERE variable = ?" );
313
#                    $sth->execute( $syspref );
314
#                    if ( ( my $count = $sth->fetchrow_array ) > 0 ) {
315
#                        die "COHERENCY: Syspref $syspref already exists";
316
#                    }
317
#                }
318
#
319
#                when ( /permissions/){
320
#                    my $module_bit = $values[0];
321
#                    my $code = $values[1];
322
#                    my $sth = $dbh->prepare( "SELECT COUNT(*) FROM permissions WHERE module_bit = ? AND code = ?" );
323
#                    $sth->execute($module_bit, $code);
324
#                    if ( ( my $count = $sth->fetchrow_array ) > 0 ) {
325
#                        die "COHERENCY: Permission $code already exists";
326
#                    }
327
#                }
328
#            }
329
#        }
330
#    }
331
#    return 1;
332
#}
333
334
=head2 get_error
335
336
  my $errors = get_error()
337
  This sub will return any mySQL error that occured during an update
338
339
=cut
340
341
sub get_error {
342
    my @errors = $dbh->selectrow_array(qq{SHOW ERRORS}); # Get errors
343
    my @warnings = $dbh->selectrow_array(qq{SHOW WARNINGS}); # Get warnings
344
    if ( @errors ) { # Catch specifics errors
345
        return qq{$errors[0] : $errors[1] => $errors[2]};
346
    } elsif ( @warnings ) {
347
        return qq{$warnings[0] : $warnings[1] => $warnings[2]}
348
            if $warnings[0] ne 'Note';
349
    }
350
    return;
351
}
352
353
=head2 get_queries
354
355
  my $result = get_queries($filepath);
356
  this sub will return a hashref with 2 entries:
357
    $result->{queries} is an array with all queries to execute
358
    $result->{comments} is an array with all comments in the .sql file
359
360
=cut
361
362
sub get_queries {
363
    my ( $filepath ) = @_;
364
    open my $fh, "<", $filepath;
365
    my @queries;
366
    my @comments;
367
    if ( $filepath =~ /\.pl$/ ) {
368
        if ( do $filepath ) {
369
            my $infos = _get_queries();
370
            @queries  = @{ $infos->{queries} }  if exists $infos->{queries};
371
            @comments = @{ $infos->{comments} } if exists $infos->{comments};
372
        }
373
        if ( $@ ) {
374
            die "I can't load $filepath. Please check the execute flag and if this file is a valid perl script ($@)";
375
        }
376
    } else {
377
        my $old_delimiter = $/;
378
        while ( <$fh> ) {
379
            my $line = $_;
380
            chomp $line;
381
            $line =~ s/^\s*//;
382
            if ( $line =~ /^--/ ) {
383
                my @l = split $old_delimiter, $line;
384
                if ( @l > 1 ) {
385
                    my $tmp_query;
386
                    for my $l ( @l ) {
387
                        if ( $l =~ /^--/ ) {
388
                            $l =~ s/^--\s*//;
389
                            push @comments, $l;
390
                            next;
391
                        }
392
                        $tmp_query .= $l . $old_delimiter;
393
                    }
394
                    push @queries, $tmp_query if $tmp_query;
395
                    next;
396
                }
397
398
                $line =~ s/^--\s*//;
399
                push @comments, $line;
400
                next;
401
            }
402
            if ( $line =~ /^delimiter (.*)$/i ) {
403
                $/ = $1;
404
                next;
405
            }
406
            $line =~ s#$/##;
407
            push @queries, $line if not $line =~ /^\s*$/; # Push if query is not empty
408
        }
409
        $/ = $old_delimiter;
410
        close $fh;
411
    }
412
413
    return { queries => \@queries, comments => \@comments };
414
}
415
416
=head2 md5_already_exists
417
418
  my $result = md5_already_exists($md5);
419
  check if the md5 of an update has already been applied on the database.
420
  If yes, it will return a hash with the version related to this md5
421
422
=cut
423
424
sub md5_already_exists {
425
    my ( $md5 ) = @_;
426
    my $query = qq/SELECT version, md5 FROM updatedb_report WHERE md5 = ?/;
427
    my $sth = $dbh->prepare( $query );
428
    $sth->execute( $md5 );
429
    my @r;
430
    while ( my ( $version, $md5 ) = $sth->fetchrow ) {
431
        push @r, { version => $version, md5 => $md5 };
432
    }
433
    $sth->finish;
434
    return \@r;
435
}
436
437
=head2 set_infos
438
439
  set_info($version,$queries, $error, $md5);
440
  this sub will insert into the updatedb tables what has been made on the database (queries, errors, result)
441
442
=cut
443
444
sub set_infos {
445
    my ( $version, $queries, $errors, $md5 ) = @_;
446
    SetVersion($version) if not -s $errors;
447
    for my $query ( @{ $queries->{queries} } ) {
448
        my $sth = $dbh->prepare("INSERT INTO updatedb_query(version, query) VALUES (?, ?)");
449
        $sth->execute( $version, $query );
450
        $sth->finish;
451
    }
452
    for my $error ( @$errors ) {
453
        my $sth = $dbh->prepare("INSERT INTO updatedb_error(version, error) VALUES (?, ?)");
454
        $sth->execute( $version, $error );
455
    }
456
    my $sth = $dbh->prepare("INSERT INTO updatedb_report(version, md5, comment, status) VALUES (?, ?, ?, ?)");
457
    $sth->execute(
458
        $version,
459
        $md5,
460
        join ('\n', @{ $queries->{comments} }),
461
        ( @$errors > 0 ) ? 0 : 1
462
    );
463
}
464
465
=head2 mark_as_ok
466
467
  mark_as_ok($version);
468
  this sub will force to mark as "OK" an update that has failed
469
  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
470
471
=cut
472
473
sub mark_as_ok {
474
    my ( $version ) = @_;
475
    my $sth = $dbh->prepare( "UPDATE updatedb_report SET status = 2 WHERE version=?" );
476
    my $affected = $sth->execute( $version );
477
    if ( $affected < 1 ) {
478
        my $filepath = get_filepath $version;
479
        my $queries  = get_queries $filepath;
480
        my $md5      = get_md5 $filepath;
481
        set_infos $version, $queries, undef, $md5;
482
483
        $sth->execute( $version );
484
    }
485
    $sth->finish;
486
}
487
488
=head2 is_uptodate
489
  is_uptodate();
490
  return 1 if the database is up to date else 0.
491
  The database is up to date if all versions are excecuted.
492
493
=cut
494
495
sub is_uptodate {
496
    my $versions_available = C4::Update::Database::list_versions_available;
497
    my $versions = C4::Update::Database::list_versions_already_applied;
498
    for my $v ( @$versions_available ) {
499
        if ( not grep { $v eq $$_{version} } @$versions ) {
500
            return 0;
501
        }
502
    }
503
    return 1;
504
}
505
506
=head2 TransformToNum
507
508
  Transform the Koha version from a 4 parts string
509
  to a number, with just 1 . (ie: it's a number)
510
511
=cut
512
513
sub TransformToNum {
514
    my $version = shift;
515
516
    # remove the 3 last . to have a Perl number
517
    $version =~ s/(.*\..*)\.(.*)\.(.*)/$1$2$3/;
518
    $version =~ s/Bug(\d+)/$1/;
519
    return $version;
520
}
521
522
sub SetVersion {
523
    my $new_version = TransformToNum(shift);
524
    return unless $new_version =~ /\d\.\d+/;
525
    my $current_version = TransformToNum( C4::Context->preference('Version') );
526
    unless ( C4::Context->preference('Version') ) {
527
        my $finish = $dbh->prepare(qq{
528
            INSERT IGNORE INTO systempreferences (variable,value,explanation)
529
            VALUES ('Version',?,'The Koha database version. WARNING: Do not change this value manually, it is maintained by the webinstaller')
530
        });
531
        $finish->execute($new_version);
532
        return;
533
    }
534
    if ( $new_version > $current_version ) {
535
        my $finish = $dbh->prepare("UPDATE systempreferences SET value=? WHERE variable='Version'");
536
        $finish->execute($new_version);
537
    }
538
}
539
540
=head2 TableExists($table)
541
542
=cut
543
544
sub TableExists {
545
    my $table = shift;
546
    eval {
547
        local $dbh->{PrintError} = 0;
548
        local $dbh->{RaiseError} = 0;
549
        $dbh->do(qq{SELECT * FROM $table WHERE 1 = 0 });
550
    };
551
    return 1 unless $@;
552
    return 0;
553
}
554
1;
(-)a/about.pl (-1 / +41 lines)
Lines 32-37 use C4::Output; Link Here
32
use C4::Auth;
32
use C4::Auth;
33
use C4::Context;
33
use C4::Context;
34
use C4::Installer;
34
use C4::Installer;
35
use C4::Update::Database;
35
36
36
#use Smart::Comments '####';
37
#use Smart::Comments '####';
37
38
Lines 47-53 my ( $template, $loggedinuser, $cookie ) = get_template_and_user( Link Here
47
    }
48
    }
48
);
49
);
49
50
50
my $kohaVersion   = C4::Context::KOHAVERSION;
51
my $kohaVersion   = C4::Context->preference("Version");
52
# restore ., for display consistency
53
$kohaVersion =~ /(.)\.(..)(..)(...)/;
54
# transform digits to Perl number, to display 3.6.1.2 instead of 3.06.01.002
55
$kohaVersion = ($1+0).".".($2+0).".".($3+0).".".($4+0);
56
57
my $dbrev_applied=""; # the list of database revisions
58
59
# the $kohaVersion is duplicated since 3.7: the 3.6 (that uses the old mechanism) and the 3.7 (new mechanism).
60
# Both versions reflects how the database has been upgraded
61
my $already_applied = C4::Update::Database::list_versions_already_applied();
62
# $last_known contains the previous DBrev applied number (all . removed). It's used to have a . instead of a number in case of continuous updates
63
my $last_known=0;
64
# $last_known_sep contains the previous DBrev applied with the separator (used for display)
65
my $last_known_sep="";
66
for my $v ( @$already_applied ) {
67
    my $current = $v->{version};
68
    $current =~s/\.//g;
69
    # if the current number is the previous one +1, then just add a ., for a better display N.........N+10, for example
70
    # (instead of N / N+1 / N+2 / ...)
71
    if ($current==$last_known+1) {
72
        $dbrev_applied.=".";
73
    } else { # we're not N+1, start a new range
74
        # if version don't end by a ., no need to add the current loop number
75
        # this avoid having N...N (in case of an isolated BDrev number)
76
        if ($last_known & $dbrev_applied =~ /\.$/) {
77
            $dbrev_applied .= "...".$last_known_sep;
78
        }
79
        # start a new range
80
        $dbrev_applied .= " ".$v->{version};
81
    }
82
    $last_known= $current;
83
    $last_known_sep=$v->{version};
84
}
85
# add the last DB rev number, we don't want to end with "..."
86
if ($dbrev_applied =~ /\.$/) {
87
    $dbrev_applied .= "...".$last_known_sep;
88
}
89
51
my $osVersion     = `uname -a`;
90
my $osVersion     = `uname -a`;
52
my $perl_path = $^X;
91
my $perl_path = $^X;
53
if ($^O ne 'VMS') {
92
if ($^O ne 'VMS') {
Lines 76-81 my $warnIsRootUser = (! $loggedinuser); Link Here
76
115
77
$template->param(
116
$template->param(
78
    kohaVersion   => $kohaVersion,
117
    kohaVersion   => $kohaVersion,
118
    dbrev_applied => $dbrev_applied,
79
    osVersion     => $osVersion,
119
    osVersion     => $osVersion,
80
    perlPath      => $perl_path,
120
    perlPath      => $perl_path,
81
    perlVersion   => $perlVersion,
121
    perlVersion   => $perlVersion,
(-)a/admin/ajax-updatedb-getinfos.pl (+60 lines)
Line 0 Link Here
1
#!/usr/bin/perl
2
3
# Copyright BibLibre 2012
4
#
5
# This file is part of Koha.
6
#
7
# Koha is free software; you can redistribute it and/or modify it under the
8
# terms of the GNU General Public License as published by the Free Software
9
# Foundation; either version 2 of the License, or (at your option) any later
10
# version.
11
#
12
# Koha is distributed in the hope that it will be useful, but WITHOUT ANY
13
# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
14
# A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
15
#
16
# You should have received a copy of the GNU General Public License along
17
# with Koha; if not, write to the Free Software Foundation, Inc.,
18
# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
19
20
=head1 NAME
21
22
ajax-updatedb-getinfos.pl
23
24
=head1 DESCRIPTION
25
this script returns comments for a updatedatabase version
26
27
=cut
28
29
use Modern::Perl;
30
use CGI;
31
use JSON;
32
use C4::Update::Database;
33
use C4::Output;
34
35
my $input = new CGI;
36
my $version = $input->param('version');
37
38
my $filepath;
39
my $queries;
40
eval {
41
    $filepath = C4::Update::Database::get_filepath( $version );
42
    $queries = C4::Update::Database::get_queries( $filepath );
43
};
44
45
my $param = {comments => "", queries => ""};
46
if ( $@ ){
47
    $param->{errors} = $@;
48
} else {
49
    if ( exists $queries->{comments} and @{ $queries->{comments} } ) {
50
        $param->{comments} = join ( "<br/>", @{ $queries->{comments} } );
51
    }
52
53
    if ( exists $queries->{queries} and @{ $queries->{queries} } ) {
54
        $param->{queries} = join ( "<br/>", @{ $queries->{queries} } );
55
    }
56
}
57
58
my $json_text = to_json( $param, { utf8 => 1 } );
59
60
output_with_http_headers $input, undef, $json_text, 'json';
(-)a/admin/updatedatabase.pl (+101 lines)
Line 0 Link Here
1
#!/usr/bin/perl
2
3
# Copyright Biblibre 2012
4
#
5
# This file is part of Koha.
6
#
7
# Koha is free software; you can redistribute it and/or modify it under the
8
# terms of the GNU General Public License as published by the Free Software
9
# Foundation; either version 2 of the License, or (at your option) any later
10
# version.
11
#
12
# Koha is distributed in the hope that it will be useful, but WITHOUT ANY
13
# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
14
# A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
15
#
16
# You should have received a copy of the GNU General Public License along
17
# with Koha; if not, write to the Free Software Foundation, Inc.,
18
# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
19
20
use Modern::Perl;
21
use CGI;
22
use C4::Auth;
23
use C4::Output;
24
use C4::Update::Database;
25
26
my $query = new CGI;
27
my $op = $query->param('op') || 'list';
28
29
my ( $template, $borrowernumber, $cookie ) = get_template_and_user(
30
    {   template_name   => "admin/updatedatabase.tmpl",
31
        query           => $query,
32
        type            => "intranet",
33
        authnotrequired => 0,
34
        flagsrequired   => { parameters => 1 },
35
    }
36
);
37
38
if ( $op eq 'update' ) {
39
    my @versions = $query->param('version');
40
    @versions = sort {
41
        C4::Update::Database::TransformToNum( $a ) <=> C4::Update::Database::TransformToNum( $b )
42
    } @versions;
43
44
    my @reports;
45
    for my $version ( @versions ) {
46
        push @reports, C4::Update::Database::execute_version $version;
47
    }
48
49
    my @report_loop = map {
50
        my ( $v, $r ) = each %$_;
51
        my @errors = ref ( $r ) eq 'ARRAY'
52
            ?
53
                map {
54
                    { error => $_ }
55
                } @$r
56
            :
57
                { error => $r };
58
        {
59
            version => $v,
60
            report  => \@errors,
61
        }
62
    } @reports;
63
    $template->param( report_loop => \@report_loop );
64
65
    $op = 'list';
66
}
67
68
if ( $op eq 'mark_as_ok' ) {
69
    my @versions = $query->param('version');
70
    C4::Update::Database::mark_as_ok $_ for @versions;
71
    $op = 'list';
72
}
73
74
if ( $op eq 'list' ) {
75
    my $versions_available = C4::Update::Database::list_versions_available;
76
    my $versions = C4::Update::Database::list_versions_already_applied;
77
78
    for my $v ( @$versions_available ) {
79
        if ( not grep { $v eq $$_{version} } @$versions ) {
80
            push @$versions, {
81
                version => $v,
82
                available => 1
83
            };
84
        }
85
    }
86
    my @sorted = sort {
87
        C4::Update::Database::TransformToNum( $$a{version} ) <=> C4::Update::Database::TransformToNum( $$b{version} )
88
    } @$versions;
89
90
    my @available = grep { defined $$_{available} and $$_{available} == 1 } @sorted;
91
    my @v_available = map { {version => $$_{version}} } @available;
92
93
    $template->param(
94
        dev_mode => $ENV{DEBUG},
95
        versions => \@sorted,
96
        nb_available => scalar @available,
97
        available => [ map { {version => $$_{version}} } @available ],
98
    );
99
}
100
101
output_html_with_http_headers $query, $cookie, $template->output;
(-)a/installer/data/mysql/kohastructure.sql (+21 lines)
Lines 2082-2087 CREATE TABLE `tags_index` ( -- a weighted list of all tags and where they are us Link Here
2082
        REFERENCES `biblio` (`biblionumber`) ON DELETE CASCADE ON UPDATE CASCADE
2082
        REFERENCES `biblio` (`biblionumber`) ON DELETE CASCADE ON UPDATE CASCADE
2083
) ENGINE=InnoDB DEFAULT CHARSET=utf8;
2083
) ENGINE=InnoDB DEFAULT CHARSET=utf8;
2084
2084
2085
2086
--
2087
-- Table structure for database updates
2088
--
2089
CREATE TABLE`updatedb_error` (
2090
    `version` varchar(32) DEFAULT NULL,
2091
    `error` text
2092
) ENGINE=InnoDB CHARSET=utf8;
2093
2094
CREATE TABLE `updatedb_query` (
2095
    `version` varchar(32) DEFAULT NULL,
2096
    `query` text
2097
) ENGINE=InnoDB CHARSET=utf8;
2098
2099
CREATE TABLE `updatedb_report` (
2100
    `version` text,
2101
    `md5` varchar(50) DEFAULT NULL,
2102
    `comment` text,
2103
    `status` int(1) DEFAULT NULL
2104
) ENGINE=InnoDB CHARSET=utf8;
2105
2085
--
2106
--
2086
-- Table structure for table `userflags`
2107
-- Table structure for table `userflags`
2087
--
2108
--
(-)a/installer/data/mysql/versions/update_sample.pl.sample (+44 lines)
Line 0 Link Here
1
#!/usr/bin/perl
2
3
# You write good Perl, so you start with Modern::Perl, of course
4
use Modern::Perl;
5
6
# then you load Packages that could be usefull
7
use C4::Context;
8
# Loading this package is usefull if you need to check if a table exist (TableExists)
9
use C4::Update::Database;
10
11
# you *must* have the sub _get_queries
12
# it returns an array of all SQL that have to be executed
13
# this array will be stored "forever" in your Koha database
14
# thus, you will be able to know which SQL has been executed
15
# at the time of upgrade. Very handy, because since then
16
# your database configuration may have changed and you'll wonder
17
# what has really be executed, not what would be executed today !
18
19
# put in an array the SQL to execute
20
# put in an array the comments
21
sub _get_queries {
22
    my @queries;
23
    my @comments;
24
    push @comments, "Add sample feature";
25
    unless ( C4::Update::Database::TableExists('testtable') ) {
26
        push @queries, qq{
27
                CREATE TABLE `testtable` (
28
                  `id` int(11) NOT NULL AUTO_INCREMENT,
29
                  `source` text DEFAULT NULL,
30
                  `text` mediumtext NOT NULL,
31
                  `timestamp` datetime NOT NULL,
32
                  PRIMARY KEY (`id`)
33
                ) ENGINE=InnoDB DEFAULT CHARSET=utf8
34
            };
35
        push @comments, qq { * Added the table testtable that did not exist};
36
    }
37
    push @queries, qq{INSERT IGNORE INTO `systempreferences` (variable,value,explanation,options,type) VALUES('testsyspref1',0,'Enable or disable display of Quote of the Day on the OPAC home page',NULL,'YesNo')};
38
    push @queries, qq{INSERT IGNORE INTO `systempreferences` (variable,value,explanation,options,type) VALUES('testsyspref2',0,'Enable or disable display of Quote of the Day on the OPAC home page',NULL,'YesNo')};
39
    push @comments , qq{ * Added 2 sysprefs};
40
41
# return queries and comments
42
    return { queries => \@queries, comments => \@comments };
43
}
44
1;
(-)a/installer/data/mysql/versions/update_sample.sql.sample (+27 lines)
Line 0 Link Here
1
-- This is an example for .sql file
2
-- all the comments (ie= what is after --) will be identified as comment
3
-- and displayed as such in Koha updatedatabase interface
4
-- the .sql is easy: just define a separator if you plan to have multi-line SQL
5
-- then, your sql
6
7
-- basic example, without delimiter defined:
8
UPDATE systempreferences SET value="something" WHERE variable="TestSysprefBasic";
9
INSERT INTO itemtypes (itemtype, description) VALUES ('SAMPLE','A description');
10
-- End of basic sample
11
12
13
-- more complex example, with delimiter defined:
14
DELIMITER //
15
-- I've defined a delimiter
16
-- so I can put SQL on many lines
17
-- Note that in this sample, the ; at the end of each query is not required.
18
CREATE TABLE `testtable1` (
19
                    `entry` varchar(255) NOT NULL default '',
20
                    `weight` bigint(20) NOT NULL default 0,
21
                    PRIMARY KEY  (`entry`)
22
                    ) ENGINE=InnoDB DEFAULT CHARSET=utf8;
23
//
24
-- or on a single line, as previously
25
-- without ; just for the sample
26
INSERT INTO `systempreferences` VALUES ('TestSyspref1','2','set the level of error info sent to the browser. 0=none, 1=some, 2=most','0|1|2','Choice')
27
//
(-)a/installer/install.pl (-21 / +32 lines)
Lines 312-340 elsif ( $step && $step == 3 ) { Link Here
312
        # Not 1st install, the only sub-step : update database
312
        # Not 1st install, the only sub-step : update database
313
        #
313
        #
314
        #Do updatedatabase And report
314
        #Do updatedatabase And report
315
315
        if ( ! defined $ENV{PERL5LIB} ) {
316
    if ( ! defined $ENV{PERL5LIB} ) {
316
            my $find = "C4/Context.pm";
317
        my $find = "C4/Context.pm";
317
            my $path = $INC{$find};
318
        my $path = $INC{$find};
318
            $path =~ s/\Q$find\E//;
319
        $path =~ s/\Q$find\E//;
319
            $ENV{PERL5LIB} = "$path:$path/installer";
320
        $ENV{PERL5LIB} = "$path:$path/installer";
320
            warn "# plack? inserted PERL5LIB $ENV{PERL5LIB}\n";
321
        warn "# plack? inserted PERL5LIB $ENV{PERL5LIB}\n";
322
    }
323
324
        my $cmd = C4::Context->config("intranetdir") . "/installer/data/$info{dbms}/updatedatabase.pl";
325
        my ($success, $error_code, $full_buf, $stdout_buf, $stderr_buf) = IPC::Cmd::run(command => $cmd, verbose => 0);
326
327
        if (@$stdout_buf) {
328
            $template->param(update_report => [ map { { line => $_ } } split(/\n/, join('', @$stdout_buf)) ] );
329
            $template->param(has_update_succeeds => 1);
330
        }
331
        if (@$stderr_buf) {
332
            $template->param(update_errors => [ map { { line => $_ } } split(/\n/, join('', @$stderr_buf)) ] );
333
            $template->param(has_update_errors => 1);
334
            warn "The following errors were returned while attempting to run the updatedatabase.pl script:\n";
335
            foreach my $line (@$stderr_buf) {warn "$line\n";}
336
        }
321
        }
337
322
323
        my $koha39 = "3.0900028";
324
        my $cmd;
325
        # Old updatedatabase method
326
        my $current_version = C4::Context->preference('Version');
327
        if ( $current_version < $koha39 ) {
328
            $cmd = C4::Context->config("intranetdir") . "/installer/data/$info{dbms}/updatedatabase.pl";
329
            my ($success, $error_code, $full_buf, $stdout_buf, $stderr_buf) = IPC::Cmd::run(command => $cmd, verbose => 0);
330
            print_std( "updatedatabase.pl", $stdout_buf, $stderr_buf );
331
            $current_version= $koha39;
332
        }
338
        $template->param( $op => 1 );
333
        $template->param( $op => 1 );
339
    }
334
    }
340
    else {
335
    else {
Lines 406-409 else { Link Here
406
        }
401
        }
407
    }
402
    }
408
}
403
}
404
405
sub print_std {
406
    my ( $script, $stdout_buf, $stderr_buf ) = @_;
407
    if (@$stdout_buf) {
408
        $template->param(update_report => [ map { { line => $_ } } split(/\n/, join('', @$stdout_buf)) ] );
409
        $template->param(has_update_succeeds => 1);
410
    }
411
    if (@$stderr_buf) {
412
        $template->param(update_errors => [ map { { line => $_ } } split(/\n/, join('', @$stderr_buf)) ] );
413
        $template->param(has_update_errors => 1);
414
        warn "The following errors were returned while attempting to run the $script script:\n";
415
        foreach my $line (@$stderr_buf) {warn "$line\n";}
416
    }
417
}
418
419
409
output_html_with_http_headers $query, $cookie, $template->output;
420
output_html_with_http_headers $query, $cookie, $template->output;
(-)a/koha-tmpl/intranet-tmpl/prog/en/css/staff-global.css (+8 lines)
Lines 2046-2051 div.pager p { Link Here
2046
	margin: 0;
2046
	margin: 0;
2047
}
2047
}
2048
2048
2049
tr.dragClass td {
2050
    background-color: grey;
2051
    color: yellow;
2052
}
2053
.underline {
2054
    text-decoration : underline;
2055
}
2056
2049
div#acqui_order_supplierlist > div.supplier {
2057
div#acqui_order_supplierlist > div.supplier {
2050
    border: 1px solid #EEEEEE;
2058
    border: 1px solid #EEEEEE;
2051
    margin: 0.5em;
2059
    margin: 0.5em;
(-)a/koha-tmpl/intranet-tmpl/prog/en/modules/about.tt (-1 / +1 lines)
Lines 37-43 Link Here
37
37
38
        <table>
38
        <table>
39
            <caption>Server information</caption>
39
            <caption>Server information</caption>
40
            <tr><th scope="row">Koha version: </th><td>[% kohaVersion |html %]</td></tr>
40
            <tr><th scope="row">Koha version: </th><td>[% kohaVersion |html %] with the following database revisions applied: [% dbrev_applied|html %]</td></tr>
41
            <tr><th scope="row">OS version ('uname -a'): </th><td>[% osVersion |html %]</td></tr>
41
            <tr><th scope="row">OS version ('uname -a'): </th><td>[% osVersion |html %]</td></tr>
42
            <tr><th scope="row">Perl interpreter: </th><td>[% perlPath |html %]</td></tr>
42
            <tr><th scope="row">Perl interpreter: </th><td>[% perlPath |html %]</td></tr>
43
            <tr><th scope="row">Perl version: </th><td>[% perlVersion |html %]</td></tr>
43
            <tr><th scope="row">Perl version: </th><td>[% perlVersion |html %]</td></tr>
(-)a/koha-tmpl/intranet-tmpl/prog/en/modules/admin/admin-home.tt (+7 lines)
Lines 110-115 Link Here
110
    <dt><a href="/cgi-bin/koha/admin/didyoumean.pl">Did you mean?</a></dt>
110
    <dt><a href="/cgi-bin/koha/admin/didyoumean.pl">Did you mean?</a></dt>
111
    <dd>Choose which plugins to use to suggest searches to patrons and staff.</dd>
111
    <dd>Choose which plugins to use to suggest searches to patrons and staff.</dd>
112
</dl>
112
</dl>
113
114
<h3>Update Database</h3>
115
<dl>
116
    <dt><a href="/cgi-bin/koha/admin/updatedatabase.pl">Check your updates</a></dt>
117
    <dd>Verify your database versions and execute new updates</dd>
118
</dl>
119
113
</div>
120
</div>
114
121
115
</div>
122
</div>
(-)a/koha-tmpl/intranet-tmpl/prog/en/modules/admin/updatedatabase.tt (+217 lines)
Line 0 Link Here
1
[% INCLUDE 'doc-head-open.inc' %]
2
<title>Koha &rsaquo; Administration &rsaquo; Update Database</title>
3
[% INCLUDE 'doc-head-close.inc' %]
4
<link rel="stylesheet" type="text/css" href="[% themelang %]/css/datatables.css" />
5
<script type="text/javascript" src="[% themelang %]/lib/jquery/plugins/jquery.dataTables.min.js"></script>
6
[% INCLUDE 'datatables-strings.inc' %]
7
<script type="text/javascript" src="[% themelang %]/js/datatables.js"></script>
8
9
<script type="text/javascript">
10
 //<![CDATA[
11
    $(document).ready(function() {
12
        $("#versionst").dataTable($.extend(true, {}, dataTablesDefaults, {
13
            "aaSorting" : [[0, "desc"]],
14
            "sPaginationType": "four_button",
15
        }));
16
    } );
17
    function see_details(a){
18
        var div = $(a).siblings('div');
19
        $(div).slideToggle("fast", function() {
20
            var isVisible = $(div).is(":visible");
21
            if ( isVisible ){$(a).text("Hide details");}else{$(a).text("Show details");}
22
        } );
23
    }
24
    function get_infos(version, node){
25
        $.getJSON('/cgi-bin/koha/admin/ajax-updatedb-getinfos.pl',
26
            { version: version },
27
            function(param) {
28
                if ( param['errors'] ) {
29
                    $(node).replaceWith(_("Errors occured: ") + param['errors']);
30
                }
31
                var s;
32
                s = "<b>" + _("Comments:") + "</b>";
33
                s += '<br/>';
34
                if ( param['comments'] ) {
35
                    s += param['comments'];
36
                } else {
37
                    s += _("No comments");
38
                }
39
                s += '<br/><br/>';
40
41
                s += "<b>" + _("Queries:") + "</b>";
42
                s += '<br/>';
43
                if ( param['queries'] ) {
44
                    s += param['queries'];
45
                } else {
46
                    s += _("No queries");
47
                }
48
                $(node).replaceWith(s);
49
            }
50
        );
51
    }
52
//]]>
53
</script>
54
</head>
55
<body>
56
[% INCLUDE 'header.inc' %]
57
[% INCLUDE 'cat-search.inc' %]
58
59
<div id="breadcrumbs"><a href="/cgi-bin/koha/mainpage.pl">Home</a> &rsaquo; <a href="/cgi-bin/koha/admin/admin-home.pl">Administration</a> &rsaquo; Database update</div>
60
61
<div id="doc3" class="yui-t2">
62
63
   <div id="bd">
64
    <div id="yui-main">
65
    <div class="yui-b">
66
67
    <h2>Database update</h2>
68
    [% IF report_loop %]
69
    <div class="report" style="display:block; margin:1em;">
70
        Report :
71
        <ul>
72
        [% FOREACH report_loo IN report_loop %]
73
            <li>
74
                [% report_loo.version %] --
75
                [% FOREACH r IN report_loo.report %]
76
                  [% IF r.error.error == "ALREADY_EXISTS" %]
77
                    <span style="color:orange;">
78
                      [% r.error.filepath %] already executed in version [% r.error.old_version %] : same md5 ([% r.error.md5 %])
79
                      [<a href="/cgi-bin/koha/admin/updatedatabase.pl?op=mark_as_ok&version=[% report_loo.version %]">Mark as OK</a>]
80
                    </span>
81
                  [% ELSIF r.error.error == "LOAD_FUNCTIONS_FAILED" %]
82
                    <span style="color:red;">
83
                      Load functions in [% r.error.filename %] failed ([% r.error.error_str %])
84
                    </span>
85
                  [% ELSIF r.error.error == "BAD_EXTENSION" %]
86
                    <span style="color:red;">
87
                      This extension ([% r.error.extension %]) is not take into account (only .pl or .sql)";
88
                    </span>
89
                  [% ELSE %]
90
                    [% IF r.error == "OK" %]
91
                      <span style="color:green;">
92
                        [% r.error %];
93
                      </span>
94
                    [% ELSE %]
95
                      <span style="color:red;">
96
                        [% r.error %];
97
                      </span>
98
                    [% END %]
99
                  [% END %]
100
                [% END %]
101
            </li>
102
        [% END %]
103
        </ul>
104
    </div>
105
    [% END %]
106
    <span class="infos" style="display:block; margin:1em;">
107
        [% IF nb_available %]
108
            Your datebase is not up to date.<br/>
109
            [% IF nb_available == 1 %]
110
                1 update available [<a href="/cgi-bin/koha/admin/updatedatabase.pl?op=update&version=[% available.first.version %]">UPDATE [% available.first.version %]</a>]
111
            [% ELSE %]
112
                [% nb_available %] updates available [<a href="/cgi-bin/koha/admin/updatedatabase.pl?op=update[% FOREACH av IN available %]&version=[% av.version %][% END %]">UPDATE ALL</a>]:
113
                [% IF ( dev_mode ) %]
114
                  <ul>
115
                    [% FOREACH av IN available %]
116
                      <li>[% av.version %] [<a href="/cgi-bin/koha/admin/updatedatabase.pl?op=update&version=[% av.version %]">UPDATE</a>]</li>
117
                    [% END %]
118
                  </ul>
119
                [% END %]
120
            [% END %]
121
        [% ELSE %]
122
            Your database is up to date
123
        [% END %]
124
    </span>
125
126
    <table id="versionst">
127
        <thead>
128
            <tr>
129
                <th>DB revision</th>
130
                <th>Status</th>
131
                <th>Comments</th>
132
                <th>Details</th>
133
            </tr>
134
        </thead>
135
        <tbody>
136
        [% FOREACH v IN versions %]
137
            <tr>
138
                <td>[% v.version %]</td>
139
                <td>
140
                    [% IF v.available %]
141
                        Not applied
142
                        [% IF (dev_mode) %]
143
                            [<a href="/cgi-bin/koha/admin/updatedatabase.pl?op=update&version=[% v.version %]">Execute</a>]
144
                        [% END %]
145
                    [% ELSE %]
146
                        [% SWITCH v.status %]
147
                        [% CASE 0 %]
148
                            <span style="color:red;">
149
                              Applied and failed
150
                              [<a href="/cgi-bin/koha/admin/updatedatabase.pl?op=mark_as_ok&version=[% v.version %]">Mark as OK</a>]
151
                            </span>
152
                        [% CASE 1 %]
153
                            <span style="color:green;">Applied and OK</span>
154
                        [% CASE 2 %]
155
                            <span style="color:green;">Applied and Forced</span>
156
                        [% CASE %]
157
                            <span style="color:red;">Status does not exist !</span>
158
                        [% END %]
159
                    [% END %]
160
                </td>
161
                <td>
162
                    [% FOREACH c IN v.comments %]
163
                        [% c.comment %]<br/>
164
                    [% END %]
165
                </td>
166
                <td width="50%">
167
                  [% IF v.available %]
168
                    <span style="display:block;"><a href="#" onclick="get_infos('[% v.version %]', this); return false;">Get comments</a></span>
169
                  [% ELSE %]
170
                    <div class="details" style="display:none;">
171
                      <div class="queries" style="display:block;">
172
                        <b>Queries</b> :
173
                        <ul>
174
                          [% FOREACH q IN v.queries %]
175
                            <li>[% q.query %]<br/></li>
176
                          [% END %]
177
                        </ul>
178
                      </div>
179
                      [% IF v.status == 1 %]
180
                        <div class="status" style="display:block;">
181
                          <b>Status</b> :
182
                          <span style="color:green;">OK</span>
183
                        </div>
184
                      [% ELSE %]
185
                        <div class="status" style="display:block;">
186
                          <b>Status</b> :
187
                          [% IF v.status == 2 %]
188
                            <span style="color:green;">OK</span>
189
                            [FORCED]
190
                          [% ELSE %]
191
                            <span style="color:red;">Failed</span>
192
                            [<a href="/cgi-bin/koha/admin/updatedatabase.pl?op=mark_as_ok&version=[% v.version %]">Mark as OK</a>]
193
                          [% END %]
194
                        </div>
195
                        <div class="errors" style="display:block;">
196
                          <b>Errors</b> :
197
                          <ul>
198
                            [% FOREACH e IN v.errors %]
199
                              <li><span>[% e.error %]</span></li>
200
                            [% END %]
201
                          </ul>
202
                        </div>
203
                      [% END %]
204
                    </div>
205
                    <a href="#" onclick="see_details(this);return false;">Show details</a>
206
                  [% END %]
207
                </td>
208
            </tr>
209
        [% END %]
210
        </tbody>
211
    </table>
212
213
    </div>
214
    </div>
215
    </div>
216
    </div>
217
    </div>
(-)a/mainpage.pl (+3 lines)
Lines 28-33 use C4::NewsChannels; Link Here
28
use C4::Review qw/numberofreviews/;
28
use C4::Review qw/numberofreviews/;
29
use C4::Suggestions qw/CountSuggestion/;
29
use C4::Suggestions qw/CountSuggestion/;
30
use C4::Tags qw/get_count_by_tag_status/;
30
use C4::Tags qw/get_count_by_tag_status/;
31
31
my $query     = new CGI;
32
my $query     = new CGI;
32
33
33
my ( $template, $loggedinuser, $cookie ) = get_template_and_user(
34
my ( $template, $loggedinuser, $cookie ) = get_template_and_user(
Lines 42-47 my ( $template, $loggedinuser, $cookie ) = get_template_and_user( Link Here
42
    }
43
    }
43
);
44
);
44
45
46
C4::Auth::version_check($query, 'intranet', $cookie);
47
45
my $all_koha_news   = &GetNewsToDisplay("koha");
48
my $all_koha_news   = &GetNewsToDisplay("koha");
46
my $koha_news_count = scalar @$all_koha_news;
49
my $koha_news_count = scalar @$all_koha_news;
47
50
(-)a/misc/bin/updatedb.pl (-1 / +115 lines)
Line 0 Link Here
0
- 
1
#!/usr/bin/perl
2
3
# Copyright Biblibre 2012
4
#
5
# This file is part of Koha.
6
#
7
# Koha is free software; you can redistribute it and/or modify it under the
8
# terms of the GNU General Public License as published by the Free Software
9
# Foundation; either version 2 of the License, or (at your option) any later
10
# version.
11
#
12
# Koha is distributed in the hope that it will be useful, but WITHOUT ANY
13
# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
14
# A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
15
#
16
# You should have received a copy of the GNU General Public License along
17
# with Koha; if not, write to the Free Software Foundation, Inc.,
18
# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
19
20
use Modern::Perl;
21
22
use C4::Context;
23
use C4::Update::Database;
24
use Getopt::Long;
25
26
my $help;
27
my $version;
28
my $list;
29
my $all;
30
my $min;
31
32
GetOptions(
33
    'h|help|?' => \$help,
34
    'm:s'      => \$version,
35
    'l|list'   => \$list,
36
    'a|all'    => \$all,
37
    'min:s'    => \$min,
38
);
39
40
if ( $help or not( $version or $list or $all ) ) {
41
    usage();
42
    exit;
43
}
44
45
my @reports;
46
if ($version) {
47
    my $report = C4::Update::Database::execute_version($version);
48
    push @reports, $report;
49
}
50
51
if ($list) {
52
    my $available       = C4::Update::Database::list_versions_available();
53
    my $already_applied = C4::Update::Database::list_versions_already_applied();
54
    say "Versions available:";
55
    for my $v (@$available) {
56
        if ( not grep { $v eq $_->{version} } @$already_applied ) {
57
            say "\t- $_" for $v;
58
        }
59
    }
60
    say "Versions already applied:";
61
    say "\t- $_->{version}" for @$already_applied;
62
63
}
64
65
if ($all) {
66
    my $versions_available = C4::Update::Database::list_versions_available();
67
    my $versions = C4::Update::Database::list_versions_already_applied;
68
    my $min_version =
69
        $min
70
      ? $min =~ m/\d\.\d{2}\.\d{2}\.\d{3}/
71
          ? C4::Update::Database::TransformToNum($min)
72
          : $min
73
      : 0;
74
75
    for my $v (@$versions_available) {
76
        # We execute ALL versions where version number >= min_version
77
        # OR version is not a number
78
        if ( not grep { $v eq $_->{version} } @$versions
79
            and ( not $v =~ /\d\.\d{2}\.\d{2}\.\d{3}/ or
80
                C4::Update::Database::TransformToNum($v) >= $min_version ) )
81
        {
82
            my $report = C4::Update::Database::execute_version $v;
83
            push @reports, $report;
84
        }
85
    }
86
}
87
88
if ( $version or $all ) {
89
    say @reports ? "Report:" : "Nothing to report";
90
    for my $report (@reports) {
91
        my ( $v, $r ) = each %$report;
92
        if ( ref($r) eq 'HASH' ) {
93
            say "\t$v => $r->{error}";
94
        }
95
        elsif ( ref($r) eq 'ARRAY' ) {
96
            say "\t$_" for @$r;
97
        }
98
        else {
99
            say "\t$v => $r";
100
        }
101
    }
102
}
103
104
sub usage {
105
    say "update.pl";
106
    say "This script updates your database for you";
107
    say "Usage:";
108
    say "\t-h\tShow this help message";
109
    say "\t-m\tExecute a given version";
110
    say "\t-l\tList all the versions";
111
    say "\t-all\tExecute all available versions";
112
    say
113
      "\t-min\tWith -all, Execute all available versions since a given version";
114
    say "\t\tCan be X.XX.XX.XXX or X.XXXXXXX";
115
}

Return to bug 7167