1 #!/usr/bin/perl -w # please develop with -w
11 use strict; # please develop with the strict pragma
16 my $step=$query->param('step');
18 my $language=$query->param('language');
19 my ($template, $loggedinuser, $cookie);
22 my $all_languages=getAllLanguages();
24 if (defined($language) ){
25 setlanguagecookie($query,$language,"install.pl?step=1");
27 ($template, $loggedinuser, $cookie)
28 = get_template_and_user({template_name => "installer/step".($step?$step:1).".tmpl",
36 $info{'dbname'}=C4::Context->config("database");
37 $info{'dbms'}=(C4::Context->config("db_scheme")?C4::Context->config("db_scheme"):"mysql");
38 $info{'hostname'}=C4::Context->config("hostname");
39 ($info{'hostname'},$info{'port'})=($1,$2) if $info{'hostname'}=~/([^:]*):([0-9]+)/;
40 $info{'user'}=C4::Context->config("user");
41 $info{'password'}=C4::Context->config("pass");
42 my $dbh= DBI->connect("DBI:$info{dbms}:$info{dbname}:$info{hostname}".($info{port}?":$info{port}":""),$info{'user'}, $info{'password'});
45 if ($step && $step==1){
47 #Checking ALL perl Modules and services needed are installed.
48 #Whenever there is an error, adding a report to the page
49 # I suppose here that Apache user can access /usr/bin/
50 # If mysql or zebra are in some fancy directory not in PATH
51 # Performing a disk search.
52 $template->param(language=>1);
55 unless ($] >= 5.006001) { # Bug 179
56 $template->param("problems"=>1,"perlversion"=>1);
59 unless (-x "/usr/bin/perl") {
60 my $realperl=`which perl`;
61 $realperl=`find / -name perl` unless ($realperl);
63 $template->param("problems"=>1,'perllocation'=>1) unless ($realperl);
64 $problem=1 unless($realperl);
66 unless (-x "/usr/local/bin/mysql") {
67 my $mysql=`which mysql`;
68 $mysql=`find / -name mysql` unless ($mysql);
70 $template->param("problems"=>1,'mysql'=>1) unless ($mysql);
71 $problem=1 unless($mysql);
73 unless (-x "/usr/local/bin/zebraidx" ||-x "/usr/local/bin/zebraidx-2.0") {
74 my $zebra=`which zebraidx`;
75 $zebra=`which zebraidx-2.0` unless ($zebra);
76 $zebra=`find / -name "zebraidx*"` unless ($zebra);
78 $template->param("problems"=>1,'zebra'=>1) unless ($zebra);
79 $problem=1 unless ($zebra);
81 unless (-x "/usr/local/bin/zebrasrv" ||-x "/usr/local/bin/zebrasrv-2.0") {
82 my $zebra=`which zebrasrv`;
83 $zebra=`which zebrasrv-2.0` unless ($zebra);
84 $zebra=`find / -name "zebrasrv*"` unless ($zebra);
86 $template->param("problems"=>1,'zebra'=>1) unless ($zebra);
87 $problem=1 unless ($zebra);
89 unless (-x "/usr/local/bin/yaz-client") {
90 my $yaz=`which yaz-client`;
91 $yaz=`find / -name "yaz-client*"` unless ($yaz);
93 $template->param("problems"=>1,'yaz'=>1) unless ($yaz);
94 $problem=1 unless ($yaz);
96 # We could here use a special find
98 unless (eval {require ZOOM}) {
99 push @missing, {name=>"ZOOM"};
101 unless (eval {require LWP::Simple}) {
102 push @missing, {name=>"LWP::Simple"};
104 unless (eval {require XML::Simple}) {
105 push @missing, {name=>"XML::Simple"};
107 unless (eval {require MARC::File::XML}) {
108 push @missing, {name=>"MARC::File::XML"};
110 unless (eval {require MARC::File::USMARC}) {
111 push @missing, {name=>"MARC::File::USMARC"};
113 unless (eval {require DBI}) { push @missing,{name=>"DBI"} };
114 unless (eval {require Date::Manip}) { push @missing,{name=>"Date::Manip"} };
115 unless (eval {require DBD::mysql}) { push @missing,{name=>"DBD::mysql"} };
116 unless (eval {require HTML::Template}) { push @missing,{name=>"HTML::Template::Pro"} };
117 unless (eval {require HTML::Template}) { push @missing,{name=>"Date::Calc"} };
118 unless (eval {require Digest::MD5}) { push @missing,{name=>"Digest::MD5"} };
119 unless (eval {require MARC::Record}) { push @missing,{name=>"MARC::Record"} };
120 unless (eval {require Mail::Sendmail}) { push @missing,{name=>"Mail::Sendmail",usagemail=>1} };
121 unless (eval {require List::MoreUtils}) { push @missing,{name=>"List::MoreUtils"} };
122 unless (eval {require XML::RSS}) { push @missing,{name=>"XML::RSS"} };
123 # The following modules are not mandatory, depends on how the library want to use Koha
124 unless (eval {require PDF::API2}) {
125 if ($#missing>=0) { # only when $#missing >= 0 so this isn't fatal
126 push @missing,{name=>"PDF::API2",usagebarcode=>1};
129 unless (eval {require GD::Barcorde}) {
130 if ($#missing>=0) { # only when $#missing >= 0 so this isn't fatal
131 push @missing,{name=>"GD::Barcode",usagebarcode=>1,usagespine=>1};
134 unless (eval {require Data::Random}) {
135 if ($#missing>=0) { # only when $#missing >= 0 so this isn't fatal
136 push @missing,{name=>"Data::Random",usagebarcode=>1};
139 unless (eval {require PDF::Reuse::Barcode}) {
140 if ($#missing>=0) { # only when $#missing >= 0 so this isn't fatal
141 push @missing,{name=>"PDF::Reuse::Barcode",usagebarcode=>1};
144 unless (eval {require PDF::Report}) {
145 if ($#missing>=0) { # only when $#missing >= 0 so this isn't fatal
146 push @missing,{name=>"PDF::Report",usagebarcode=>1};
149 unless (eval {require GD::Barcode::UPCE}) {
150 if ($#missing>=0) { # only when $#missing >= 0 so this isn't fatal
151 push @missing,{name=>"GD::Barcode::UPCE",usagepine=>1};
154 unless (eval {require Net::LDAP}) {
155 if ($#missing>=0) { # only when $#missing >= 0 so this isn't fatal
156 push @missing,{name=>"Net::LDAP",usageLDAP=>1};
160 $template->param(missings=>\@missing) if (scalar(@missing)>0);
161 $template->param('checkmodule'=>1) unless (scalar(@missing) && $problem);
163 } elsif ($step && $step==2){
164 # Check Database connection and access
165 $template->param(%info);
166 my $checkmysql=$query->param("checkmysql");
167 $template->param('mysqlconnection'=>$checkmysql);
170 # Can connect to the mysql
171 $template->param("checkdatabaseaccess"=>1);
172 if ($info{dbms} eq "mysql"){
173 #Check if database created
174 my $rv=$dbh->do("SHOW DATABASES LIKE \'$info{dbname}\'");
175 if ($rv==1){$template->param('checkdatabasecreated'=>1);}
176 #Check if user have all necessary grants on this database.
177 my $rq=$dbh->prepare("SHOW GRANTS FOR \'$info{user}\'\@'$info{hostname}'");
180 while (my ($line)=$rq->fetchrow){
181 my $dbname=$info{dbname};
182 if ($line=~m/$dbname/ || index($line,'*.*')>0){
183 $grantaccess=1 if (index($line,'ALL PRIVILEGES')>0 ||
184 ((index($line,'SELECT')>0)&&(index($line,'INSERT')>0)&&(index($line,'UPDATE')>0)&&(index($line,'DELETE')>0)&&(index($line,'CREATE')>0)&&(index($line,'DROP')>0)));
187 unless ($grantaccess){
188 $rq=$dbh->prepare("SHOW GRANTS FOR \'$info{user}\'\@'\%'");
190 while (my ($line)=$rq->fetchrow){
191 my $dbname=$info{dbname};
192 if ($line=~m/$dbname/ || index($line,'*.*')>0){
193 $grantaccess=1 if (index($line,'ALL PRIVILEGES')>0 ||
194 ((index($line,'SELECT')>0)&&(index($line,'INSERT')>0)&&(index($line,'UPDATE')>0)&&(index($line,'DELETE')>0)&&(index($line,'CREATE')>0)&&(index($line,'DROP')>0)));
198 $template->param("checkgrantaccess"=>$grantaccess);
201 $template->param("error"=>DBI::err,"message"=>DBI::errstr);
204 } elsif ($step && $step==3){
205 my $op=$query->param('op');
206 if ($op && $op eq 'finish'){
207 if (C4::Context->preference('Version')) {
208 warn "UPDATE Version";
209 my $finish=$dbh->prepare("UPDATE systempreferences SET value=? WHERE variable='Version'");
210 $finish->execute(C4::Context->config("kohaversion"));
212 warn "INSERT Version";
213 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')");
214 $finish->execute(C4::Context->config("kohaversion"));
216 # Installation is finished.
217 # We just deny anybody acess to install
218 # And we redirect people to mainpage.
219 # The installer wil have to relogin since we donot pass cookie to redirection.
220 $template->param("$op"=>1);
221 }elsif ($op && $op eq 'finished'){
222 print $query->redirect("/cgi-bin/koha/mainpage.pl");
224 } elsif ($op && $op eq 'addframeworks'){
225 #Framework importing and reports
228 # sort by filename -> prepend with numbers to specify order of insertion.
229 my @fnames = sort { my @aa = split /\/|\\/, ($a); my @bb = split /\/|\\/, ($b); $aa[-1] lt $bb[-1] } $query->param('framework') ;
230 $dbh->do('SET FOREIGN_KEY_CHECKS=0');
231 my $request=$dbh->prepare("SELECT value FROM systempreferences WHERE variable='FrameworksLoaded'");
233 my ($systempreference)=$request->fetchrow;
234 foreach my $file (@fnames){
237 my $strcmd="mysql ".($info{hostname}?" -h $info{hostname} ":"").($info{port}?" -P $info{port} ":"").($info{user}?" -u $info{user} ":"").($info{password}?" -p$info{password}":"")." $info{dbname} ";
238 my $error = qx($strcmd < $file 2>&1);
239 my @file = split qr(\/|\\),$file;
240 $lang=$file[scalar(@file)-3] unless ($lang);
241 my $level=$file[scalar(@file)-2];
243 $systempreference.="$file[scalar(@file)-1]|" unless(index($systempreference,$file[scalar(@file)-1])>=0);
245 #Bulding here a hierarchy to display files by level.
246 push @{$hashlevel{$level}},{"fwkname"=>$file[scalar(@file)-1],"error"=>$error};
248 #systempreference contains an ending |
249 chop $systempreference;
251 map {push @list,{"level"=>$_,"fwklist"=>$hashlevel{$_}}} keys %hashlevel;
253 for my $each_language(@$all_languages) {
254 # warn "CODE".$each_language->{'language_code'};
255 # warn "LANG:".$lang;
256 if ($lang eq $each_language->{'language_code'}) {
257 $fwk_language = $each_language->{language_locale_name};
260 my $updateflag=$dbh->do("UPDATE systempreferences set value=\"$systempreference\" where variable='FrameworksLoaded'");
261 unless ($updateflag==1){
262 my $string="INSERT INTO systempreferences (value, variable, explanation, type) VALUES (\"$systempreference\",'FrameworksLoaded','Frameworks loaded through webinstaller','choice')";
263 my $rq=$dbh->prepare($string);
266 $template->param("fwklanguage"=>$fwk_language,
268 $template->param("$op"=>1);
269 $dbh->do('SET FOREIGN_KEY_CHECKS=1');
270 } elsif ( $op && $op eq 'selectframeworks'){
272 #sql data for import are supposed to be located in misc/sql-datas/<language>/<level>
273 # Where <language> is en|fr or any international abbreviation (provided language hash is updated... This will be a problem with internationlisation.)
274 # Where <level> is a category of requirement : required, recommended optional
275 # level should contain :
276 # SQL File for import With a readable name.
277 # txt File taht explains what this SQL File is meant for.
278 # Could be VERY useful to have A Big file for a kind of library.
279 # But could also be useful to have some Authorised values data set prepared here.
280 # Framework Selection is achieved through checking boxes.
281 my $langchoice=$query->param('fwklanguage') ;
282 $langchoice=$query->cookie('KohaOpacLanguage') unless ($langchoice);
283 my $dir=C4::Context->config('intranetdir')."/misc/sql-datas/";
284 opendir (MYDIR,$dir);
285 my @listdir= grep { !/^\.|CVS/ && -d "$dir/$_"} readdir(MYDIR);
287 my $frmwklangs = getFrameworkLanguages();
290 push @languages,{'dirname'=>$_->{'language_code'}, 'languagedescription'=>$_->{'language_name'},'checked'=>($_->{'language_code'} eq $langchoice) } if ($_->{'language_code'});
292 $template->param("languagelist"=>\@languages);
294 $dir=C4::Context->config('intranetdir')."/misc/sql-datas/$langchoice";
295 opendir (MYDIR,$dir) || warn "no open $dir";
296 @listdir= grep { !/^\.|CVS/ && -d "$dir/$_"} readdir(MYDIR);
299 my $request=$dbh->prepare("SELECT value FROM systempreferences WHERE variable='FrameworksLoaded'");
301 my ($frameworksloaded)=$request->fetchrow;
302 my %frameworksloaded;
303 foreach (split(/\|/,$frameworksloaded)){
304 $frameworksloaded{$_}=1;
306 foreach my $requirelevel (@listdir){
307 $dir =C4::Context->config('intranetdir')."/misc/sql-datas/$langchoice/$requirelevel";
308 opendir (MYDIR,$dir);
309 my @listname = grep { !/^\.|CVS/ && -f "$dir/$_" && $_=~m/\.sql$/} readdir(MYDIR);
314 my $name=substr($_,0,-4);
315 open FILE, "< $dir/$name.txt";
317 $lines=~s/\n|\r/<br \/>/g;
319 utf8::encode($lines) unless (utf8::is_utf8($lines));
322 'fwkfile'=>"$dir/$_",
323 'fwkdescription'=>$lines,
324 'checked'=>(($frameworksloaded{$_}||($requirelevel=~/(mandatory|requi|oblig|necess)/i))?1:0)
327 my @fwks = sort { $a->{'fwkname'} lt $b->{'fwkname'} } @frameworklist;
328 # $cell{"mandatory"}=($requirelevel=~/(mandatory|requi|oblig|necess)/i);
329 $cell{"frameworks"}=\@fwks;
330 $cell{"label"}=ucfirst($requirelevel);
331 $cell{"code"}=lc($requirelevel);
332 push @levellist,\%cell;
334 $template->param("levelloop"=>\@levellist);
335 $template->param("$op"=>1);
336 } elsif ($op && $op eq 'updatestructure'){
337 #Do updatedatabase And report
338 my $execstring=C4::Context->config("intranetdir")."/updater/updatedatabase";
340 my $string= qx|$execstring 2>&1|;
342 $string=~s/\n|\r/<br \/>/g;
343 $string=~s/(DBD::mysql.*? failed: .*? line [0-9]*.|=================.*?====================)/<font color=red>$1<\/font>/g;
344 $template->param("updatereport"=>$string) ;
346 $template->param($op=>1)
347 }elsif ($op && $op eq 'importdatastructure'){
348 #Import data structure and show errors if any
349 #Uses DBI to read the file [MJR 2007-07-01]
350 my $dbh= DBI->connect("DBI:$info{dbms}:$info{dbname}:$info{hostname}".($info{port}?":$info{port}":""),$info{'user'}, $info{'password'});
351 open(INPUT,"<kohastructure.sql");
352 my $file=do{ local $/=undef; <INPUT>};
353 my @commands=split(/;/,$file);
355 map { $dbh->do($_)} @commands;
357 $template->param("error"=>$dbh->errstr ,
361 #Check if there are enough tables.
362 # Paul has cleaned up tables so reduced the count
363 #I put it there because it implied a data import if condition was not satisfied.
364 my $dbh= DBI->connect("DBI:$info{dbms}:$info{dbname}:$info{hostname}".($info{port}?":$info{port}":""),$info{'user'}, $info{'password'});
365 my $rq=$dbh->prepare("SHOW TABLES FROM ".$info{'dbname'});
367 my $data=$rq->fetchall_arrayref({});
368 my $count=scalar(@$data);
370 $template->param("count"=>$count,"proposeimport"=>1);
372 $template->param("count"=>$count,"default"=>1);
377 # LANGUAGE SELECTION page by default
378 # using opendir + language Hash
380 my $langavail = getTranslatedLanguages();
382 foreach (@$langavail){
383 push @languages,{'value'=>$_->{'language_code'}, 'description'=>$_->{'language_name'} } if ($_->{'language_code'});
385 $template->param(languages=>\@languages);
387 my $rq=$dbh->prepare("SELECT * from systempreferences WHERE variable='Version'");
389 my ($version)=$rq->fetchrow;
391 $query->redirect("install.pl?step=3");
396 output_html_with_http_headers $query, $cookie, $template->output;