adding Algorithm::CheckDigits dependancy, for barcode printing
[koha.git] / installer / install.pl
1 #!/usr/bin/perl -w # please develop with -w
2
3 #use diagnostics;
4
5 # use Install;
6 use InstallAuth;
7 use C4::Context;
8 use C4::Output;
9 use C4::Languages;
10
11 use strict;    # please develop with the strict pragma
12
13 use CGI;
14
15 my $query = new CGI;
16 my $step  = $query->param('step');
17
18 my $language = $query->param('language');
19 my ( $template, $loggedinuser, $cookie );
20
21 my $all_languages = getAllLanguages();
22
23 if ( defined($language) ) {
24     setlanguagecookie( $query, $language, "install.pl?step=1" );
25 }
26 ( $template, $loggedinuser, $cookie ) = get_template_and_user(
27     {
28         template_name => "installer/step" . ( $step ? $step : 1 ) . ".tmpl",
29         query         => $query,
30         type          => "intranet",
31         authnotrequired => 0,
32         debug           => 1,
33     }
34 );
35
36 my %info;
37 $info{'dbname'} = C4::Context->config("database");
38 $info{'dbms'} =
39   (   C4::Context->config("db_scheme")
40     ? C4::Context->config("db_scheme")
41     : "mysql" );
42 $info{'hostname'} = C4::Context->config("hostname");
43 ( $info{'hostname'}, $info{'port'} ) = ( $1, $2 )
44   if $info{'hostname'} =~ /([^:]*):([0-9]+)/;
45 $info{'user'}     = C4::Context->config("user");
46 $info{'password'} = C4::Context->config("pass");
47 my $dbh = DBI->connect(
48     "DBI:$info{dbms}:$info{dbname}:$info{hostname}"
49       . ( $info{port} ? ":$info{port}" : "" ),
50     $info{'user'}, $info{'password'}
51 );
52
53 if ( $step && $step == 1 ) {
54     #First Step
55     #Checking ALL perl Modules and services needed are installed.
56     #Whenever there is an error, adding a report to the page
57     # I suppose here that Apache user can access /usr/bin/
58     # If mysql or zebra are in some fancy directory not in PATH
59     # Performing a disk search.
60     $template->param( language => 1 );
61     my $problem;
62
63     unless ( $] >= 5.006001 ) {    # Bug 179
64         $template->param( "problems" => 1, "perlversion" => 1 );
65         $problem = 1;
66     }
67     unless ( -x "/usr/bin/perl" ) {
68         my $realperl = `which perl`;
69         $realperl = `find / -name perl` unless ($realperl);
70         chomp $realperl;
71         $template->param( "problems" => 1, 'perllocation' => 1 )
72           unless ($realperl);
73         $problem = 1 unless ($realperl);
74     }
75     unless ( -x "/usr/local/bin/mysql" ) {
76         my $mysql = `which mysql`;
77         $mysql = `find / -name mysql` unless ($mysql);
78         chomp $mysql;
79         $template->param( "problems" => 1, 'mysql' => 1 ) unless ($mysql);
80         $problem = 1 unless ($mysql);
81     }
82     unless ( -x "/usr/local/bin/zebraidx" || -x "/usr/local/bin/zebraidx-2.0" )
83     {
84         my $zebra = `which zebraidx`;
85         $zebra = `which zebraidx-2.0`       unless ($zebra);
86         $zebra = `find / -name "zebraidx*"` unless ($zebra);
87         chomp $zebra;
88         $template->param( "problems" => 1, 'zebra' => 1 ) unless ($zebra);
89         $problem = 1 unless ($zebra);
90     }
91     unless ( -x "/usr/local/bin/zebrasrv" || -x "/usr/local/bin/zebrasrv-2.0" )
92     {
93         my $zebra = `which zebrasrv`;
94         $zebra = `which zebrasrv-2.0`       unless ($zebra);
95         $zebra = `find / -name "zebrasrv*"` unless ($zebra);
96         chomp $zebra;
97         $template->param( "problems" => 1, 'zebra' => 1 ) unless ($zebra);
98         $problem = 1 unless ($zebra);
99     }
100     unless ( -x "/usr/local/bin/yaz-client" ) {
101         my $yaz = `which yaz-client`;
102         $yaz = `find / -name "yaz-client*"` unless ($yaz);
103         chomp $yaz;
104         $template->param( "problems" => 1, 'yaz' => 1 ) unless ($yaz);
105         $problem = 1 unless ($yaz);
106     }
107
108     # We could here use a special find
109     my @missing = ();
110     unless ( eval { require ZOOM } ) {
111         push @missing, { name => "ZOOM" };
112     }
113     unless ( eval { require LWP::Simple } ) {
114         push @missing, { name => "LWP::Simple" };
115     }
116     unless ( eval { require XML::Simple } ) {
117         push @missing, { name => "XML::Simple" };
118     }
119     unless ( eval { require MARC::File::XML } ) {
120         push @missing, { name => "MARC::File::XML" };
121     }
122     unless ( eval { require MARC::File::USMARC } ) {
123         push @missing, { name => "MARC::File::USMARC" };
124     }
125     unless ( eval { require DBI } ) {
126         push @missing, { name => "DBI" };
127     }
128     unless ( eval { require Date::Manip } ) {
129         push @missing, { name => "Date::Manip" };
130     }
131     unless ( eval { require DBD::mysql } ) {
132         push @missing, { name => "DBD::mysql" };
133     }
134     unless ( eval { require HTML::Template } ) {
135         push @missing, { name => "HTML::Template::Pro" };
136     }
137     unless ( eval { require HTML::Template } ) {
138         push @missing, { name => "Date::Calc" };
139     }
140     unless ( eval { require Digest::MD5 } ) {
141         push @missing, { name => "Digest::MD5" };
142     }
143     unless ( eval { require MARC::Record } ) {
144         push @missing, { name => "MARC::Record" };
145     }
146     unless ( eval { require Mail::Sendmail } ) {
147         push @missing, { name => "Mail::Sendmail", usagemail => 1 };
148     }
149     unless ( eval { require List::MoreUtils } ) {
150         push @missing, { name => "List::MoreUtils" };
151     }
152     unless ( eval { require XML::RSS } ) {
153         push @missing, { name => "XML::RSS" };
154     }
155
156 # The following modules are not mandatory, depends on how the library want to use Koha
157     unless ( eval { require PDF::API2 } ) {
158         if ( $#missing >= 0 ) {   # only when $#missing >= 0 so this isn't fatal
159             push @missing, { name => "PDF::API2", usagebarcode => 1 };
160         }
161     }
162     unless ( eval { require GD::Barcorde } ) {
163         if ( $#missing >= 0 ) {   # only when $#missing >= 0 so this isn't fatal
164             push @missing,
165               { name => "GD::Barcode", usagebarcode => 1, usagespine => 1 };
166         }
167     }
168     unless ( eval { require Data::Random } ) {
169         if ( $#missing >= 0 ) {   # only when $#missing >= 0 so this isn't fatal
170             push @missing, { name => "Data::Random", usagebarcode => 1 };
171         }
172     }
173     unless ( eval { require PDF::Reuse::Barcode } ) {
174         if ( $#missing >= 0 ) {   # only when $#missing >= 0 so this isn't fatal
175             push @missing, { name => "PDF::Reuse::Barcode", usagebarcode => 1 };
176         }
177     }
178     unless ( eval { require PDF::Report } ) {
179         if ( $#missing >= 0 ) {   # only when $#missing >= 0 so this isn't fatal
180             push @missing, { name => "PDF::Report", usagebarcode => 1 };
181         }
182     }
183     unless ( eval { require Net::LDAP } ) {
184         if ( $#missing >= 0 ) {   # only when $#missing >= 0 so this isn't fatal
185             push @missing, { name => "Algorithm::CheckDigits", usagebarcode => 1 };
186         }
187     }
188     unless ( eval { require GD::Barcode::UPCE } ) {
189         if ( $#missing >= 0 ) {   # only when $#missing >= 0 so this isn't fatal
190             push @missing, { name => "GD::Barcode::UPCE", usagepine => 1 };
191         }
192     }
193     unless ( eval { require Net::LDAP } ) {
194         if ( $#missing >= 0 ) {   # only when $#missing >= 0 so this isn't fatal
195             push @missing, { name => "Net::LDAP", usageLDAP => 1 };
196         }
197     }
198     $template->param( missings => \@missing ) if ( scalar(@missing) > 0 );
199     $template->param( 'checkmodule' => 1 )
200       unless ( scalar(@missing) && $problem );
201
202 }
203 elsif ( $step && $step == 2 ) {
204 #
205 #STEP 2 Check Database conn~ection and access
206 #
207     $template->param(%info);
208     my $checkmysql = $query->param("checkmysql");
209     $template->param( 'mysqlconnection' => $checkmysql );
210     if ($checkmysql) {
211         if ($dbh) {
212
213             # Can connect to the mysql
214             $template->param( "checkdatabaseaccess" => 1 );
215             if ( $info{dbms} eq "mysql" ) {
216
217                 #Check if database created
218                 my $rv = $dbh->do("SHOW DATABASES LIKE \'$info{dbname}\'");
219                 if ( $rv == 1 ) {
220                     $template->param( 'checkdatabasecreated' => 1 );
221                 }
222
223                 #Check if user have all necessary grants on this database.
224                 my $rq =
225                   $dbh->prepare(
226                     "SHOW GRANTS FOR \'$info{user}\'\@'$info{hostname}'");
227                 $rq->execute;
228                 my $grantaccess;
229                 while ( my ($line) = $rq->fetchrow ) {
230                     my $dbname = $info{dbname};
231                     if ( $line =~ m/$dbname/ || index( $line, '*.*' ) > 0 ) {
232                         $grantaccess = 1
233                           if (
234                             index( $line, 'ALL PRIVILEGES' ) > 0
235                             || (   ( index( $line, 'SELECT' ) > 0 )
236                                 && ( index( $line, 'INSERT' ) > 0 )
237                                 && ( index( $line, 'UPDATE' ) > 0 )
238                                 && ( index( $line, 'DELETE' ) > 0 )
239                                 && ( index( $line, 'CREATE' ) > 0 )
240                                 && ( index( $line, 'DROP' ) > 0 ) )
241                           );
242                     }
243                 }
244                 unless ($grantaccess) {
245                     $rq =
246                       $dbh->prepare("SHOW GRANTS FOR \'$info{user}\'\@'\%'");
247                     $rq->execute;
248                     while ( my ($line) = $rq->fetchrow ) {
249                         my $dbname = $info{dbname};
250                         if ( $line =~ m/$dbname/ || index( $line, '*.*' ) > 0 )
251                         {
252                             $grantaccess = 1
253                               if (
254                                 index( $line, 'ALL PRIVILEGES' ) > 0
255                                 || (   ( index( $line, 'SELECT' ) > 0 )
256                                     && ( index( $line, 'INSERT' ) > 0 )
257                                     && ( index( $line, 'UPDATE' ) > 0 )
258                                     && ( index( $line, 'DELETE' ) > 0 )
259                                     && ( index( $line, 'CREATE' ) > 0 )
260                                     && ( index( $line, 'DROP' ) > 0 ) )
261                               );
262                         }
263                     }
264                 }
265                 $template->param( "checkgrantaccess" => $grantaccess );
266             }
267         }
268         else {
269             $template->param( "error" => DBI::err, "message" => DBI::errstr );
270         }
271     }
272 }
273 elsif ( $step && $step == 3 ) {
274 #
275 #
276 # STEP 3 : database setup
277 #
278
279     my $op = $query->param('op');
280     if ( $op && $op eq 'finish' ) {
281     my $kohaversion=C4::Context::KOHAVERSION;
282     # remove the 3 last . to have a Perl number
283     $kohaversion =~ s/(.*\..*)\.(.*)\.(.*)/$1$2$3/;
284     if (C4::Context->preference('Version')) {
285         warn "UPDATE Version";
286       my $finish=$dbh->prepare("UPDATE systempreferences SET value=? WHERE variable='Version'");
287       $finish->execute($kohaversion);
288     } else {
289         warn "INSERT Version";
290       my $finish=$dbh->prepare("INSERT into systempreferences (variable,value,explanation) values ('Version',?,'The Koha database version. Don t change this value manually, it s holded by the webinstaller')");
291       $finish->execute($kohaversion);
292     }
293
294   # Installation is finished.
295   # We just deny anybody acess to install
296   # And we redirect people to mainpage.
297   # The installer wil have to relogin since we donot pass cookie to redirection.
298         $template->param( "$op" => 1 );
299     }
300     elsif ( $op && $op eq 'finished' ) {
301     #
302     #
303     # we have finished, just redirect to mainpage.
304     #
305     #
306         print $query->redirect("/cgi-bin/koha/mainpage.pl");
307         exit 1;
308     }
309     elsif ( $op && $op eq 'addframeworks' ) {
310     #
311     # 1ST install : insert the SQL files the user has selected
312     #
313
314         #Framework importing and reports
315         my $lang;
316         my %hashlevel;
317
318        # sort by filename -> prepend with numbers to specify order of insertion.
319         my @fnames = sort {
320             my @aa = split /\/|\\/, ($a);
321             my @bb = split /\/|\\/, ($b);
322             $aa[-1] lt $bb[-1]
323         } $query->param('framework');
324         $dbh->do('SET FOREIGN_KEY_CHECKS=0');
325         my $request =
326           $dbh->prepare(
327 "SELECT value FROM systempreferences WHERE variable='FrameworksLoaded'"
328           );
329         $request->execute;
330         my ($systempreference) = $request->fetchrow;
331         foreach my $file (@fnames) {
332
333             #      warn $file;
334             undef $/;
335             my $strcmd = "mysql "
336               . ( $info{hostname} ? " -h $info{hostname} " : "" )
337               . ( $info{port}     ? " -P $info{port} "     : "" )
338               . ( $info{user}     ? " -u $info{user} "     : "" )
339               . ( $info{password} ? " -p$info{password}"   : "" )
340               . " $info{dbname} ";
341             my $error = qx($strcmd < $file 2>&1);
342             my @file = split qr(\/|\\), $file;
343             $lang = $file[ scalar(@file) - 3 ] unless ($lang);
344             my $level = $file[ scalar(@file) - 2 ];
345             unless ($error) {
346                 $systempreference .= "$file[scalar(@file)-1]|"
347                   unless (
348                     index( $systempreference, $file[ scalar(@file) - 1 ] ) >=
349                     0 );
350             }
351
352             #Bulding here a hierarchy to display files by level.
353             push @{ $hashlevel{$level} },
354               { "fwkname" => $file[ scalar(@file) - 1 ], "error" => $error };
355         }
356
357         #systempreference contains an ending |
358         chop $systempreference;
359         my @list;
360         map { push @list, { "level" => $_, "fwklist" => $hashlevel{$_} } }
361           keys %hashlevel;
362         my $fwk_language;
363         for my $each_language (@$all_languages) {
364
365             #           warn "CODE".$each_language->{'language_code'};
366             #           warn "LANG:".$lang;
367             if ( $lang eq $each_language->{'language_code'} ) {
368                 $fwk_language = $each_language->{language_locale_name};
369             }
370         }
371         my $updateflag =
372           $dbh->do(
373 "UPDATE systempreferences set value=\"$systempreference\" where variable='FrameworksLoaded'"
374           );
375         unless ( $updateflag == 1 ) {
376             my $string =
377 "INSERT INTO systempreferences (value, variable, explanation, type) VALUES (\"$systempreference\",'FrameworksLoaded','Frameworks loaded through webinstaller','choice')";
378             my $rq = $dbh->prepare($string);
379             $rq->execute;
380         }
381         $template->param(
382             "fwklanguage" => $fwk_language,
383             "list"        => \@list
384         );
385         $template->param( "$op" => 1 );
386         $dbh->do('SET FOREIGN_KEY_CHECKS=1');
387     }
388     elsif ( $op && $op eq 'selectframeworks' ) {
389 #
390 #
391 # 1ST install : show the user the sql datas he can insert in the database.
392 #
393 #
394 # (note that the term "selectframeworks is not correct. The user can select various files, not only frameworks)
395
396 #Framework Selection
397 #sql data for import are supposed to be located in installer/data/<language>/<level>
398 # Where <language> is en|fr or any international abbreviation (provided language hash is updated... This will be a problem with internationlisation.)
399 # Where <level> is a category of requirement : required, recommended optional
400 # level should contain :
401 #   SQL File for import With a readable name.
402 #   txt File taht explains what this SQL File is meant for.
403 # Could be VERY useful to have A Big file for a kind of library.
404 # But could also be useful to have some Authorised values data set prepared here.
405 # Framework Selection is achieved through checking boxes.
406         my $langchoice = $query->param('fwklanguage');
407         $langchoice = $query->cookie('KohaOpacLanguage') unless ($langchoice);
408         my $dir = C4::Context->config('intranetdir') . "/installer/data/";
409         opendir( MYDIR, $dir );
410         my @listdir = grep { !/^\.|CVS/ && -d "$dir/$_" } readdir(MYDIR);
411         closedir MYDIR;
412         my $frmwklangs = getFrameworkLanguages();
413         my @languages;
414         map {
415             push @languages,
416               {
417                 'dirname'             => $_->{'language_code'},
418                 'languagedescription' => $_->{'language_name'},
419                 'checked' => ( $_->{'language_code'} eq $langchoice )
420               }
421               if ( $_->{'language_code'} );
422         } @$frmwklangs;
423         $template->param( "languagelist" => \@languages );
424         undef $/;
425         $dir =
426           C4::Context->config('intranetdir') . "/installer/data/$langchoice";
427         opendir( MYDIR, $dir ) || warn "no open $dir";
428         @listdir = grep { !/^\.|CVS/ && -d "$dir/$_" } readdir(MYDIR);
429         closedir MYDIR;
430         my @levellist;
431         my $request =
432           $dbh->prepare(
433 "SELECT value FROM systempreferences WHERE variable='FrameworksLoaded'"
434           );
435         $request->execute;
436         my ($frameworksloaded) = $request->fetchrow;
437         my %frameworksloaded;
438
439         foreach ( split( /\|/, $frameworksloaded ) ) {
440             $frameworksloaded{$_} = 1;
441         }
442         foreach my $requirelevel (@listdir) {
443             $dir =
444               C4::Context->config('intranetdir')
445               . "/installer/data/$langchoice/$requirelevel";
446             opendir( MYDIR, $dir );
447             my @listname =
448               grep { !/^\.|CVS/ && -f "$dir/$_" && $_ =~ m/\.sql$/ }
449               readdir(MYDIR);
450             closedir MYDIR;
451             my %cell;
452             my @frameworklist;
453             map {
454                 my $name = substr( $_, 0, -4 );
455                 open FILE, "< $dir/$name.txt";
456                 my $lines = <FILE>;
457                 $lines =~ s/\n|\r/<br \/>/g;
458                 use utf8;
459                 utf8::encode($lines) unless ( utf8::is_utf8($lines) );
460                 push @frameworklist,
461                   {
462                     'fwkname'        => $name,
463                     'fwkfile'        => "$dir/$_",
464                     'fwkdescription' => $lines,
465                     'checked'        => (
466                         (
467                             $frameworksloaded{$_}
468                               || ( $requirelevel =~
469                                 /(mandatory|requi|oblig|necess)/i )
470                         ) ? 1 : 0
471                     )
472                   };
473             } @listname;
474             my @fwks =
475               sort { $a->{'fwkname'} lt $b->{'fwkname'} } @frameworklist;
476
477   #       $cell{"mandatory"}=($requirelevel=~/(mandatory|requi|oblig|necess)/i);
478             $cell{"frameworks"} = \@fwks;
479             $cell{"label"}      = ucfirst($requirelevel);
480             $cell{"code"}       = lc($requirelevel);
481             push @levellist, \%cell;
482         }
483         $template->param( "levelloop" => \@levellist );
484         $template->param( "$op"       => 1 );
485     }
486     elsif ( $op && $op eq 'updatestructure' ) {
487
488         #Do updatedatabase And report
489         my $execstring =
490           C4::Context->config("intranetdir") . "/updater/updatedatabase";
491         undef $/;
492         my $string = qx|$execstring 2>&1|;
493         if ($string) {
494             $string =~ s/\n|\r/<br \/>/g;
495             $string =~
496 s/(DBD::mysql.*? failed: .*? line [0-9]*.|=================.*?====================)/<font color=red>$1<\/font>/g;
497             $template->param( "updatereport" => $string );
498         }
499         $template->param( $op => 1 );
500     }
501     elsif ( $op && $op eq 'importdatastructure' ) {
502     #
503     #
504     # UPDATE (not 1st install) run updatedatabase
505     #
506     #
507
508         #Import data structure and show errors if any
509         #Uses DBI to read the file [MJR 2007-07-01]
510         my $dbh = DBI->connect(
511             "DBI:$info{dbms}:$info{dbname}:$info{hostname}"
512               . ( $info{port} ? ":$info{port}" : "" ),
513             $info{'user'}, $info{'password'}
514         );
515         open( INPUT, "<kohastructure.sql" );
516         my $file = do { local $/ = undef; <INPUT> };
517         my @commands = split( /;/, $file );
518         pop @commands;
519         map { $dbh->do($_) } @commands;
520         close(INPUT);
521         $template->param(
522             "error" => $dbh->errstr,
523             "$op"   => 1,
524         );
525         $dbh->disconnect;
526     }
527     else {
528
529 #Check if there are enough tables.
530 # Paul has cleaned up tables so reduced the count
531 #I put it there because it implied a data import if condition was not satisfied.
532         my $dbh = DBI->connect(
533             "DBI:$info{dbms}:$info{dbname}:$info{hostname}"
534               . ( $info{port} ? ":$info{port}" : "" ),
535             $info{'user'}, $info{'password'}
536         );
537         my $rq = $dbh->prepare( "SHOW TABLES FROM " . $info{'dbname'} );
538         $rq->execute;
539         my $data = $rq->fetchall_arrayref( {} );
540         my $count = scalar(@$data);
541         #
542         # we don't have tables, propose DB import
543         #
544         if ( $count < 70 ) {
545             $template->param( "count" => $count, "proposeimport" => 1 );
546         }
547         else {
548             #
549             # we have tables, propose to select files to upload or updatedatabase
550             #
551             $template->param( "count" => $count, "default" => 1 );
552             #
553             # 1st part of step 3 : check if there is a databaseversion systempreference
554             # if there is, then we just need to upgrade
555             # if there is none, then we need to install the database
556             #
557             my $dbversion = C4::Context->preference('Version');
558             $dbversion =~ /(.*)\.(..)(..)(...)/;
559             $dbversion = "$1.$2.$3.$4";
560             if (C4::Context->preference('Version')) {
561                 $template->param("upgrading" => 1,
562                                 "dbversion" => $dbversion,
563                                 "kohaversion" => C4::Context->KOHAVERSION,
564                                 );
565             }
566         }
567
568         $dbh->disconnect;
569     }
570 }
571 else {
572
573     # LANGUAGE SELECTION page by default
574     # using opendir + language Hash
575
576     my $langavail = getTranslatedLanguages();
577
578     my @languages;
579     foreach (@$langavail) {
580         push @languages,
581           {
582             'value'       => $_->{'language_code'},
583             'description' => $_->{'language_name'}
584           }
585           if ( $_->{'language_code'} );
586     }
587     $template->param( languages => \@languages );
588     if ($dbh) {
589         my $rq =
590           $dbh->prepare(
591             "SELECT * from systempreferences WHERE variable='Version'");
592         if ( $rq->execute ) {
593             my ($version) = $rq->fetchrow;
594             if ($version) {
595                 $query->redirect("install.pl?step=3");
596             }
597         }
598     }
599 }
600 output_html_with_http_headers $query, $cookie, $template->output;