From b9f141a592b15339fc36f07d6350c991defaf585 Mon Sep 17 00:00:00 2001 From: Joe Atzberger Date: Tue, 16 Oct 2007 16:02:27 -0500 Subject: [PATCH] Minor overhaul of installer WITHOUT thorough testing. Steps broken out into More revision is required: CVS variables, bad use of map in void context, overuse of multiple index lines instead of one RegExp, etc. Koha GPL statement at top needed. Signed-off-by: Chris Cormack Signed-off-by: Joshua Ferraro --- installer/install.pl | 372 +++++++++++++++++-------------------------- 1 file changed, 144 insertions(+), 228 deletions(-) diff --git a/installer/install.pl b/installer/install.pl index 1afe245651..7e9d61087d 100755 --- a/installer/install.pl +++ b/installer/install.pl @@ -12,15 +12,15 @@ use strict; # please develop with the strict pragma use CGI; +# +### Main Body #### +# my $query = new CGI; -my $step = $query->param('step'); - -my $language = $query->param('language'); -my ( $template, $loggedinuser, $cookie ); +my $step = $query->param('step') || 0; -my $all_languages = getAllLanguages(); +my ($language, $template, $loggedinuser, $cookie); -if ( defined($language) ) { +if ($language = $query->param('language')) { # assignment, not comparison setlanguagecookie( $query, $language, "install.pl?step=1" ); } ( $template, $loggedinuser, $cookie ) = get_template_and_user( @@ -35,25 +35,34 @@ if ( defined($language) ) { my %info; $info{'dbname'} = C4::Context->config("database"); -$info{'dbms'} = - ( C4::Context->config("db_scheme") +$info{'dbms' } = ( + C4::Context->config("db_scheme") ? C4::Context->config("db_scheme") : "mysql" ); -$info{'hostname'} = C4::Context->config("hostname"); -( $info{'hostname'}, $info{'port'} ) = ( $1, $2 ) - if $info{'hostname'} =~ /([^:]*):([0-9]+)/; -$info{'user'} = C4::Context->config("user"); -$info{'password'} = C4::Context->config("pass"); +foreach (qw(hostname user password)) { + $info{$_} = C4::Context->config($_); +} +($info{'hostname'}, $info{'port'}) = ($1,$2) + if $info{'hostname'} =~ /([^:]*):([0-9]+)/; my $dbh = DBI->connect( "DBI:$info{dbms}:$info{dbname}:$info{hostname}" . ( $info{port} ? ":$info{port}" : "" ), $info{'user'}, $info{'password'} ); -if ( $step && $step == 1 ) { - #First Step - #Checking ALL perl Modules and services needed are installed. - #Whenever there is an error, adding a report to the page + if ($step == 1) {&step_one ;} +elsif ($step == 2) {&step_two ;} +elsif ($step == 3) {&step_three;} +else {&step_else ;} + +output_html_with_http_headers $query, $cookie, $template->output; + +# +### Subroutines ### +# +sub step_one { + # Checking ALL perl Modules and services needed are installed. + # Whenever there is an error, add a report to the page $template->param( language => 1 ); my $problem; @@ -64,113 +73,70 @@ if ( $step && $step == 1 ) { # We could here use a special find my @missing = (); - unless ( eval { require ZOOM } ) { - push @missing, { name => "ZOOM" }; - } - unless ( eval { require LWP::Simple } ) { - push @missing, { name => "LWP::Simple" }; - } - unless ( eval { require XML::Simple } ) { - push @missing, { name => "XML::Simple" }; - } - unless ( eval { require MARC::File::XML } ) { - push @missing, { name => "MARC::File::XML" }; - } - unless ( eval { require MARC::File::USMARC } ) { - push @missing, { name => "MARC::File::USMARC" }; - } - unless ( eval { require DBI } ) { - push @missing, { name => "DBI" }; - } - unless ( eval { require Date::Manip } ) { - push @missing, { name => "Date::Manip" }; - } - unless ( eval { require DBD::mysql } ) { - push @missing, { name => "DBD::mysql" }; - } - unless ( eval { require HTML::Template } ) { - push @missing, { name => "HTML::Template::Pro" }; - } - unless ( eval { require HTML::Template } ) { - push @missing, { name => "Date::Calc" }; - } - unless ( eval { require Digest::MD5 } ) { - push @missing, { name => "Digest::MD5" }; - } - unless ( eval { require MARC::Record } ) { - push @missing, { name => "MARC::Record" }; - } - unless ( eval { require Mail::Sendmail } ) { - push @missing, { name => "Mail::Sendmail", usagemail => 1 }; - } - unless ( eval { require List::MoreUtils } ) { - push @missing, { name => "List::MoreUtils" }; - } - unless ( eval { require XML::RSS } ) { - push @missing, { name => "XML::RSS" }; - } - unless ( eval { require CGI::Carp } ) { - push @missing, { name => "CGI::Carp" }; - } - + my @required = qw( + ZOOM + LWP::Simple + XML::Simple + MARC::File::XML + MARC::File::USMARC + DBI + Date::Manip + DBD::mysql + HTML::Template::Pro + Date::Calc + Digest::MD5 + MARC::Record + List::MoreUtils + XML::RSS + CGI::Carp + Mail::Sendmail + ); + my %optional = ( + 'PDF::API2' => 'usagebarcode', + 'PDF::Reuse::Barcode' => 'usagebarcode', + 'PDF::Report' => 'usagebarcode', + 'Data::Random' => 'usagebarcode', + 'Algorithm::CheckDigits' => 'usagebarcode', + 'GD::Barcode' => 'usagebarcode usagespine', + 'GD::Barcode::UPCE' => 'usagepine', + 'Net::LDAP' => 'usageLDAP', + 'Mail::Sendmail' => 'usagemail', + ); + push @missing, map {{name => $_}} grep {! eval {require $_}} @required; # The following modules are not mandatory, depends on how the library want to use Koha - unless ( eval { require PDF::API2 } ) { - if ( $#missing >= 0 ) { # only when $#missing >= 0 so this isn't fatal - push @missing, { name => "PDF::API2", usagebarcode => 1 }; - } - } - unless ( eval { require GD::Barcorde } ) { - if ( $#missing >= 0 ) { # only when $#missing >= 0 so this isn't fatal - push @missing, - { name => "GD::Barcode", usagebarcode => 1, usagespine => 1 }; - } - } - unless ( eval { require Data::Random } ) { - if ( $#missing >= 0 ) { # only when $#missing >= 0 so this isn't fatal - push @missing, { name => "Data::Random", usagebarcode => 1 }; - } - } - unless ( eval { require PDF::Reuse::Barcode } ) { - if ( $#missing >= 0 ) { # only when $#missing >= 0 so this isn't fatal - push @missing, { name => "PDF::Reuse::Barcode", usagebarcode => 1 }; - } - } - unless ( eval { require PDF::Report } ) { - if ( $#missing >= 0 ) { # only when $#missing >= 0 so this isn't fatal - push @missing, { name => "PDF::Report", usagebarcode => 1 }; - } - } - unless ( eval { require Net::LDAP } ) { - if ( $#missing >= 0 ) { # only when $#missing >= 0 so this isn't fatal - push @missing, { name => "Algorithm::CheckDigits", usagebarcode => 1 }; - } - } - unless ( eval { require GD::Barcode::UPCE } ) { - if ( $#missing >= 0 ) { # only when $#missing >= 0 so this isn't fatal - push @missing, { name => "GD::Barcode::UPCE", usagepine => 1 }; - } - } - unless ( eval { require Net::LDAP } ) { - if ( $#missing >= 0 ) { # only when $#missing >= 0 so this isn't fatal - push @missing, { name => "Net::LDAP", usageLDAP => 1 }; - } - } - $template->param( missings => \@missing ) if ( scalar(@missing) > 0 ); - $template->param( 'checkmodule' => 1 ) - unless ( scalar(@missing) && $problem ); + if ($#missing) { # only when $#missing (is >= 0), so this isn't fatal + foreach my $module (keys %optional) { + unless ( eval { require $module } ) { + my @usages = split /\s+/, $optional{$module}; + push @missing, { name => $module, map {$_ => 1} @usages }; + } + } + $template->param( missings => \@missing ); + } + $template->param( 'checkmodule' => 1 ) unless (scalar(@missing) && $problem); +} +sub line_check ($) { + my $line = shift; + return 1 if ( + index( $line, 'ALL PRIVILEGES' ) > 0 + || ( ( index( $line, 'SELECT' ) > 0 ) + && ( index( $line, 'INSERT' ) > 0 ) + && ( index( $line, 'UPDATE' ) > 0 ) + && ( index( $line, 'DELETE' ) > 0 ) + && ( index( $line, 'CREATE' ) > 0 ) + && ( index( $line, 'DROP' ) > 0 ) ) + ); + return 0; } -elsif ( $step && $step == 2 ) { -# -#STEP 2 Check Database conn~ection and access -# + +sub step_two { + # STEP 2 Check Database connection and access $template->param(%info); my $checkmysql = $query->param("checkmysql"); $template->param( 'mysqlconnection' => $checkmysql ); - if ($checkmysql) { - if ($dbh) { - + if ($checkmysql and $dbh) { # Can connect to the mysql $template->param( "checkdatabaseaccess" => 1 ); if ( $info{dbms} eq "mysql" ) { @@ -182,102 +148,68 @@ elsif ( $step && $step == 2 ) { } #Check if user have all necessary grants on this database. - my $rq = - $dbh->prepare( - "SHOW GRANTS FOR \'$info{user}\'\@'$info{hostname}'"); + my $rq = $dbh->prepare( "SHOW GRANTS FOR \'$info{user}\'\@'$info{hostname}'"); $rq->execute; my $grantaccess; + my $dbname = $info{dbname}; while ( my ($line) = $rq->fetchrow ) { - my $dbname = $info{dbname}; - if ( $line =~ m/$dbname/ || index( $line, '*.*' ) > 0 ) { - $grantaccess = 1 - if ( - index( $line, 'ALL PRIVILEGES' ) > 0 - || ( ( index( $line, 'SELECT' ) > 0 ) - && ( index( $line, 'INSERT' ) > 0 ) - && ( index( $line, 'UPDATE' ) > 0 ) - && ( index( $line, 'DELETE' ) > 0 ) - && ( index( $line, 'CREATE' ) > 0 ) - && ( index( $line, 'DROP' ) > 0 ) ) - ); + if ( $line =~ /$dbname/ || index( $line, '*.*' ) > 0 ) { + line_check($line) and $grantaccess = 1; } } unless ($grantaccess) { - $rq = - $dbh->prepare("SHOW GRANTS FOR \'$info{user}\'\@'\%'"); + $rq = $dbh->prepare("SHOW GRANTS FOR \'$info{user}\'\@'\%'"); $rq->execute; while ( my ($line) = $rq->fetchrow ) { - my $dbname = $info{dbname}; - if ( $line =~ m/$dbname/ || index( $line, '*.*' ) > 0 ) - { - $grantaccess = 1 - if ( - index( $line, 'ALL PRIVILEGES' ) > 0 - || ( ( index( $line, 'SELECT' ) > 0 ) - && ( index( $line, 'INSERT' ) > 0 ) - && ( index( $line, 'UPDATE' ) > 0 ) - && ( index( $line, 'DELETE' ) > 0 ) - && ( index( $line, 'CREATE' ) > 0 ) - && ( index( $line, 'DROP' ) > 0 ) ) - ); + if ( $line =~ /$dbname/ || index( $line, '*.*' ) > 0 ) { + line_check($line) and $grantaccess = 1; } } } $template->param( "checkgrantaccess" => $grantaccess ); } - } - else { + } else { $template->param( "error" => DBI::err, "message" => DBI::errstr ); } - } } -elsif ( $step && $step == 3 ) { -# -# -# STEP 3 : database setup -# -# - my $op = $query->param('op'); - if ( $op && $op eq 'finished' ) { - # - # we have finished, just redirect to mainpage. - # + +sub step_three { + # STEP 3 : database setup + my $op = $query->param('op') || ''; + if ($op eq 'finished') { # we have finished, just redirect to mainpage. print $query->redirect("/cgi-bin/koha/mainpage.pl"); exit 1; } - elsif ( $op && $op eq 'finish' ) { + elsif ($op eq 'finish') { my $kohaversion=C4::Context::KOHAVERSION; # remove the 3 last . to have a Perl number $kohaversion =~ s/(.*\..*)\.(.*)\.(.*)/$1$2$3/; + my $finish; if (C4::Context->preference('Version')) { warn "UPDATE Version"; - my $finish=$dbh->prepare("UPDATE systempreferences SET value=? WHERE variable='Version'"); - $finish->execute($kohaversion); + $finish=$dbh->prepare("UPDATE systempreferences SET value=? WHERE variable='Version'"); } else { warn "INSERT Version"; - 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')"); - $finish->execute($kohaversion); + $finish=$dbh->prepare("INSERT into systempreferences (variable,value,explanation) values ('Version',?,'The Koha database version. Do not change this value manually, it is written by the webinstaller')"); } + $finish->execute($kohaversion); # Installation is finished. # We just deny anybody acess to install # And we redirect people to mainpage. - # The installer wil have to relogin since we donot pass cookie to redirection. + # The installer wil have to relogin since we do not pass cookie to redirection. $template->param( "$op" => 1 ); } - elsif ( $op && $op eq 'Nozebra' ) { - if ($query->param('Nozebra')) { - $dbh->do("UPDATE systempreferences SET value=1 WHERE variable='NoZebra'"); + elsif ($op eq 'Nozebra') { + if ($query->param($op)) { + $dbh->do("UPDATE systempreferences SET value=1 WHERE variable='$op'"); } else { - $dbh->do("UPDATE systempreferences SET value=0 WHERE variable='NoZebra'"); + $dbh->do("UPDATE systempreferences SET value=0 WHERE variable='$op'"); } $template->param( "$op" => 1 ); } - elsif ( $op && $op eq 'addframeworks' ) { - # + elsif ($op eq 'addframeworks') { # 1ST install, 3rd sub-step : insert the SQL files the user has selected - # - #Framework importing and reports my $lang; my %hashlevel; @@ -289,14 +221,12 @@ elsif ( $step && $step == 3 ) { $aa[-1] lt $bb[-1] } $query->param('framework'); $dbh->do('SET FOREIGN_KEY_CHECKS=0'); - my $request = - $dbh->prepare( + my $request = $dbh->prepare( "SELECT value FROM systempreferences WHERE variable='FrameworksLoaded'" ); $request->execute; my ($systempreference) = $request->fetchrow; foreach my $file (@fnames) { - # warn $file; undef $/; my $strcmd = "mysql " @@ -306,19 +236,17 @@ elsif ( $step && $step == 3 ) { . ( $info{password} ? " -p$info{password}" : "" ) . " $info{dbname} "; my $error = qx($strcmd < $file 2>&1); - my @file = split qr(\/|\\), $file; - $lang = $file[ scalar(@file) - 3 ] unless ($lang); - my $level = $file[ scalar(@file) - 2 ]; - unless ($error) { - $systempreference .= "$file[scalar(@file)-1]|" - unless ( - index( $systempreference, $file[ scalar(@file) - 1 ] ) >= - 0 ); + my @file = split qr(\/|\\), $file; # odd use of qr + my $fsize = scalar(@file); + $lang = $file[$fsize-3] unless ($lang); + my $level = $file[$fsize-2]; + unless ($error and index($systempreference, $file[$fsize-1]) >= 0) { + $systempreference .= "$file[$fsize-1]|" } #Bulding here a hierarchy to display files by level. push @{ $hashlevel{$level} }, - { "fwkname" => $file[ scalar(@file) - 1 ], "error" => $error }; + { "fwkname" => $file[$fsize-1], "error" => $error }; } #systempreference contains an ending | @@ -327,8 +255,7 @@ elsif ( $step && $step == 3 ) { map { push @list, { "level" => $_, "fwklist" => $hashlevel{$_} } } keys %hashlevel; my $fwk_language; - for my $each_language (@$all_languages) { - + for my $each_language (getAllLanguages()) { # warn "CODE".$each_language->{'language_code'}; # warn "LANG:".$lang; if ( $lang eq $each_language->{'language_code'} ) { @@ -352,7 +279,7 @@ elsif ( $step && $step == 3 ) { $template->param( "$op" => 1 ); $dbh->do('SET FOREIGN_KEY_CHECKS=1'); } - elsif ( $op && $op eq 'selectframeworks' ) { + elsif ($op eq 'selectframeworks') { # # # 1ST install, 2nd sub-step : show the user the sql datas he can insert in the database. @@ -360,25 +287,25 @@ elsif ( $step && $step == 3 ) { # # (note that the term "selectframeworks is not correct. The user can select various files, not only frameworks) - #Framework Selection - #sql data for import are supposed to be located in installer/data// + # Framework Selection + # sql data for import are supposed to be located in installer/data// # Where is en|fr or any international abbreviation (provided language hash is updated... This will be a problem with internationlisation.) - # Where is a category of requirement : required, recommended optional + # Where is a category of requirement : required, recommended, optional # level should contain : # SQL File for import With a readable name. # txt File taht explains what this SQL File is meant for. # Could be VERY useful to have A Big file for a kind of library. # But could also be useful to have some Authorised values data set prepared here. # Framework Selection is achieved through checking boxes. - my $langchoice = $query->param('fwklanguage'); - $langchoice = $query->cookie('KohaOpacLanguage') unless ($langchoice); + my $langchoice = $query->param('fwklanguage') || + $query->cookie('KohaOpacLanguage') ; my $dir = C4::Context->config('intranetdir') . "/installer/data/"; opendir( MYDIR, $dir ); my @listdir = grep { !/^\.|CVS/ && -d "$dir/$_" } readdir(MYDIR); closedir MYDIR; my $frmwklangs = getFrameworkLanguages(); my @languages; - map { + map { # inappropriate use of map in void context push @languages, { 'dirname' => $_->{'language_code'}, @@ -389,14 +316,12 @@ elsif ( $step && $step == 3 ) { } @$frmwklangs; $template->param( "languagelist" => \@languages ); undef $/; - $dir = - C4::Context->config('intranetdir') . "/installer/data/$langchoice"; - opendir( MYDIR, $dir ) || warn "no open $dir"; + $dir = C4::Context->config('intranetdir') . "/installer/data/$langchoice"; + opendir ( MYDIR, $dir ) or warn "Cannot read directory $dir"; @listdir = sort grep { !/^\.|CVS/ && -d "$dir/$_" } readdir(MYDIR); closedir MYDIR; my @levellist; - my $request = - $dbh->prepare( + my $request = $dbh->prepare( "SELECT value FROM systempreferences WHERE variable='FrameworksLoaded'" ); $request->execute; @@ -417,12 +342,12 @@ elsif ( $step && $step == 3 ) { closedir MYDIR; my %cell; my @frameworklist; - map { + map { # inappropriate use of map in void context my $name = substr( $_, 0, -4 ); open FILE, "< $dir/$name.txt"; my $lines = ; $lines =~ s/\n|\r/
/g; - use utf8; + use utf8; # this doesn't even make sense here. utf8::encode($lines) unless ( utf8::is_utf8($lines) ); push @frameworklist, { @@ -450,7 +375,7 @@ elsif ( $step && $step == 3 ) { $template->param( "levelloop" => \@levellist ); $template->param( "$op" => 1 ); } - elsif ( $op && $op eq 'importdatastructure' ) { + elsif ($op eq 'importdatastructure' ) { # # # 1st install, 1st "sub-step" : import kohastructure @@ -473,7 +398,7 @@ elsif ( $step && $step == 3 ) { ); $dbh->disconnect; } - elsif ( $op && $op eq 'updatestructure' ) { + elsif ($op eq 'updatestructure' ) { # # Not 1st install, the only sub-step : update database # @@ -492,9 +417,9 @@ elsif ( $step && $step == 3 ) { } else { # - # check wether it's a 1st install or an update + # Check wether it's a 1st install or an update # - #Check if there are enough tables. + # Check if there are enough tables. # Paul has cleaned up tables so reduced the count #I put it there because it implied a data import if condition was not satisfied. my $dbh = DBI->connect( @@ -511,9 +436,7 @@ elsif ( $step && $step == 3 ) { # if ( $count < 70 ) { $template->param( "count" => $count, "proposeimport" => 1 ); - } - else { - # + } else { # we have tables, propose to select files to upload or updatedatabase # $template->param( "count" => $count, "default" => 1 ); @@ -522,27 +445,22 @@ elsif ( $step && $step == 3 ) { # if there is, then we just need to upgrade # if there is none, then we need to install the database # - my $dbversion = C4::Context->preference('Version'); - $dbversion =~ /(.*)\.(..)(..)(...)/; - $dbversion = "$1.$2.$3.$4"; - if (C4::Context->preference('Version')) { - $template->param("upgrading" => 1, - "dbversion" => $dbversion, + if (my $dbversion = C4::Context->preference('Version')) { + $dbversion =~ s/(.*)\.(..)(..)(...)/$1.$2.$3.$4/; + $template->param( "upgrading" => 1, + "dbversion" => $dbversion, "kohaversion" => C4::Context->KOHAVERSION, ); } } - $dbh->disconnect; } } -else { +sub step_else { # LANGUAGE SELECTION page by default # using opendir + language Hash - my $langavail = getTranslatedLanguages(); - my @languages; foreach (@$langavail) { push @languages, @@ -555,14 +473,12 @@ else { $template->param( languages => \@languages ); if ($dbh) { my $rq = - $dbh->prepare( - "SELECT * from systempreferences WHERE variable='Version'"); - if ( $rq->execute ) { - my ($version) = $rq->fetchrow; - if ($version) { - $query->redirect("install.pl?step=3"); - } + $dbh->prepare("SELECT * from systempreferences WHERE variable='Version'"); + if ( $rq->execute && $rq->fetchrow) { + $query->redirect("install.pl?step=3"); } } } -output_html_with_http_headers $query, $cookie, $template->output; + + + -- 2.39.5