| 
      
            Line 0
          
      
      
        Link Here
      
     | 
  
            
               | 
               | 
              1 | 
              package C4::Update::Database;  | 
            
            
              | 2 | 
               | 
            
            
              | 3 | 
              # Copyright Biblibre 2012  | 
            
            
              | 4 | 
              #  | 
            
            
              | 5 | 
              # This file is part of Koha.  | 
            
            
              | 6 | 
              #  | 
            
            
              | 7 | 
              # Koha is free software; you can redistribute it and/or modify it under the  | 
            
            
              | 8 | 
              # terms of the GNU General Public License as published by the Free Software  | 
            
            
              | 9 | 
              # Foundation; either version 2 of the License, or (at your option) any later  | 
            
            
              | 10 | 
              # version.  | 
            
            
              | 11 | 
              #  | 
            
            
              | 12 | 
              # Koha is distributed in the hope that it will be useful, but WITHOUT ANY  | 
            
            
              | 13 | 
              # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR  | 
            
            
              | 14 | 
              # A PARTICULAR PURPOSE.  See the GNU General Public License for more details.  | 
            
            
              | 15 | 
              #  | 
            
            
              | 16 | 
              # You should have received a copy of the GNU General Public License along  | 
            
            
              | 17 | 
              # with Koha; if not, write to the Free Software Foundation, Inc.,  | 
            
            
              | 18 | 
              # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.  | 
            
            
              | 19 | 
               | 
            
            
              | 20 | 
              use Modern::Perl;  | 
            
            
              | 21 | 
               | 
            
            
              | 22 | 
              use C4::Context;  | 
            
            
              | 23 | 
               | 
            
            
              | 24 | 
              use File::Basename;  | 
            
            
              | 25 | 
              use File::Find::Rule;  | 
            
            
              | 26 | 
              use Digest::MD5;  | 
            
            
              | 27 | 
              use List::MoreUtils qw/uniq/;  | 
            
            
              | 28 | 
              use YAML;  | 
            
            
              | 29 | 
               | 
            
            
              | 30 | 
              =head1 NAME  | 
            
            
              | 31 | 
               | 
            
            
              | 32 | 
              C4::Update::Database.pm  | 
            
            
              | 33 | 
               | 
            
            
              | 34 | 
              =head1 SYNOPSIS  | 
            
            
              | 35 | 
               | 
            
            
              | 36 | 
                use C4::Update::Database;  | 
            
            
              | 37 | 
               | 
            
            
              | 38 | 
                This package is used by admin/updatedatabase.pl, to manage DB updates  | 
            
            
              | 39 | 
               | 
            
            
              | 40 | 
              =head1 FUNCTIONS  | 
            
            
              | 41 | 
               | 
            
            
              | 42 | 
              =cut  | 
            
            
              | 43 | 
               | 
            
            
              | 44 | 
              my $VERSIONS_PATH = C4::Context->config('intranetdir') . '/installer/data/mysql/versions'; | 
            
            
              | 45 | 
               | 
            
            
              | 46 | 
              my $version;  | 
            
            
              | 47 | 
              my $list;  | 
            
            
              | 48 | 
               | 
            
            
              | 49 | 
              my $dbh = C4::Context->dbh;  | 
            
            
              | 50 | 
               | 
            
            
              | 51 | 
              =head2 get_filepath  | 
            
            
              | 52 | 
               | 
            
            
              | 53 | 
                my $file = get_filepath($version);  | 
            
            
              | 54 | 
                this sub will return the full path of a given DB update number  | 
            
            
              | 55 | 
               | 
            
            
              | 56 | 
              =cut  | 
            
            
              | 57 | 
               | 
            
            
              | 58 | 
              sub get_filepath { | 
            
            
              | 59 | 
                  my ( $version ) = @_;  | 
            
            
              | 60 | 
                  my @files = File::Find::Rule->file->name( "$version.sql", "$version.pl" ) ->in( ( $VERSIONS_PATH ) );  | 
            
            
              | 61 | 
               | 
            
            
              | 62 | 
                  if ( scalar @files != 1 ) { | 
            
            
              | 63 | 
                      die "This version ($version) returned has ".scalar @files." corresponding, need only 1";  | 
            
            
              | 64 | 
                  }  | 
            
            
              | 65 | 
               | 
            
            
              | 66 | 
                  return $files[0];  | 
            
            
              | 67 | 
              }  | 
            
            
              | 68 | 
               | 
            
            
              | 69 | 
              =head2 get_md5  | 
            
            
              | 70 | 
               | 
            
            
              | 71 | 
                my $md5 = get_md5($filepath)  | 
            
            
              | 72 | 
                returns the md5sum of the selected file.  | 
            
            
              | 73 | 
                This is used to check consistency of updates  | 
            
            
              | 74 | 
               | 
            
            
              | 75 | 
              =cut  | 
            
            
              | 76 | 
               | 
            
            
              | 77 | 
              sub get_md5 { | 
            
            
              | 78 | 
                  my ( $filepath ) = @_;  | 
            
            
              | 79 | 
                  open(FILE, $filepath);  | 
            
            
              | 80 | 
               | 
            
            
              | 81 | 
                  my $ctx = Digest::MD5->new;  | 
            
            
              | 82 | 
                  $ctx->addfile(*FILE);  | 
            
            
              | 83 | 
                  my $md5 = $ctx->hexdigest;  | 
            
            
              | 84 | 
                  close(FILE);  | 
            
            
              | 85 | 
                  return $md5;  | 
            
            
              | 86 | 
              }  | 
            
            
              | 87 | 
               | 
            
            
              | 88 | 
              =head2 execute_version  | 
            
            
              | 89 | 
               | 
            
            
              | 90 | 
                $result = execute_version($version_number);  | 
            
            
              | 91 | 
                Execute an update.  | 
            
            
              | 92 | 
                This sub will detect if the number is made through a .pl or a .sql, and behave accordingly  | 
            
            
              | 93 | 
                if there is more than 1 file with the same number, an error will be issued  | 
            
            
              | 94 | 
                if you try to execute a version_number that has already be executed, then it will also issue an error  | 
            
            
              | 95 | 
                the sub return an result hash, with the version number and the result  | 
            
            
              | 96 | 
               | 
            
            
              | 97 | 
              =cut  | 
            
            
              | 98 | 
               | 
            
            
              | 99 | 
              sub execute_version { | 
            
            
              | 100 | 
                  my ( $version ) = @_;  | 
            
            
              | 101 | 
                  my $report;  | 
            
            
              | 102 | 
               | 
            
            
              | 103 | 
                  my $filepath;  | 
            
            
              | 104 | 
                  eval { | 
            
            
              | 105 | 
                      $filepath = get_filepath $version;  | 
            
            
              | 106 | 
                  };  | 
            
            
              | 107 | 
                  if ( $@ ) { | 
            
            
              | 108 | 
                      return { $version => $@ }; | 
            
            
              | 109 | 
                  }  | 
            
            
              | 110 | 
               | 
            
            
              | 111 | 
                  my @file_infos = fileparse( $filepath, qr/\.[^.]*/ );  | 
            
            
              | 112 | 
                  my $extension = $file_infos[2];  | 
            
            
              | 113 | 
                  my $filename = $version . $extension;  | 
            
            
              | 114 | 
               | 
            
            
              | 115 | 
                  my $md5 = get_md5 $filepath;  | 
            
            
              | 116 | 
                  my $r = md5_already_exists( $md5 );  | 
            
            
              | 117 | 
                  if ( scalar @$r ) { | 
            
            
              | 118 | 
                      my $p = @$r[0];  | 
            
            
              | 119 | 
                      $report->{$version} = { | 
            
            
              | 120 | 
                          error => "ALREADY_EXISTS",  | 
            
            
              | 121 | 
                          filepath => $filepath,  | 
            
            
              | 122 | 
                          old_version => @$r[0]->{version}, | 
            
            
              | 123 | 
                          md5 => @$r[0]->{md5}, | 
            
            
              | 124 | 
                      };  | 
            
            
              | 125 | 
                      return $report;  | 
            
            
              | 126 | 
                  }  | 
            
            
              | 127 | 
               | 
            
            
              | 128 | 
                  my $queries;  | 
            
            
              | 129 | 
                  given ( $extension ) { | 
            
            
              | 130 | 
                      when ( /.sql/ ) { | 
            
            
              | 131 | 
                          $queries = get_queries ( $filepath );  | 
            
            
              | 132 | 
                      }  | 
            
            
              | 133 | 
                      when ( /.pl/ ) { | 
            
            
              | 134 | 
                          eval { | 
            
            
              | 135 | 
                              $queries = get_queries ( $filepath );  | 
            
            
              | 136 | 
                          };  | 
            
            
              | 137 | 
                          if ($@) { | 
            
            
              | 138 | 
                              $report->{$version} = { | 
            
            
              | 139 | 
                                  error => "LOAD_FUNCTIONS_FAILED",  | 
            
            
              | 140 | 
                                  filename => $filename,  | 
            
            
              | 141 | 
                                  error_str => $@,  | 
            
            
              | 142 | 
                              };  | 
            
            
              | 143 | 
                          }  | 
            
            
              | 144 | 
                      }  | 
            
            
              | 145 | 
                      default { | 
            
            
              | 146 | 
                          $report->{$version} = { | 
            
            
              | 147 | 
                              error => "BAD_EXTENSION",  | 
            
            
              | 148 | 
                              extension => $extension,  | 
            
            
              | 149 | 
                          };  | 
            
            
              | 150 | 
                      }  | 
            
            
              | 151 | 
                  }  | 
            
            
              | 152 | 
               | 
            
            
              | 153 | 
                  return $report  | 
            
            
              | 154 | 
                      if ( defined $report->{$version} ); | 
            
            
              | 155 | 
               | 
            
            
              | 156 | 
                  my $errors = execute ( $queries );  | 
            
            
              | 157 | 
                  $report->{$version} = scalar( @$errors ) ? $errors : "OK"; | 
            
            
              | 158 | 
                  set_infos ( $version, $queries, $errors, $md5 );  | 
            
            
              | 159 | 
                  return $report;  | 
            
            
              | 160 | 
              }  | 
            
            
              | 161 | 
               | 
            
            
              | 162 | 
              =head2 list_versions_available  | 
            
            
              | 163 | 
               | 
            
            
              | 164 | 
                my @versions = list_versions_available;  | 
            
            
              | 165 | 
                return an array with all version available  | 
            
            
              | 166 | 
               | 
            
            
              | 167 | 
              =cut  | 
            
            
              | 168 | 
               | 
            
            
              | 169 | 
              sub list_versions_available { | 
            
            
              | 170 | 
                  my @versions;  | 
            
            
              | 171 | 
               | 
            
            
              | 172 | 
                  my @files = File::Find::Rule->file->name( "*.sql", "*.pl" ) ->in( ( $VERSIONS_PATH ) );  | 
            
            
              | 173 | 
               | 
            
            
              | 174 | 
                  for my $f ( @files ) { | 
            
            
              | 175 | 
                      my @file_infos = fileparse( $f, qr/\.[^.]*/ );  | 
            
            
              | 176 | 
                      push @versions, $file_infos[0];  | 
            
            
              | 177 | 
                  }  | 
            
            
              | 178 | 
                  @versions = uniq @versions;  | 
            
            
              | 179 | 
                  return \@versions;  | 
            
            
              | 180 | 
              }  | 
            
            
              | 181 | 
               | 
            
            
              | 182 | 
              =head2 list_versions_already_applied  | 
            
            
              | 183 | 
               | 
            
            
              | 184 | 
                my @versions = list_versions_available;  | 
            
            
              | 185 | 
                return an array with all version that have already been applied  | 
            
            
              | 186 | 
                This sub check first that the updatedb tables exist and create them if needed  | 
            
            
              | 187 | 
               | 
            
            
              | 188 | 
              =cut  | 
            
            
              | 189 | 
               | 
            
            
              | 190 | 
              sub list_versions_already_applied { | 
            
            
              | 191 | 
                  # 1st check if tables exist, otherwise create them  | 
            
            
              | 192 | 
                      $dbh->do(qq{ | 
            
            
              | 193 | 
                              CREATE TABLE IF NOT EXISTS `updatedb_error` ( `version` varchar(32) DEFAULT NULL, `error` text ) ENGINE=InnoDB CHARSET=utf8;  | 
            
            
              | 194 | 
                      });  | 
            
            
              | 195 | 
                          $dbh->do(qq{ | 
            
            
              | 196 | 
                          CREATE TABLE  IF NOT EXISTS `updatedb_query` ( `version` varchar(32) DEFAULT NULL, `query` text ) ENGINE=InnoDB CHARSET=utf8;  | 
            
            
              | 197 | 
                      });  | 
            
            
              | 198 | 
                      $dbh->do(qq{ | 
            
            
              | 199 | 
                          CREATE TABLE  IF NOT EXISTS `updatedb_report` ( `version` text, `md5` varchar(50) DEFAULT NULL, `comment` text, `status` int(1) DEFAULT NULL ) ENGINE=InnoDB CHARSET=utf8;  | 
            
            
              | 200 | 
                      });  | 
            
            
              | 201 | 
               | 
            
            
              | 202 | 
                  my $query = qq/ SELECT version, comment, status FROM updatedb_report ORDER BY version/;  | 
            
            
              | 203 | 
                  my $sth = $dbh->prepare( $query );  | 
            
            
              | 204 | 
                  $sth->execute;  | 
            
            
              | 205 | 
                  my $versions = $sth->fetchall_arrayref( {} ); | 
            
            
              | 206 | 
                  map { | 
            
            
              | 207 | 
                      my $version = $_;  | 
            
            
              | 208 | 
                      my @comments = defined $_->{comment} ? split '\\\n', $_->{comment} : ""; | 
            
            
              | 209 | 
                      push @{ $version->{comments} }, { comment => $_ } for @comments; | 
            
            
              | 210 | 
                      delete $version->{comment}; | 
            
            
              | 211 | 
                  } @$versions;  | 
            
            
              | 212 | 
                  $sth->finish;  | 
            
            
              | 213 | 
                  for my $version ( @$versions ) { | 
            
            
              | 214 | 
                      $query = qq/ SELECT query FROM updatedb_query WHERE version = ? ORDER BY version/;  | 
            
            
              | 215 | 
                      $sth = $dbh->prepare( $query );  | 
            
            
              | 216 | 
                      $sth->execute( $version->{version} ); | 
            
            
              | 217 | 
                      $version->{queries} = $sth->fetchall_arrayref( {} ); | 
            
            
              | 218 | 
                      $sth->finish;  | 
            
            
              | 219 | 
                      $query = qq/ SELECT error FROM updatedb_error WHERE version = ? ORDER BY version/;  | 
            
            
              | 220 | 
                      $sth = $dbh->prepare( $query );  | 
            
            
              | 221 | 
                      $sth->execute( $version->{version} ); | 
            
            
              | 222 | 
                      $version->{errors} = $sth->fetchall_arrayref( {} ); | 
            
            
              | 223 | 
                      $sth->finish;  | 
            
            
              | 224 | 
                  }  | 
            
            
              | 225 | 
                  return $versions;  | 
            
            
              | 226 | 
              }  | 
            
            
              | 227 | 
               | 
            
            
              | 228 | 
              =head2 execute  | 
            
            
              | 229 | 
               | 
            
            
              | 230 | 
                my @errors = $execute(\@queries);  | 
            
            
              | 231 | 
                This sub will execute queries coming from an execute_version based on a .sql file  | 
            
            
              | 232 | 
               | 
            
            
              | 233 | 
              =cut  | 
            
            
              | 234 | 
               | 
            
            
              | 235 | 
              sub execute { | 
            
            
              | 236 | 
                  my ( $queries ) = @_;  | 
            
            
              | 237 | 
                  my @errors;  | 
            
            
              | 238 | 
                  for my $query ( @{$queries->{queries}} ) { | 
            
            
              | 239 | 
                      eval { | 
            
            
              | 240 | 
                          $dbh->do( $query );  | 
            
            
              | 241 | 
                      };  | 
            
            
              | 242 | 
                      push @errors, get_error();  | 
            
            
              | 243 | 
                  }  | 
            
            
              | 244 | 
                  return \@errors;  | 
            
            
              | 245 | 
              }  | 
            
            
              | 246 | 
               | 
            
            
              | 247 | 
              =head2 get_tables_name  | 
            
            
              | 248 | 
               | 
            
            
              | 249 | 
                my $tables = get_tables_name;  | 
            
            
              | 250 | 
                return an array with all Koha mySQL table names  | 
            
            
              | 251 | 
               | 
            
            
              | 252 | 
              =cut  | 
            
            
              | 253 | 
               | 
            
            
              | 254 | 
              sub get_tables_name { | 
            
            
              | 255 | 
                  my $sth = $dbh->prepare("SHOW TABLES"); | 
            
            
              | 256 | 
                  $sth->execute();  | 
            
            
              | 257 | 
                  my @tables;  | 
            
            
              | 258 | 
                  while ( my ( $table ) = $sth->fetchrow_array ) { | 
            
            
              | 259 | 
                      push @tables, $table;  | 
            
            
              | 260 | 
                  }  | 
            
            
              | 261 | 
                  return \@tables;  | 
            
            
              | 262 | 
              }  | 
            
            
              | 263 | 
              my $tables;  | 
            
            
              | 264 | 
               | 
            
            
              | 265 | 
              =head2 check_coherency  | 
            
            
              | 266 | 
               | 
            
            
              | 267 | 
                my $errors = check_coherency($query); UNUSED  | 
            
            
              | 268 | 
                This sub will try to check if a SQL query is useless or no.  | 
            
            
              | 269 | 
                for queries that are CREATE TABLE, it will check if the table already exists  | 
            
            
              | 270 | 
                for queries that are ALTER TABLE, it will search if the modification has already been made  | 
            
            
              | 271 | 
                for queries that are INSERT, it will search if the insert has already been made if it's a syspref or a permission  | 
            
            
              | 272 | 
               | 
            
            
              | 273 | 
                Those test cover 90% of the updatedatabases cases. That will help finding duplicate or inconsistencies  | 
            
            
              | 274 | 
               | 
            
            
              | 275 | 
              =cut  | 
            
            
              | 276 | 
               | 
            
            
              | 277 | 
              #sub check_coherency { | 
            
            
              | 278 | 
              #    my ( $query ) = @_;  | 
            
            
              | 279 | 
              #    $tables = get_tables_name() if not $tables;  | 
            
            
              | 280 | 
              #  | 
            
            
              | 281 | 
              #    given ( $query ) { | 
            
            
              | 282 | 
              #        when ( /CREATE TABLE(?:.*?)? `?(\w+)`?/ ) { | 
            
            
              | 283 | 
              #            my $table_name = $1;  | 
            
            
              | 284 | 
              #            if ( grep { /$table_name/ } @$tables ) { | 
            
            
              | 285 | 
              #                die "COHERENCY: Table $table_name already exists";  | 
            
            
              | 286 | 
              #            }  | 
            
            
              | 287 | 
              #        }  | 
            
            
              | 288 | 
              #  | 
            
            
              | 289 | 
              #        when ( /ALTER TABLE *`?(\w+)`? *ADD *(?:COLUMN)? `?(\w+)`?/ ) { | 
            
            
              | 290 | 
              #            my $table_name = $1;  | 
            
            
              | 291 | 
              #            my $column_name = $2;  | 
            
            
              | 292 | 
              #            next if $column_name =~ /(UNIQUE|CONSTRAINT|INDEX|KEY|FOREIGN)/;  | 
            
            
              | 293 | 
              #            if ( not grep { /$table_name/ } @$tables ) { | 
            
            
              | 294 | 
              #                return "COHERENCY: Table $table_name does not exist";  | 
            
            
              | 295 | 
              #            } else { | 
            
            
              | 296 | 
              #                my $sth = $dbh->prepare( "DESC $table_name $column_name" );  | 
            
            
              | 297 | 
              #                my $rv = $sth->execute;  | 
            
            
              | 298 | 
              #                if ( $rv > 0 ) { | 
            
            
              | 299 | 
              #                    die "COHERENCY: Field $table_name.$column_name already exists";  | 
            
            
              | 300 | 
              #                }  | 
            
            
              | 301 | 
              #            }  | 
            
            
              | 302 | 
              #        }  | 
            
            
              | 303 | 
              #  | 
            
            
              | 304 | 
              #        when ( /INSERT INTO `?(\w+)`?.*?VALUES *\((.*?)\)/ ) { | 
            
            
              | 305 | 
              #            my $table_name = $1;  | 
            
            
              | 306 | 
              #            my @values = split /,/, $2;  | 
            
            
              | 307 | 
              #            s/^ *'// foreach @values;  | 
            
            
              | 308 | 
              #            s/' *$// foreach @values;  | 
            
            
              | 309 | 
              #            given ( $table_name ) { | 
            
            
              | 310 | 
              #                when ( /systempreferences/ ) { | 
            
            
              | 311 | 
              #                    my $syspref = $values[0];  | 
            
            
              | 312 | 
              #                    my $sth = $dbh->prepare( "SELECT COUNT(*) FROM systempreferences WHERE variable = ?" );  | 
            
            
              | 313 | 
              #                    $sth->execute( $syspref );  | 
            
            
              | 314 | 
              #                    if ( ( my $count = $sth->fetchrow_array ) > 0 ) { | 
            
            
              | 315 | 
              #                        die "COHERENCY: Syspref $syspref already exists";  | 
            
            
              | 316 | 
              #                    }  | 
            
            
              | 317 | 
              #                }  | 
            
            
              | 318 | 
              #  | 
            
            
              | 319 | 
              #                when ( /permissions/){ | 
            
            
              | 320 | 
              #                    my $module_bit = $values[0];  | 
            
            
              | 321 | 
              #                    my $code = $values[1];  | 
            
            
              | 322 | 
              #                    my $sth = $dbh->prepare( "SELECT COUNT(*) FROM permissions WHERE module_bit = ? AND code = ?" );  | 
            
            
              | 323 | 
              #                    $sth->execute($module_bit, $code);  | 
            
            
              | 324 | 
              #                    if ( ( my $count = $sth->fetchrow_array ) > 0 ) { | 
            
            
              | 325 | 
              #                        die "COHERENCY: Permission $code already exists";  | 
            
            
              | 326 | 
              #                    }  | 
            
            
              | 327 | 
              #                }  | 
            
            
              | 328 | 
              #            }  | 
            
            
              | 329 | 
              #        }  | 
            
            
              | 330 | 
              #    }  | 
            
            
              | 331 | 
              #    return 1;  | 
            
            
              | 332 | 
              #}  | 
            
            
              | 333 | 
               | 
            
            
              | 334 | 
              =head2 get_error  | 
            
            
              | 335 | 
               | 
            
            
              | 336 | 
                my $errors = get_error()  | 
            
            
              | 337 | 
                This sub will return any mySQL error that occured during an update  | 
            
            
              | 338 | 
               | 
            
            
              | 339 | 
              =cut  | 
            
            
              | 340 | 
               | 
            
            
              | 341 | 
              sub get_error { | 
            
            
              | 342 | 
                  my @errors = $dbh->selectrow_array(qq{SHOW ERRORS}); # Get errors | 
            
            
              | 343 | 
                  my @warnings = $dbh->selectrow_array(qq{SHOW WARNINGS}); # Get warnings | 
            
            
              | 344 | 
                  if ( @errors ) { # Catch specifics errors | 
            
            
              | 345 | 
                      return qq{$errors[0] : $errors[1] => $errors[2]}; | 
            
            
              | 346 | 
                  } elsif ( @warnings ) { | 
            
            
              | 347 | 
                      return qq{$warnings[0] : $warnings[1] => $warnings[2]} | 
            
            
              | 348 | 
                          if $warnings[0] ne 'Note';  | 
            
            
              | 349 | 
                  }  | 
            
            
              | 350 | 
                  return;  | 
            
            
              | 351 | 
              }  | 
            
            
              | 352 | 
               | 
            
            
              | 353 | 
              =head2 get_queries  | 
            
            
              | 354 | 
               | 
            
            
              | 355 | 
                my $result = get_queries($filepath);  | 
            
            
              | 356 | 
                this sub will return a hashref with 2 entries:  | 
            
            
              | 357 | 
                  $result->{queries} is an array with all queries to execute | 
            
            
              | 358 | 
                  $result->{comments} is an array with all comments in the .sql file | 
            
            
              | 359 | 
               | 
            
            
              | 360 | 
              =cut  | 
            
            
              | 361 | 
               | 
            
            
              | 362 | 
              sub get_queries { | 
            
            
              | 363 | 
                  my ( $filepath ) = @_;  | 
            
            
              | 364 | 
                  open my $fh, "<", $filepath;  | 
            
            
              | 365 | 
                  my @queries;  | 
            
            
              | 366 | 
                  my @comments;  | 
            
            
              | 367 | 
                  if ( $filepath =~ /\.pl$/ ) { | 
            
            
              | 368 | 
                      if ( do $filepath ) { | 
            
            
              | 369 | 
                          my $infos = _get_queries();  | 
            
            
              | 370 | 
                          @queries  = @{ $infos->{queries} }  if exists $infos->{queries}; | 
            
            
              | 371 | 
                          @comments = @{ $infos->{comments} } if exists $infos->{comments}; | 
            
            
              | 372 | 
                      }  | 
            
            
              | 373 | 
                      if ( $@ ) { | 
            
            
              | 374 | 
                          die "I can't load $filepath. Please check the execute flag and if this file is a valid perl script ($@)";  | 
            
            
              | 375 | 
                      }  | 
            
            
              | 376 | 
                  } else { | 
            
            
              | 377 | 
                      my $old_delimiter = $/;  | 
            
            
              | 378 | 
                      while ( <$fh> ) { | 
            
            
              | 379 | 
                          my $line = $_;  | 
            
            
              | 380 | 
                          chomp $line;  | 
            
            
              | 381 | 
                          $line =~ s/^\s*//;  | 
            
            
              | 382 | 
                          if ( $line =~ /^--/ ) { | 
            
            
              | 383 | 
                              my @l = split $old_delimiter, $line;  | 
            
            
              | 384 | 
                              if ( @l > 1 ) { | 
            
            
              | 385 | 
                                  my $tmp_query;  | 
            
            
              | 386 | 
                                  for my $l ( @l ) { | 
            
            
              | 387 | 
                                      if ( $l =~ /^--/ ) { | 
            
            
              | 388 | 
                                          $l =~ s/^--\s*//;  | 
            
            
              | 389 | 
                                          push @comments, $l;  | 
            
            
              | 390 | 
                                          next;  | 
            
            
              | 391 | 
                                      }  | 
            
            
              | 392 | 
                                      $tmp_query .= $l . $old_delimiter;  | 
            
            
              | 393 | 
                                  }  | 
            
            
              | 394 | 
                                  push @queries, $tmp_query if $tmp_query;  | 
            
            
              | 395 | 
                                  next;  | 
            
            
              | 396 | 
                              }  | 
            
            
              | 397 | 
               | 
            
            
              | 398 | 
                              $line =~ s/^--\s*//;  | 
            
            
              | 399 | 
                              push @comments, $line;  | 
            
            
              | 400 | 
                              next;  | 
            
            
              | 401 | 
                          }  | 
            
            
              | 402 | 
                          if ( $line =~ /^delimiter (.*)$/i ) { | 
            
            
              | 403 | 
                              $/ = $1;  | 
            
            
              | 404 | 
                              next;  | 
            
            
              | 405 | 
                          }  | 
            
            
              | 406 | 
                          $line =~ s#$/##;  | 
            
            
              | 407 | 
                          push @queries, $line if not $line =~ /^\s*$/; # Push if query is not empty  | 
            
            
              | 408 | 
                      }  | 
            
            
              | 409 | 
                      $/ = $old_delimiter;  | 
            
            
              | 410 | 
                      close $fh;  | 
            
            
              | 411 | 
                  }  | 
            
            
              | 412 | 
               | 
            
            
              | 413 | 
                  return { queries => \@queries, comments => \@comments }; | 
            
            
              | 414 | 
              }  | 
            
            
              | 415 | 
               | 
            
            
              | 416 | 
              =head2 md5_already_exists  | 
            
            
              | 417 | 
               | 
            
            
              | 418 | 
                my $result = md5_already_exists($md5);  | 
            
            
              | 419 | 
                check if the md5 of an update has already been applied on the database.  | 
            
            
              | 420 | 
                If yes, it will return a hash with the version related to this md5  | 
            
            
              | 421 | 
               | 
            
            
              | 422 | 
              =cut  | 
            
            
              | 423 | 
               | 
            
            
              | 424 | 
              sub md5_already_exists { | 
            
            
              | 425 | 
                  my ( $md5 ) = @_;  | 
            
            
              | 426 | 
                  my $query = qq/SELECT version, md5 FROM updatedb_report WHERE md5 = ?/;  | 
            
            
              | 427 | 
                  my $sth = $dbh->prepare( $query );  | 
            
            
              | 428 | 
                  $sth->execute( $md5 );  | 
            
            
              | 429 | 
                  my @r;  | 
            
            
              | 430 | 
                  while ( my ( $version, $md5 ) = $sth->fetchrow ) { | 
            
            
              | 431 | 
                      push @r, { version => $version, md5 => $md5 }; | 
            
            
              | 432 | 
                  }  | 
            
            
              | 433 | 
                  $sth->finish;  | 
            
            
              | 434 | 
                  return \@r;  | 
            
            
              | 435 | 
              }  | 
            
            
              | 436 | 
               | 
            
            
              | 437 | 
              =head2 set_infos  | 
            
            
              | 438 | 
               | 
            
            
              | 439 | 
                set_info($version,$queries, $error, $md5);  | 
            
            
              | 440 | 
                this sub will insert into the updatedb tables what has been made on the database (queries, errors, result)  | 
            
            
              | 441 | 
               | 
            
            
              | 442 | 
              =cut  | 
            
            
              | 443 | 
               | 
            
            
              | 444 | 
              sub set_infos { | 
            
            
              | 445 | 
                  my ( $version, $queries, $errors, $md5 ) = @_;  | 
            
            
              | 446 | 
                  SetVersion($version) if not -s $errors;  | 
            
            
              | 447 | 
                  for my $query ( @{ $queries->{queries} } ) { | 
            
            
              | 448 | 
                      my $sth = $dbh->prepare("INSERT INTO updatedb_query(version, query) VALUES (?, ?)"); | 
            
            
              | 449 | 
                      $sth->execute( $version, $query );  | 
            
            
              | 450 | 
                      $sth->finish;  | 
            
            
              | 451 | 
                  }  | 
            
            
              | 452 | 
                  for my $error ( @$errors ) { | 
            
            
              | 453 | 
                      my $sth = $dbh->prepare("INSERT INTO updatedb_error(version, error) VALUES (?, ?)"); | 
            
            
              | 454 | 
                      $sth->execute( $version, $error );  | 
            
            
              | 455 | 
                  }  | 
            
            
              | 456 | 
                  my $sth = $dbh->prepare("INSERT INTO updatedb_report(version, md5, comment, status) VALUES (?, ?, ?, ?)"); | 
            
            
              | 457 | 
                  $sth->execute(  | 
            
            
              | 458 | 
                      $version,  | 
            
            
              | 459 | 
                      $md5,  | 
            
            
              | 460 | 
                      join ('\n', @{ $queries->{comments} }), | 
            
            
              | 461 | 
                      ( @$errors > 0 ) ? 0 : 1  | 
            
            
              | 462 | 
                  );  | 
            
            
              | 463 | 
              }  | 
            
            
              | 464 | 
               | 
            
            
              | 465 | 
              =head2 mark_as_ok  | 
            
            
              | 466 | 
               | 
            
            
              | 467 | 
                mark_as_ok($version);  | 
            
            
              | 468 | 
                this sub will force to mark as "OK" an update that has failed  | 
            
            
              | 469 | 
                once this has been made, the status will look as "forced OK", and appear in green like versions that have been applied without any problem  | 
            
            
              | 470 | 
               | 
            
            
              | 471 | 
              =cut  | 
            
            
              | 472 | 
               | 
            
            
              | 473 | 
              sub mark_as_ok { | 
            
            
              | 474 | 
                  my ( $version ) = @_;  | 
            
            
              | 475 | 
                  my $sth = $dbh->prepare( "UPDATE updatedb_report SET status = 2 WHERE version=?" );  | 
            
            
              | 476 | 
                  my $affected = $sth->execute( $version );  | 
            
            
              | 477 | 
                  if ( $affected < 1 ) { | 
            
            
              | 478 | 
                      my $filepath = get_filepath $version;  | 
            
            
              | 479 | 
                      my $queries  = get_queries $filepath;  | 
            
            
              | 480 | 
                      my $md5      = get_md5 $filepath;  | 
            
            
              | 481 | 
                      set_infos $version, $queries, undef, $md5;  | 
            
            
              | 482 | 
               | 
            
            
              | 483 | 
                      $sth->execute( $version );  | 
            
            
              | 484 | 
                  }  | 
            
            
              | 485 | 
                  $sth->finish;  | 
            
            
              | 486 | 
              }  | 
            
            
              | 487 | 
               | 
            
            
              | 488 | 
              =head2 is_uptodate  | 
            
            
              | 489 | 
                is_uptodate();  | 
            
            
              | 490 | 
                return 1 if the database is up to date else 0.  | 
            
            
              | 491 | 
                The database is up to date if all versions are excecuted.  | 
            
            
              | 492 | 
               | 
            
            
              | 493 | 
              =cut  | 
            
            
              | 494 | 
               | 
            
            
              | 495 | 
              sub is_uptodate { | 
            
            
              | 496 | 
                  my $versions_available = C4::Update::Database::list_versions_available;  | 
            
            
              | 497 | 
                  my $versions = C4::Update::Database::list_versions_already_applied;  | 
            
            
              | 498 | 
                  for my $v ( @$versions_available ) { | 
            
            
              | 499 | 
                      if ( not grep { $v eq $$_{version} } @$versions ) { | 
            
            
              | 500 | 
                          return 0;  | 
            
            
              | 501 | 
                      }  | 
            
            
              | 502 | 
                  }  | 
            
            
              | 503 | 
                  return 1;  | 
            
            
              | 504 | 
              }  | 
            
            
              | 505 | 
               | 
            
            
              | 506 | 
              =head2 TransformToNum  | 
            
            
              | 507 | 
               | 
            
            
              | 508 | 
                Transform the Koha version from a 4 parts string  | 
            
            
              | 509 | 
                to a number, with just 1 . (ie: it's a number)  | 
            
            
              | 510 | 
               | 
            
            
              | 511 | 
              =cut  | 
            
            
              | 512 | 
               | 
            
            
              | 513 | 
              sub TransformToNum { | 
            
            
              | 514 | 
                  my $version = shift;  | 
            
            
              | 515 | 
               | 
            
            
              | 516 | 
                  # remove the 3 last . to have a Perl number  | 
            
            
              | 517 | 
                  $version =~ s/(.*\..*)\.(.*)\.(.*)/$1$2$3/;  | 
            
            
              | 518 | 
                  $version =~ s/Bug(\d+)/$1/;  | 
            
            
              | 519 | 
                  return $version;  | 
            
            
              | 520 | 
              }  | 
            
            
              | 521 | 
               | 
            
            
              | 522 | 
              sub SetVersion { | 
            
            
              | 523 | 
                  my $new_version = TransformToNum(shift);  | 
            
            
              | 524 | 
                  return unless $new_version =~ /\d\.\d+/;  | 
            
            
              | 525 | 
                  my $current_version = TransformToNum( C4::Context->preference('Version') ); | 
            
            
              | 526 | 
                  unless ( C4::Context->preference('Version') ) { | 
            
            
              | 527 | 
                      my $finish = $dbh->prepare(qq{ | 
            
            
              | 528 | 
                          INSERT IGNORE INTO systempreferences (variable,value,explanation)  | 
            
            
              | 529 | 
                          VALUES ('Version',?,'The Koha database version. WARNING: Do not change this value manually, it is maintained by the webinstaller') | 
            
            
              | 530 | 
                      });  | 
            
            
              | 531 | 
                      $finish->execute($new_version);  | 
            
            
              | 532 | 
                      return;  | 
            
            
              | 533 | 
                  }  | 
            
            
              | 534 | 
                  if ( $new_version > $current_version ) { | 
            
            
              | 535 | 
                      my $finish = $dbh->prepare("UPDATE systempreferences SET value=? WHERE variable='Version'"); | 
            
            
              | 536 | 
                      $finish->execute($new_version);  | 
            
            
              | 537 | 
                  }  | 
            
            
              | 538 | 
              }  | 
            
            
              | 539 | 
               | 
            
            
              | 540 | 
              =head2 TableExists($table)  | 
            
            
              | 541 | 
               | 
            
            
              | 542 | 
              =cut  | 
            
            
              | 543 | 
               | 
            
            
              | 544 | 
              sub TableExists { | 
            
            
              | 545 | 
                  my $table = shift;  | 
            
            
              | 546 | 
                  eval { | 
            
            
              | 547 | 
                      local $dbh->{PrintError} = 0; | 
            
            
              | 548 | 
                      local $dbh->{RaiseError} = 0; | 
            
            
              | 549 | 
                      $dbh->do(qq{SELECT * FROM $table WHERE 1 = 0 }); | 
            
            
              | 550 | 
                  };  | 
            
            
              | 551 | 
                  return 1 unless $@;  | 
            
            
              | 552 | 
                  return 0;  | 
            
            
              | 553 | 
              }  | 
            
            
              | 554 | 
              1;  |