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
  22 my $all_languages=getAllLanguages();
  23
  24 if (defined($language) ){
  25   setlanguagecookie($query,$language,"install.pl?step=1");
  26 }
  27 ($template, $loggedinuser, $cookie)
  28         = get_template_and_user({template_name => "installer/step".($step?$step:1).".tmpl",
  29                 query => $query,
  30                 type => "intranet",
  31                 authnotrequired => 0,
  32                 debug => 1,
  33                 });
  34
  35 my %info;
  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'});
  43
  44
  45 if ($step && $step==1){
  46   #First Step
  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);
  53   my $problem;
  54
  55   unless ($] >= 5.006001) {                     # Bug 179
  56       $template->param("problems"=>1,"perlversion"=>1);
  57       $problem=1;
  58   }
  59   unless (-x "/usr/bin/perl") {
  60     my $realperl=`which perl`;
  61     $realperl=`find / -name perl` unless ($realperl);
  62     chomp $realperl;
  63     $template->param("problems"=>1,'perllocation'=>1) unless ($realperl);
  64     $problem=1 unless($realperl);
  65   }
  66   unless (-x "/usr/local/bin/mysql") {
  67     my $mysql=`which mysql`;
  68     $mysql=`find / -name mysql` unless ($mysql);
  69     chomp $mysql;
  70     $template->param("problems"=>1,'mysql'=>1) unless ($mysql);
  71     $problem=1 unless($mysql);
  72   }
  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);
  77     chomp $zebra;
  78     $template->param("problems"=>1,'zebra'=>1) unless ($zebra);
  79     $problem=1 unless ($zebra);
  80   }
  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);
  85     chomp $zebra;
  86     $template->param("problems"=>1,'zebra'=>1) unless ($zebra);
  87     $problem=1 unless ($zebra);
  88   }
  89   unless (-x "/usr/local/bin/yaz-client") {
  90     my $yaz=`which yaz-client`;
  91     $yaz=`find / -name "yaz-client*"` unless ($yaz);
  92     chomp $yaz;
  93     $template->param("problems"=>1,'yaz'=>1) unless ($yaz);
  94     $problem=1 unless ($yaz);
  95   }
  96   # We could here use a special find
  97   my @missing = ();
  98   unless (eval {require ZOOM})       {
  99           push @missing, {name=>"ZOOM"};
 100   }
 101   unless (eval {require LWP::Simple})       {
 102           push @missing, {name=>"LWP::Simple"};
 103   }
 104   unless (eval {require XML::Simple})       {
 105           push @missing, {name=>"XML::Simple"};
 106   }
 107   unless (eval {require MARC::File::XML})       {
 108           push @missing, {name=>"MARC::File::XML"};
 109   }
 110   unless (eval {require MARC::File::USMARC})       {
 111           push @missing, {name=>"MARC::File::USMARC"};
 112   }
 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 # The following modules are not mandatory, depends on how the library want to use Koha
 123   unless (eval {require PDF::API2})   {
 124           if ($#missing>=0) { # only when $#missing >= 0 so this isn't fatal
 125               push @missing,{name=>"PDF::API2",usagebarcode=>1};
 126           }
 127   }
 128   unless (eval {require GD::Barcorde})   {
 129     if ($#missing>=0) { # only when $#missing >= 0 so this isn't fatal
 130       push @missing,{name=>"GD::Barcode",usagebarcode=>1,usagespine=>1};
 131     }
 132   }
 133   unless (eval {require Data::Random})   {
 134     if ($#missing>=0) { # only when $#missing >= 0 so this isn't fatal
 135       push @missing,{name=>"Data::Random",usagebarcode=>1};
 136     }
 137   }
 138   unless (eval {require PDF::Reuse::Barcode})   {
 139     if ($#missing>=0) { # only when $#missing >= 0 so this isn't fatal
 140       push @missing,{name=>"PDF::Reuse::Barcode",usagebarcode=>1};
 141     }
 142   }
 143   unless (eval {require PDF::Report})   {
 144     if ($#missing>=0) { # only when $#missing >= 0 so this isn't fatal
 145       push @missing,{name=>"PDF::Report",usagebarcode=>1};
 146     }
 147   }
 148   unless (eval {require GD::Barcode::UPCE})   {
 149     if ($#missing>=0) { # only when $#missing >= 0 so this isn't fatal
 150       push @missing,{name=>"GD::Barcode::UPCE",usagepine=>1};
 151     }
 152   }
 153   unless (eval {require Net::LDAP})       {
 154     if ($#missing>=0) { # only when $#missing >= 0 so this isn't fatal
 155       push @missing,{name=>"Net::LDAP",usageLDAP=>1};
 156     }
 157   }
 158
 159   $template->param(missings=>\@missing) if (scalar(@missing)>0);
 160   $template->param('checkmodule'=>1) unless (scalar(@missing) && $problem);
 161
 162 } elsif ($step && $step==2){
 163   # Check Database connection and access
 164   $template->param(%info);
 165   my $checkmysql=$query->param("checkmysql");
 166   $template->param('mysqlconnection'=>$checkmysql);
 167   if ($checkmysql){
 168     if ($dbh){
 169       # Can connect to the mysql
 170       $template->param("checkdatabaseaccess"=>1);
 171       if ($info{dbms} eq "mysql"){
 172         #Check if database created
 173         my $rv=$dbh->do("SHOW DATABASES LIKE \'$info{dbname}\'");
 174         if ($rv==1){$template->param('checkdatabasecreated'=>1);}
 175         #Check if user have all necessary grants on this database.
 176         my $rq=$dbh->prepare("SHOW GRANTS FOR \'$info{user}\'\@'$info{hostname}'");
 177         $rq->execute;
 178         my $grantaccess;
 179         while (my ($line)=$rq->fetchrow){
 180           my $dbname=$info{dbname};
 181           if ($line=~m/$dbname/ || index($line,'*.*')>0){
 182             $grantaccess=1 if (index($line,'ALL PRIVILEGES')>0 ||
 183             ((index($line,'SELECT')>0)&&(index($line,'INSERT')>0)&&(index($line,'UPDATE')>0)&&(index($line,'DELETE')>0)&&(index($line,'CREATE')>0)&&(index($line,'DROP')>0)));
 184           }
 185         }
 186         unless ($grantaccess){
 187           $rq=$dbh->prepare("SHOW GRANTS FOR \'$info{user}\'\@'\%'");
 188           $rq->execute;
 189           while (my ($line)=$rq->fetchrow){
 190             my $dbname=$info{dbname};
 191             if ($line=~m/$dbname/ || index($line,'*.*')>0){
 192               $grantaccess=1 if (index($line,'ALL PRIVILEGES')>0 ||
 193               ((index($line,'SELECT')>0)&&(index($line,'INSERT')>0)&&(index($line,'UPDATE')>0)&&(index($line,'DELETE')>0)&&(index($line,'CREATE')>0)&&(index($line,'DROP')>0)));
 194             }
 195           }
 196         }
 197         $template->param("checkgrantaccess"=>$grantaccess);
 198       }
 199     } else {
 200       $template->param("error"=>DBI::err,"message"=>DBI::errstr);
 201     }
 202   }
 203 } elsif ($step && $step==3){
 204   my $op=$query->param('op');
 205   if ($op && $op eq 'finish'){
 206     if (C4::Context->preference('Version')) {
 207         warn "UPDATE Version";
 208       my $finish=$dbh->prepare("UPDATE systempreferences SET value=? WHERE variable='Version'");
 209       $finish->execute(C4::Context->config("kohaversion"));
 210     } else {
 211         warn "INSERT Version";
 212       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')");
 213       $finish->execute(C4::Context->config("kohaversion"));
 214     }
 215     # Installation is finished.
 216     # We just deny anybody acess to install
 217     # And we redirect people to mainpage.
 218     # The installer wil have to relogin since we donot pass cookie to redirection.
 219     $template->param("$op"=>1);
 220   }elsif ($op && $op eq 'finished'){
 221     print $query->redirect("/cgi-bin/koha/mainpage.pl");
 222     exit 1;
 223   } elsif ($op && $op eq 'addframeworks'){
 224     #Framework importing and reports
 225     my $lang;
 226     my %hashlevel;
 227    # sort by filename -> prepend with numbers to specify order of insertion.
 228     my @fnames = sort { my @aa = split /\/|\\/, ($a); my @bb = split /\/|\\/, ($b); $aa[-1] lt $bb[-1] } $query->param('framework')  ;
 229         $dbh->do('SET FOREIGN_KEY_CHECKS=0');
 230     my $request=$dbh->prepare("SELECT value FROM systempreferences WHERE variable='FrameworksLoaded'");
 231     $request->execute;
 232     my ($systempreference)=$request->fetchrow;
 233     foreach my $file (@fnames){
 234 #      warn $file;
 235       undef $/;
 236       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} ";
 237       my $error = qx($strcmd < $file 2>&1);
 238       my @file = split qr(\/|\\),$file;
 239       $lang=$file[scalar(@file)-3] unless ($lang);
 240       my $level=$file[scalar(@file)-2];
 241       unless ($error){
 242         $systempreference.="$file[scalar(@file)-1]|" unless(index($systempreference,$file[scalar(@file)-1])>=0);
 243       }
 244       #Bulding here a hierarchy to display files by level.
 245       push @{$hashlevel{$level}},{"fwkname"=>$file[scalar(@file)-1],"error"=>$error};
 246     }
 247     #systempreference contains an ending |
 248     chop $systempreference;
 249     my @list;
 250     map {push @list,{"level"=>$_,"fwklist"=>$hashlevel{$_}}} keys %hashlevel;
 251     my $fwk_language;
 252     for my $each_language(@$all_languages) {
 253 #               warn "CODE".$each_language->{'language_code'};
 254 #               warn "LANG:".$lang;
 255       if ($lang eq $each_language->{'language_code'}) {
 256               $fwk_language = $each_language->{language_locale_name};
 257       }
 258     }
 259     my $updateflag=$dbh->do("UPDATE systempreferences set value=\"$systempreference\" where variable='FrameworksLoaded'");
 260     unless ($updateflag==1){
 261       my $string="INSERT INTO systempreferences (value, variable, explanation, type) VALUES (\"$systempreference\",'FrameworksLoaded','Frameworks loaded through webinstaller','choice')";
 262       my $rq=$dbh->prepare($string);
 263       $rq->execute;
 264     }
 265     $template->param("fwklanguage"=>$fwk_language,
 266                      "list"=>\@list);
 267     $template->param("$op"=>1);
 268         $dbh->do('SET FOREIGN_KEY_CHECKS=1');
 269   } elsif ( $op && $op eq 'selectframeworks'){
 270     #Framework Selection
 271     #sql data for import are supposed to be located in misc/sql-datas/<language>/<level>
 272     # Where <language> is en|fr or any international abbreviation (provided language hash is updated... This will be a problem with internationlisation.)
 273     # Where <level> is a category of requirement : required, recommended optional
 274     # level should contain :
 275     #   SQL File for import With a readable name.
 276     #   txt File taht explains what this SQL File is meant for.
 277     # Could be VERY useful to have A Big file for a kind of library.
 278     # But could also be useful to have some Authorised values data set prepared here.
 279     # Framework Selection is achieved through checking boxes.
 280     my $langchoice=$query->param('fwklanguage') ;
 281     $langchoice=$query->cookie('KohaOpacLanguage') unless ($langchoice);
 282     my $dir=C4::Context->config('intranetdir')."/misc/sql-datas/";
 283     opendir (MYDIR,$dir);
 284     my @listdir= grep { !/^\.|CVS/ && -d "$dir/$_"} readdir(MYDIR);
 285     closedir MYDIR;
 286     my $frmwklangs = getFrameworkLanguages();
 287     my @languages;
 288     map{
 289       push @languages,{'dirname'=>$_->{'language_code'}, 'languagedescription'=>$_->{'language_name'},'checked'=>($_->{'language_code'} eq $langchoice) } if ($_->{'language_code'});
 290     } @$frmwklangs;
 291     $template->param("languagelist"=>\@languages);
 292     undef $/;
 293     $dir=C4::Context->config('intranetdir')."/misc/sql-datas/$langchoice";
 294     opendir (MYDIR,$dir) || warn "no open $dir";
 295     @listdir= grep { !/^\.|CVS/ && -d "$dir/$_"} readdir(MYDIR);
 296     closedir MYDIR;
 297     my @levellist;
 298     my $request=$dbh->prepare("SELECT value FROM systempreferences WHERE variable='FrameworksLoaded'");
 299     $request->execute;
 300     my ($frameworksloaded)=$request->fetchrow;
 301     my %frameworksloaded;
 302     foreach (split(/\|/,$frameworksloaded)){
 303       $frameworksloaded{$_}=1;
 304     }
 305     foreach my $requirelevel (@listdir){
 306       $dir =C4::Context->config('intranetdir')."/misc/sql-datas/$langchoice/$requirelevel";
 307       opendir (MYDIR,$dir);
 308       my @listname = grep { !/^\.|CVS/ && -f "$dir/$_" && $_=~m/\.sql$/} readdir(MYDIR);
 309       closedir MYDIR;
 310       my %cell;
 311       my @frameworklist;
 312       map{
 313         my $name=substr($_,0,-4);
 314         open FILE, "< $dir/$name.txt";
 315         my $lines = <FILE>;
 316         $lines=~s/\n|\r/<br \/>/g;
 317         use utf8;
 318         utf8::encode($lines) unless (utf8::is_utf8($lines));
 319         push @frameworklist,
 320           {'fwkname'=>$name,
 321            'fwkfile'=>"$dir/$_",
 322            'fwkdescription'=>$lines,
 323            'checked'=>(($frameworksloaded{$_}||($requirelevel=~/(mandatory|requi|oblig|necess)/i))?1:0)
 324           };
 325       } @listname;
 326       my @fwks = sort { $a->{'fwkname'} lt $b->{'fwkname'} } @frameworklist;
 327 #       $cell{"mandatory"}=($requirelevel=~/(mandatory|requi|oblig|necess)/i);
 328       $cell{"frameworks"}=\@fwks;
 329       $cell{"label"}=ucfirst($requirelevel);
 330       $cell{"code"}=lc($requirelevel);
 331       push @levellist,\%cell;
 332     }
 333     $template->param("levelloop"=>\@levellist);
 334     $template->param("$op"=>1);
 335   } elsif ($op && $op eq 'updatestructure'){
 336     #Do updatedatabase And report
 337     my $execstring=C4::Context->config("intranetdir")."/updater/updatedatabase";
 338     undef $/;
 339     my $string= qx|$execstring 2>&1|;
 340     if ($string){
 341       $string=~s/\n|\r/<br \/>/g;
 342       $string=~s/(DBD::mysql.*? failed: .*? line [0-9]*.|=================.*?====================)/<font color=red>$1<\/font>/g;
 343       $template->param("updatereport"=>$string) ;
 344     }
 345     $template->param($op=>1)
 346   }elsif ($op && $op eq 'importdatastructure'){
 347     #Import data structure and show errors if any
 348         #Uses DBI to read the file [MJR 2007-07-01]
 349     my $dbh= DBI->connect("DBI:$info{dbms}:$info{dbname}:$info{hostname}".($info{port}?":$info{port}":""),$info{'user'}, $info{'password'});
 350       open(INPUT,"<kohastructure.sql");
 351       my $file=do{ local $/=undef; <INPUT>};
 352       my @commands=split(/;/,$file);
 353       pop @commands;
 354       map { $dbh->do($_)} @commands;
 355       close(INPUT);
 356         $template->param("error"=>$dbh->errstr ,
 357                          "$op"=> 1, );
 358     $dbh->disconnect;
 359   } else {
 360     #Check if there are enough tables.
 361     # Version 2_2 was 74 tables, so we check if there is more than 75
 362     # Maybe could be in step 2
 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'});
 366     $rq->execute;
 367     my $data=$rq->fetchall_arrayref({});
 368     my $count=scalar(@$data);
 369     if ($count < 75){
 370       $template->param("count"=>$count,"proposeimport"=>1);
 371     } else {
 372       $template->param("count"=>$count,"default"=>1);
 373     }
 374     $dbh->disconnect;
 375   }
 376 }else {
 377   # LANGUAGE SELECTION page by default
 378   # using opendir + language Hash
 379
 380   my $langavail = getTranslatedLanguages();
 381   my @languages;
 382   foreach (@$langavail){
 383         push @languages,{'value'=>$_->{'language_code'}, 'description'=>$_->{'language_name'} } if ($_->{'language_code'});
 384   }
 385   $template->param(languages=>\@languages);
 386   if ($dbh){
 387     my $rq=$dbh->prepare("SELECT * from systempreferences WHERE variable='Version'");
 388     if ($rq->execute){
 389       my ($version)=$rq->fetchrow;
 390       if ($version){
 391         $query->redirect("install.pl?step=3");
 392       }
 393     }
 394   }
 395 }
 396 output_html_with_http_headers $query, $cookie, $template->output;