Bug 22778: Suggestions with no "suggester" can cause errors
[srvgit] / C4 / Installer.pm
index 0a6fca8..db247e5 100644 (file)
@@ -21,8 +21,8 @@ use Modern::Perl;
 
 use Encode qw( encode is_utf8 );
 use DBIx::RunSQL;
+use YAML::Syck qw( LoadFile );
 use C4::Context;
-use C4::Installer::PerlModules;
 use DBI;
 use Koha;
 
@@ -145,16 +145,22 @@ sub marc_framework_sql_list {
 
     foreach my $requirelevel (@listdir) {
         opendir( MYDIR, "$dir/$requirelevel" );
-        my @listname = grep { !/^\./ && -f "$dir/$requirelevel/$_" && $_ =~ m/\.sql$/ } readdir(MYDIR);
+        my @listname = grep { !/^\./ && -f "$dir/$requirelevel/$_" && $_ =~ m/\.(sql|yml)$/ } readdir(MYDIR);
         closedir MYDIR;
         my %cell;
         my @frameworklist;
         map {
-            my $name = substr( $_, 0, -4 );
-            open my $fh, "<:encoding(UTF-8)", "$dir/$requirelevel/$name.txt";
-            my $line = <$fh>;
-            $line = Encode::encode('UTF-8', $line) unless ( Encode::is_utf8($line) );
-            my @lines = split /\n/, $line;
+            my ( $name, $ext ) = split /\./, $_;
+            my @lines;
+            if ( $ext =~ /yml/ ) {
+                my $yaml = LoadFile("$dir/$requirelevel/$name\.$ext");
+                @lines = map { Encode::decode('UTF-8', $_) } @{ $yaml->{'description'} };
+            } else {
+                open my $fh, "<:encoding(UTF-8)", "$dir/$requirelevel/$name.txt";
+                my $line = <$fh>;
+                $line = Encode::encode('UTF-8', $line) unless ( Encode::is_utf8($line) );
+                @lines = split /\n/, $line;
+            }
             my $mandatory = ($requirelevel =~ /(mandatory|requi|oblig|necess)/i);
             push @frameworklist,
               {
@@ -169,7 +175,7 @@ sub marc_framework_sql_list {
           sort { $a->{'fwkname'} cmp $b->{'fwkname'} } @frameworklist;
 
         $cell{"frameworks"} = \@fwks;
-        $cell{"label"}      = ucfirst($requirelevel);
+        $cell{"label"}      = ($requirelevel =~ /(mandatory|requi|oblig|necess)/i)?'mandatory':'optional';
         $cell{"code"}       = lc($requirelevel);
         push @fwklist, \%cell;
     }
@@ -222,16 +228,22 @@ sub sample_data_sql_list {
 
     foreach my $requirelevel (@listdir) {
         opendir( MYDIR, "$dir/$requirelevel" );
-        my @listname = grep { !/^\./ && -f "$dir/$requirelevel/$_" && $_ =~ m/\.sql$/ } readdir(MYDIR);
+        my @listname = grep { !/^\./ && -f "$dir/$requirelevel/$_" && $_ =~ m/\.(sql|yml)$/ } readdir(MYDIR);
         closedir MYDIR;
         my %cell;
         my @frameworklist;
         map {
-            my $name = substr( $_, 0, -4 );
-            open my $fh , "<:encoding(UTF-8)", "$dir/$requirelevel/$name.txt";
-            my $line = <$fh>;
-            $line = Encode::encode('UTF-8', $line) unless ( Encode::is_utf8($line) );
-            my @lines = split /\n/, $line;
+            my ( $name, $ext ) = split /\./, $_;
+            my @lines;
+            if ( $ext =~ /yml/ ) {
+                my $yaml = LoadFile("$dir/$requirelevel/$name\.$ext");
+                @lines = map { Encode::decode('UTF-8', $_) } @{ $yaml->{'description'} };
+            } else {
+                open my $fh, "<:encoding(UTF-8)", "$dir/$requirelevel/$name.txt";
+                my $line = <$fh>;
+                $line = Encode::encode('UTF-8', $line) unless ( Encode::is_utf8($line) );
+                @lines = split /\n/, $line;
+            }
             my $mandatory = ($requirelevel =~ /(mandatory|requi|oblig|necess)/i);
             push @frameworklist,
               {
@@ -245,7 +257,7 @@ sub sample_data_sql_list {
         my @fwks = sort { $a->{'fwkname'} cmp $b->{'fwkname'} } @frameworklist;
 
         $cell{"frameworks"} = \@fwks;
-        $cell{"label"}      = ucfirst($requirelevel);
+        $cell{"label"}      = ($requirelevel =~ /(mandatory|requi|oblig|necess)/i)?'mandatory':'optional';
         $cell{"code"}       = lc($requirelevel);
         push @levellist, \%cell;
     }
@@ -435,11 +447,67 @@ sub set_version_syspref {
     C4::Context->clear_syspref_cache();
 }
 
+=head2 set_languages_syspref
+
+  $installer->set_languages_syspref();
+
+Add the installation language to 'language' and 'opaclanguages' system preferences
+if different from 'en'
+
+=cut
+
+sub set_languages_syspref {
+    my $self     = shift;
+    my $language = shift;
+
+    return if ( not $language or $language eq 'en' );
+
+    warn "UPDATE Languages";
+    # intranet
+    my $pref = $self->{'dbh'}->prepare("UPDATE systempreferences SET value=? WHERE variable='language'");
+    $pref->execute("en,$language");
+    # opac
+    $pref = $self->{'dbh'}->prepare("UPDATE systempreferences SET value=? WHERE variable='opaclanguages'");
+    $pref->execute("en,$language");
+
+    C4::Context->clear_syspref_cache();
+}
+
+=head2 process_yml_table
+
+  my $query_info   = $installer->process_yml_table($table);
+
+Analyzes a table loaded in YAML format.
+Returns the values required to build an insert statement.
+
+=cut
+
+sub process_yml_table {
+    my ($table) = @_;
+    my $table_name   = ( keys %$table )[0];                          # table name
+    my @rows         = @{ $table->{$table_name}->{rows} };           #
+    my @columns      = ( sort keys %{$rows[0]} );                    # column names
+    my $fields       = join ",", map{sprintf("`%s`", $_)} @columns;  # idem, joined
+    my $query        = "INSERT INTO $table_name ( $fields ) VALUES ";
+    my @multiline    = @{ $table->{$table_name}->{'multiline'} };    # to check multiline values;
+    my $placeholders = '(' . join ( ",", map { "?" } @columns ) . ')'; # '(?,..,?)' string
+    my @values;
+    foreach my $row ( @rows ) {
+        push @values, [ map {
+                        my $col = $_;
+                        ( @multiline and grep { $_ eq $col } @multiline )
+                        ? join "\r\n", @{$row->{$col}}                # join multiline values
+                        : $row->{$col};
+                     } @columns ];
+    }
+    return { query => $query, placeholders => $placeholders, values => \@values };
+}
+
 =head2 load_sql
 
   my $error = $installer->load_sql($filename);
 
-Runs a the specified SQL file using a sql loader DBIx::RunSQL
+Runs the specified input file using a sql loader DBIx::RunSQL, or a yaml loader
 Returns any strings sent to STDERR
 
 # FIXME This should be improved: sometimes the caller and load_sql warn the same
@@ -459,12 +527,35 @@ sub load_sql {
         local *STDERR;
         open STDERR, ">>", \$dup_stderr;
 
-        eval {
-            DBIx::RunSQL->run_sql_file(
-                dbh     => $dbh,
-                sql     => $filename,
-            );
-        };
+        if ( $filename =~ /sql$/ ) {                                                        # SQL files
+            eval {
+                DBIx::RunSQL->run_sql_file(
+                    dbh     => $dbh,
+                    sql     => $filename,
+                );
+            };
+        }
+        else {                                                                       # YAML files
+            eval {
+                my $yaml         = LoadFile( $filename );                            # Load YAML
+                for my $table ( @{ $yaml->{'tables'} } ) {
+                    my $query_info   = process_yml_table($table);
+                    my $query        = $query_info->{query};
+                    my $placeholders = $query_info->{placeholders};
+                    my $values       = $query_info->{values};
+                    # Doing only 1 INSERT query for the whole table
+                    my @all_rows_values = map { @$_ } @$values;
+                    $query .= join ', ', ( $placeholders ) x scalar @$values;
+                    $dbh->do( $query, undef, @all_rows_values );
+                }
+                for my $statement ( @{ $yaml->{'sql_statements'} } ) {               # extra SQL statements
+                    $dbh->do($statement);
+                }
+            };
+        }
+        if ($@){
+            warn "Something went wrong loading file $filename ($@)";
+        }
     };
     #   errors thrown while loading installer data should be logged
     if( $dup_stderr ) {