3 # Copyright (C) 2008 LibLime
5 # This file is part of Koha.
7 # Koha is free software; you can redistribute it and/or modify it
8 # under the terms of the GNU General Public License as published by
9 # the Free Software Foundation; either version 3 of the License, or
10 # (at your option) any later version.
12 # Koha is distributed in the hope that it will be useful, but
13 # WITHOUT ANY WARRANTY; without even the implied warranty of
14 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 # GNU General Public License for more details.
17 # You should have received a copy of the GNU General Public License
18 # along with Koha; if not, see <http://www.gnu.org/licenses>.
22 use Encode
qw( encode is_utf8 );
25 use C4
::Installer
::PerlModules
;
29 use vars
qw(@ISA @EXPORT);
32 @ISA = qw( Exporter );
33 push @EXPORT, qw( foreign_key_exists index_exists column_exists TableExists);
43 my $installer = C4::Installer->new();
44 my $all_languages = getAllLanguages();
45 my $error = $installer->load_db_schema();
47 #fill $list with list of sql files
48 my ($fwk_language, $error_list) = $installer->load_sql_in_order($all_languages, @$list);
49 $installer->set_version_syspref();
50 $installer->set_marcflavour_syspref('MARC21');
60 my $installer = C4::Installer->new();
62 Creates a new installer.
71 # get basic information from context
72 $self->{'dbname'} = C4
::Context
->config("database");
73 $self->{'dbms'} = C4
::Context
->config("db_scheme") ? C4
::Context
->config("db_scheme") : "mysql";
74 $self->{'hostname'} = C4
::Context
->config("hostname");
75 $self->{'port'} = C4
::Context
->config("port");
76 $self->{'user'} = C4
::Context
->config("user");
77 $self->{'password'} = C4
::Context
->config("pass");
78 $self->{'tls'} = C4
::Context
->config("tls");
79 if( $self->{'tls'} && $self->{'tls'} eq 'yes' ) {
80 $self->{'ca'} = C4
::Context
->config('ca');
81 $self->{'cert'} = C4
::Context
->config('cert');
82 $self->{'key'} = C4
::Context
->config('key');
83 $self->{'tlsoptions'} = ";mysql_ssl=1;mysql_ssl_client_key=".$self->{key
}.";mysql_ssl_client_cert=".$self->{cert
}.";mysql_ssl_ca_file=".$self->{ca
};
84 $self->{'tlscmdline'} = " --ssl-cert ". $self->{cert
} . " --ssl-key " . $self->{key
} . " --ssl-ca ".$self->{ca
}." "
86 $self->{'dbh'} = DBI
->connect("DBI:$self->{dbms}:dbname=$self->{dbname};host=$self->{hostname}" .
87 ( $self->{port
} ?
";port=$self->{port}" : "" ).
88 ( $self->{tlsoptions
} ?
$self->{tlsoptions
} : ""),
89 $self->{'user'}, $self->{'password'});
90 $self->{'language'} = undef;
91 $self->{'marcflavour'} = undef;
92 $self->{'dbh'}->do('set NAMES "utf8"');
93 $self->{'dbh'}->{'mysql_enable_utf8'}=1;
99 =head2 marc_framework_sql_list
101 my ($defaulted_to_en, $list) =
102 $installer->marc_framework_sql_list($lang, $marcflavour);
104 Returns in C<$list> a structure listing the filename, description, section,
105 and mandatory/optional status of MARC framework scripts available for C<$lang>
108 If the C<$defaulted_to_en> return value is true, no scripts are available
109 for language C<$lang> and the 'en' ones are returned.
113 sub marc_framework_sql_list
{
116 my $marcflavour = shift;
118 my $defaulted_to_en = 0;
121 my $dir = C4
::Context
->config('intranetdir') . "/installer/data/$self->{dbms}/$lang/marcflavour/".lc($marcflavour);
122 unless (opendir( MYDIR
, $dir )) {
124 warn "cannot open MARC frameworks directory $dir";
126 # if no translated MARC framework is available,
128 $dir = C4
::Context
->config('intranetdir') . "/installer/data/$self->{dbms}/en/marcflavour/".lc($marcflavour);
129 opendir(MYDIR
, $dir) or warn "cannot open English MARC frameworks directory $dir";
130 $defaulted_to_en = 1;
133 my @listdir = sort grep { !/^\.|marcflavour/ && -d
"$dir/$_" } readdir(MYDIR
);
137 my $request = $self->{'dbh'}->prepare("SELECT value FROM systempreferences WHERE variable='FrameworksLoaded'");
139 my ($frameworksloaded) = $request->fetchrow;
140 $frameworksloaded = '' unless defined $frameworksloaded; # avoid warning
141 my %frameworksloaded;
142 foreach ( split( /\|/, $frameworksloaded ) ) {
143 $frameworksloaded{$_} = 1;
146 foreach my $requirelevel (@listdir) {
147 opendir( MYDIR
, "$dir/$requirelevel" );
148 my @listname = grep { !/^\./ && -f
"$dir/$requirelevel/$_" && $_ =~ m/\.sql$/ } readdir(MYDIR
);
153 my $name = substr( $_, 0, -4 );
154 open my $fh, "<:encoding(UTF-8)", "$dir/$requirelevel/$name.txt";
156 $line = Encode
::encode
('UTF-8', $line) unless ( Encode
::is_utf8
($line) );
157 my @lines = split /\n/, $line;
158 my $mandatory = ($requirelevel =~ /(mandatory|requi|oblig|necess)/i);
162 'fwkfile' => "$dir/$requirelevel/$_",
163 'fwkdescription' => \
@lines,
164 'checked' => ( ( $frameworksloaded{$_} || $mandatory ) ?
1 : 0 ),
165 'mandatory' => $mandatory,
169 sort { $a->{'fwkname'} cmp $b->{'fwkname'} } @frameworklist;
171 $cell{"frameworks"} = \
@fwks;
172 $cell{"label"} = ucfirst($requirelevel);
173 $cell{"code"} = lc($requirelevel);
174 push @fwklist, \
%cell;
177 return ($defaulted_to_en, \
@fwklist);
180 =head2 sample_data_sql_list
182 my ($defaulted_to_en, $list) = $installer->sample_data_sql_list($lang);
184 Returns in C<$list> a structure listing the filename, description, section,
185 and mandatory/optional status of sample data scripts available for C<$lang>.
186 If the C<$defaulted_to_en> return value is true, no scripts are available
187 for language C<$lang> and the 'en' ones are returned.
191 sub sample_data_sql_list
{
195 my $defaulted_to_en = 0;
198 my $dir = C4
::Context
->config('intranetdir') . "/installer/data/$self->{dbms}/$lang";
199 unless (opendir( MYDIR
, $dir )) {
201 warn "cannot open sample data directory $dir";
203 # if no sample data is available,
205 $dir = C4
::Context
->config('intranetdir') . "/installer/data/$self->{dbms}/en";
206 opendir(MYDIR
, $dir) or warn "cannot open English sample data directory $dir";
207 $defaulted_to_en = 1;
210 my @listdir = sort grep { !/^\.|marcflavour/ && -d
"$dir/$_" } readdir(MYDIR
);
214 my $request = $self->{'dbh'}->prepare("SELECT value FROM systempreferences WHERE variable='FrameworksLoaded'");
216 my ($frameworksloaded) = $request->fetchrow;
217 $frameworksloaded = '' unless defined $frameworksloaded; # avoid warning
218 my %frameworksloaded;
219 foreach ( split( /\|/, $frameworksloaded ) ) {
220 $frameworksloaded{$_} = 1;
223 foreach my $requirelevel (@listdir) {
224 opendir( MYDIR
, "$dir/$requirelevel" );
225 my @listname = grep { !/^\./ && -f
"$dir/$requirelevel/$_" && $_ =~ m/\.sql$/ } readdir(MYDIR
);
230 my $name = substr( $_, 0, -4 );
231 open my $fh , "<:encoding(UTF-8)", "$dir/$requirelevel/$name.txt";
233 $line = Encode
::encode
('UTF-8', $line) unless ( Encode
::is_utf8
($line) );
234 my @lines = split /\n/, $line;
235 my $mandatory = ($requirelevel =~ /(mandatory|requi|oblig|necess)/i);
239 'fwkfile' => "$dir/$requirelevel/$_",
240 'fwkdescription' => \
@lines,
241 'checked' => ( ( $frameworksloaded{$_} || $mandatory ) ?
1 : 0 ),
242 'mandatory' => $mandatory,
245 my @fwks = sort { $a->{'fwkname'} cmp $b->{'fwkname'} } @frameworklist;
247 $cell{"frameworks"} = \
@fwks;
248 $cell{"label"} = ucfirst($requirelevel);
249 $cell{"code"} = lc($requirelevel);
250 push @levellist, \
%cell;
253 return ($defaulted_to_en, \
@levellist);
256 =head2 load_db_schema
258 my $error = $installer->load_db_schema();
260 Loads the SQL script that creates Koha's tables and indexes. The
261 return value is a string containing error messages reported by the
269 my $datadir = C4
::Context
->config('intranetdir') . "/installer/data/$self->{dbms}";
270 my $error = $self->load_sql("$datadir/kohastructure.sql");
275 =head2 load_sql_in_order
277 my ($fwk_language, $list) = $installer->load_sql_in_order($all_languages, @sql_list);
279 Given a list of SQL scripts supplied in C<@sql_list>, loads each of them
280 into the database and sets the FrameworksLoaded system preference to names
281 of the scripts that were loaded.
283 The SQL files are loaded in alphabetical order by filename (not including
284 directory path). This means that dependencies among the scripts are to
285 be resolved by carefully naming them, keeping in mind that the directory name
286 does *not* currently count.
288 B<FIXME:> this is a rather delicate way of dealing with dependencies between
291 The return value C<$list> is an arrayref containing a hashref for each
292 "level" or directory containing SQL scripts; the hashref in turns contains
293 a list of hashrefs containing a list of each script load and any error
294 messages associated with the loading of each script.
296 B<FIXME:> The C<$fwk_language> code probably doesn't belong and needs to be
297 moved to a different method.
301 sub load_sql_in_order
{
303 my $all_languages = shift;
309 my @aa = split /\/|\\/, ($a);
310 my @bb = split /\/|\\/, ($b);
313 my $request = $self->{'dbh'}->prepare( "SELECT value FROM systempreferences WHERE variable='FrameworksLoaded'" );
315 my ($systempreference) = $request->fetchrow;
316 $systempreference = '' unless defined $systempreference; # avoid warning
318 my $global_mandatory_dir = C4
::Context
->config('intranetdir') . "/installer/data/$self->{dbms}/mandatory";
320 # Make sure some stuffs are loaded first
321 unshift(@fnames, C4
::Context
->config('intranetdir') . "/installer/data/$self->{dbms}/sysprefs.sql");
323 "$global_mandatory_dir/subtag_registry.sql",
324 "$global_mandatory_dir/auth_val_cat.sql",
325 "$global_mandatory_dir/message_transport_types.sql",
326 "$global_mandatory_dir/sample_notices_message_attributes.sql",
327 "$global_mandatory_dir/sample_notices_message_transports.sql",
328 "$global_mandatory_dir/keyboard_shortcuts.sql",
331 push @fnames, C4
::Context
->config('intranetdir') . "/installer/data/mysql/userflags.sql";
332 push @fnames, C4
::Context
->config('intranetdir') . "/installer/data/mysql/userpermissions.sql";
333 push @fnames, C4
::Context
->config('intranetdir') . "/installer/data/mysql/audio_alerts.sql";
334 push @fnames, C4
::Context
->config('intranetdir') . "/installer/data/mysql/account_offset_types.sql";
335 push @fnames, C4
::Context
->config('intranetdir') . "/installer/data/mysql/account_credit_types.sql";
336 push @fnames, C4
::Context
->config('intranetdir') . "/installer/data/mysql/account_debit_types.sql";
337 foreach my $file (@fnames) {
340 my $error = $self->load_sql($file);
341 my @file = split qr
(\
/|\\), $file;
342 $lang = $file[ scalar(@file) - 3 ] unless ($lang);
343 my $level = $file[ scalar(@file) - 2 ];
345 $systempreference .= "$file[scalar(@file)-1]|"
346 unless ( index( $systempreference, $file[ scalar(@file) - 1 ] ) >= 0 );
349 #Bulding here a hierarchy to display files by level.
350 push @
{ $hashlevel{$level} },
351 { "fwkname" => $file[ scalar(@file) - 1 ], "error" => $error };
354 #systempreference contains an ending |
355 chop $systempreference;
357 map { push @list, { "level" => $_, "fwklist" => $hashlevel{$_} } } keys %hashlevel;
359 for my $each_language (@
$all_languages) {
361 # warn "CODE".$each_language->{'language_code'};
362 # warn "LANG:".$lang;
363 if ( $lang eq $each_language->{'language_code'} ) {
364 $fwk_language = $each_language->{language_locale_name
};
369 "UPDATE systempreferences set value=\"$systempreference\" where variable='FrameworksLoaded'"
372 unless ( $updateflag == 1 ) {
374 "INSERT INTO systempreferences (value, variable, explanation, type) VALUES (\"$systempreference\",'FrameworksLoaded','Frameworks loaded through webinstaller','choice')";
375 my $rq = $self->{'dbh'}->prepare($string);
378 return ($fwk_language, \
@list);
381 =head2 set_marcflavour_syspref
383 $installer->set_marcflavour_syspref($marcflavour);
385 Set the 'marcflavour' system preference. The incoming
386 C<$marcflavour> references to a subdirectory of
387 installer/data/$dbms/$lang/marcflavour, and is
388 normalized to MARC21, UNIMARC or NORMARC.
390 FIXME: this method assumes that the MARC flavour will be either
391 MARC21, UNIMARC or NORMARC.
395 sub set_marcflavour_syspref
{
397 my $marcflavour = shift;
399 # we can have some variants of marc flavour, by having different directories, like : unimarc_small and unimarc_full, for small and complete unimarc frameworks.
400 # marc_cleaned finds the marcflavour, without the variant.
401 my $marc_cleaned = 'MARC21';
402 $marc_cleaned = 'UNIMARC' if $marcflavour =~ /unimarc/i;
403 $marc_cleaned = 'NORMARC' if $marcflavour =~ /normarc/i;
405 $self->{'dbh'}->prepare(
406 "INSERT IGNORE INTO `systempreferences` (variable,value,explanation,options,type) VALUES('marcflavour','$marc_cleaned','Define global MARC flavor (MARC21, UNIMARC or NORMARC) used for character encoding','MARC21|UNIMARC|NORMARC','Choice');"
411 =head2 set_version_syspref
413 $installer->set_version_syspref();
415 Set or update the 'Version' system preference to the current
416 Koha software version.
420 sub set_version_syspref
{
423 my $kohaversion = Koha
::version
();
424 # remove the 3 last . to have a Perl number
425 $kohaversion =~ s/(.*\..*)\.(.*)\.(.*)/$1$2$3/;
426 if (C4
::Context
->preference('Version')) {
427 warn "UPDATE Version";
428 my $finish=$self->{'dbh'}->prepare("UPDATE systempreferences SET value=? WHERE variable='Version'");
429 $finish->execute($kohaversion);
431 warn "INSERT Version";
432 my $finish=$self->{'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')");
433 $finish->execute($kohaversion);
435 C4
::Context
->clear_syspref_cache();
440 my $error = $installer->load_sql($filename);
442 Runs a the specified SQL file using a sql loader DBIx::RunSQL
443 Returns any strings sent to STDERR
445 # FIXME This should be improved: sometimes the caller and load_sql warn the same
452 my $filename = shift;
455 my $dbh = $self->{ dbh
};
460 open STDERR
, ">>", \
$dup_stderr;
463 DBIx
::RunSQL
->run_sql_file(
469 # errors thrown while loading installer data should be logged
471 warn "C4::Installer::load_sql returned the following errors while attempting to load $filename:\n";
472 $error = $dup_stderr;
478 =head2 get_file_path_from_name
480 my $filename = $installer->get_file_path_from_name('script_name');
482 searches through the set of known SQL scripts and finds the fully
483 qualified path name for the script that mathches the input.
485 returns undef if no match was found.
490 sub get_file_path_from_name
{
492 my $partialname = shift;
494 my $lang = 'en'; # FIXME: how do I know what language I want?
496 my ($defaulted_to_en, $list) = $self->sample_data_sql_list($lang);
497 # warn( Data::Dumper->Dump( [ $list ], [ 'list' ] ) );
500 foreach my $frameworklist ( @
$list ) {
501 push @found, grep { $_->{'fwkfile'} =~ /$partialname$/ } @
{$frameworklist->{'frameworks'}};
504 # warn( Data::Dumper->Dump( [ \@found ], [ 'found' ] ) );
505 if ( 0 == scalar @found ) {
507 } elsif ( 1 < scalar @found ) {
508 warn "multiple results found for $partialname";
511 return $found[0]->{'fwkfile'};
516 sub foreign_key_exists
{
517 my ( $table_name, $constraint_name ) = @_;
518 my $dbh = C4
::Context
->dbh;
519 my (undef, $infos) = $dbh->selectrow_array(qq|SHOW CREATE TABLE
$table_name|);
520 return $infos =~ m
|CONSTRAINT
`$constraint_name` FOREIGN KEY
|;
524 my ( $table_name, $key_name ) = @_;
525 my $dbh = C4
::Context
->dbh;
526 my ($exists) = $dbh->selectrow_array(
528 SHOW INDEX FROM
$table_name
536 my ( $table_name, $column_name ) = @_;
537 return unless TableExists
($table_name);
538 my $dbh = C4
::Context
->dbh;
539 my ($exists) = $dbh->selectrow_array(
541 SHOW COLUMNS FROM
$table_name
543 |, undef, $column_name
548 sub TableExists
{ # Could be renamed table_exists for consistency
551 my $dbh = C4
::Context
->dbh;
552 local $dbh->{PrintError
} = 0;
553 local $dbh->{RaiseError
} = 1;
554 $dbh->do(qq{SELECT
* FROM
$table WHERE
1 = 0 });
563 C4::Installer is a refactoring of logic originally from installer/installer.pl, which was
564 originally written by Henri-Damien Laurant.
566 Koha Development Team <http://koha-community.org/>
568 Galen Charlton <galen.charlton@liblime.com>