Koha/Database/Commenter.pm

   1 package Koha::Database::Commenter;
   2
   3 # Copyright 2022 Rijksmuseum, Koha development team
   4 #
   5 # This file is part of Koha.
   6 #
   7 # Koha is free software; you can redistribute it and/or modify it
   8 # under the terms of the GNU General Public License as published by
   9 # the Free Software Foundation; either version 3 of the License, or
  10 # (at your option) any later version.
  11 #
  12 # Koha is distributed in the hope that it will be useful, but
  13 # WITHOUT ANY WARRANTY; without even the implied warranty of
  14 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  15 # GNU General Public License for more details.
  16 #
  17 # You should have received a copy of the GNU General Public License
  18 # along with Koha; if not, see <http://www.gnu.org/licenses>.
  19
  20 use Modern::Perl;
  21 use File::Slurp qw(read_file);
  22
  23 use C4::Context;
  24 use Koha::Exceptions;
  25
  26 use constant KOHA_STRUCTURE => 'installer/data/mysql/kohastructure.sql';
  27 use constant DBI_HANDLE_CLASS => 'DBI::db';
  28
  29 =head1 NAME
  30
  31 Koha::Database::Commenter - Manage column comments in database
  32
  33 =head1 SYNOPSIS
  34
  35     use Koha::Database::Commenter;
  36     $mgr = Koha::Database::Commenter->new({ dbh => $dbh });
  37
  38     $mgr->reset_to_schema;
  39     # OR:
  40     $mgr->clear;
  41
  42 =head1 DESCRIPTION
  43
  44     This object helps you to keep column comments in your database in sync
  45     with the Koha schema. It also allows you to clear all comments.
  46
  47     The advantage of keeping in sync is that you can easily track differences
  48     between schema and database with the maintenance script
  49     update_dbix_class_files.pl.
  50
  51     Tip: make a backup of your database before running this script.
  52
  53 =head1 METHODS
  54
  55 =head2 new
  56
  57     $mgr = Koha::Database::Commenter->new({
  58         dbh => $dbh, database => $d, schema_file => $s
  59     });
  60
  61     Object constructor.
  62     Param dbh is mandatory. Params database and schema_file are
  63     optional.
  64     Param database can be used to move away from current database of
  65     db handle.
  66     Param schema_file is needed for resetting to schema. Falls back to
  67     the constant for Koha structure file.
  68
  69 =cut
  70
  71 sub new {
  72     my ( $class, $params ) = @_; # params: database, dbh, schema_file
  73     my $self = bless $params // {}, $class;
  74
  75     Koha::Exceptions::MissingParameter->throw( parameter => 'dbh' ) unless $self->{dbh};
  76     Koha::Exceptions::WrongParameter->throw( name => 'dbh', type => ref($self->{dbh}) )
  77         unless ref($self->{dbh}) eq DBI_HANDLE_CLASS;
  78
  79     $self->{database} //= ( $self->{dbh}->selectrow_array('SELECT DATABASE()') )[0];
  80     $self->_find_schema;
  81     $self->{schema_info} = {};
  82
  83     return $self;
  84 }
  85
  86 =head2 clear
  87
  88     $object->clear({ dry_run => 0, table => $table }, $messages );
  89
  90     Clears all current column comments in storage.
  91     If table is passed, only that table is changed.
  92     Dry run only returns sql statements in $messages (arrayref).
  93
  94 =cut
  95
  96 sub clear {
  97     my ( $self, $params, $messages ) = @_; # dry_run, table
  98     my $cols = $self->_fetch_stored_comments($params);
  99     foreach my $col ( @$cols ) {
 100         next if !$col->{column_comment};
 101         next if $params->{table} && $col->{table_name} ne $params->{table};
 102         $self->_change_column( $col->{table_name}, $col->{column_name}, undef, $params, $messages ); # undef clears
 103     }
 104 }
 105
 106 =head2 reset_to_schema
 107
 108     $object->reset_to_schema({ dry_run => 0, table => $table }, $messages );
 109
 110     Resets column comments in storage to schema definition.
 111     Other column comments are cleared.
 112     When you pass table, only that table is changed.
 113     Dry run only returns sql statements in $messages (arrayref).
 114
 115 =cut
 116
 117 sub reset_to_schema {
 118     my ( $self, $params, $messages ) = @_; # dry_run, table
 119     $self->clear( $params, $messages );
 120     my $schema_comments = $self->_fetch_schema_comments;
 121     foreach my $table ( sort keys %$schema_comments ) {
 122         next if $params->{table} && $table ne $params->{table};
 123         foreach my $col ( sort keys %{$schema_comments->{$table}} ) {
 124             $self->_change_column( $table, $col, $schema_comments->{$table}->{$col}, $params, $messages );
 125         }
 126     }
 127 }
 128
 129 =head2 renumber
 130
 131     $object->renumber({ dry_run => 0, table => $table }, $messages );
 132
 133     This is primarily meant for testing purposes (verifying results across
 134     whole database).
 135     It adds comments like Comment_1, Comment_2 etc.
 136     When you pass table, only that table is changed. Otherwise all tables
 137     are affected; note that the column counter does not reset by table.
 138     Dry run only returns sql statements in $messages (arrayref).
 139
 140 =cut
 141
 142 sub renumber {
 143     my ( $self, $params, $messages ) = @_; # dry_run, table
 144     my $cols = $self->_fetch_stored_comments($params);
 145     my $i = 0;
 146     foreach my $col ( @$cols ) {
 147         next if $params->{table} && $col->{table_name} ne $params->{table};
 148         $i++;
 149         $self->_change_column( $col->{table_name}, $col->{column_name}, "Column_$i", $params, $messages );
 150     }
 151 }
 152
 153 =head1 INTERNAL ROUTINES
 154
 155 =head2 _find_schema
 156
 157 =cut
 158
 159 sub _find_schema {
 160     my $self = shift;
 161     my $rootdir = C4::Context->config('intranetdir');
 162     if( $self->{schema_file} ) {
 163         warn "File ". $self->{schema_file}. " not found!\n" if !-e $self->{schema_file};
 164     } elsif( -e "$rootdir/". KOHA_STRUCTURE ) {
 165         $self->{schema_file} = "$rootdir/". KOHA_STRUCTURE;
 166     } elsif( -e "$rootdir/intranet/cgi-bin/". KOHA_STRUCTURE ) {
 167         $self->{schema_file} = "$rootdir/intranet/cgi-bin/". KOHA_STRUCTURE;
 168     }
 169 }
 170
 171 =head2 _fetch_schema_comments
 172
 173 =cut
 174
 175 sub _fetch_schema_comments {
 176 # Wish we had a DBIC function for this, showing comments too ;) Now using kohastructure as source of truth.
 177     my ( $self ) = @_;
 178     my $file = $self->{schema_file};
 179     Koha::Exceptions::FileNotFound->throw( filename => $file ) unless $file && -e $file;
 180
 181     return $self->{schema_info} if keys %{$self->{schema_info}};
 182
 183     my @schema_lines = read_file( $file );
 184     my $info = {};
 185     my $current_table = q{};
 186     foreach my $line ( @schema_lines ) {
 187         if( $line =~ /^CREATE TABLE\s*(?:IF NOT EXISTS)?\s*`?(\w+)`?/ ) {
 188             $current_table = $1;
 189         } elsif( $current_table && $line =~ /^\s+`?(\w+)`?.*COMMENT ['"](.+)['"][,)]?$/ ) {
 190             my ( $col, $comment ) = ( $1, $2 );
 191             $comment =~ s/''/'/g; # we call quote later on
 192             $info->{$current_table}->{$col} = $comment;
 193         }
 194     }
 195     return $self->{schema_info} = $info;
 196 }
 197
 198 =head2 _fetch_stored_comments
 199
 200 =cut
 201
 202 sub _fetch_stored_comments {
 203     my ( $self, $params ) = @_; # params: table
 204     my $sql = q|
 205 SELECT table_name AS `table_name`, column_name AS `column_name`, column_comment AS `column_comment`
 206 FROM information_schema.columns
 207 WHERE table_schema=? AND table_name=?
 208 ORDER BY table_name, column_name|;
 209 # The AS `table_name` etc. is needed for MySQL8 which returns uppercase columns in information_schema
 210     $sql =~ s/AND table_name=\?// unless $params->{table};
 211     return $self->{dbh}->selectall_arrayref( $sql, { Slice => {} }, $self->{database}, $params->{table} || () );
 212 }
 213
 214 =head2 _change_column
 215
 216 =cut
 217
 218 sub _change_column {
 219 # NOTE: We do not want to use DBIx schema here, but we use stored structure,
 220 # since we only want to change comment not actual table structure.
 221     my ( $self, $table_name, $column_name, $comment, $params, $messages ) = @_; # params: dry_run
 222     $params //= {};
 223
 224     my $dbh = $self->{dbh};
 225     my $info = $self->_columns_info( $table_name )->{$column_name};
 226
 227     # datatype; nullable, collation
 228     my $rv = qq|ALTER TABLE $self->{database}.$table_name MODIFY COLUMN `$column_name` $info->{Type} |;
 229     $rv .= 'NOT NULL ' if $info->{Null} eq 'NO';
 230     $rv .= "COLLATE $info->{Collation} " if $info->{Collation};
 231
 232     # Default - needs a bit of tweaking
 233     if( !defined $info->{Default} && $info->{Null} eq 'NO' ) {
 234         # Do not provide a default
 235     } elsif( $info->{Type} =~ /char|text|enum/i ) {
 236         if( !defined $info->{Default} ) {
 237             $rv .= "DEFAULT NULL ";
 238         } else {      #includes: $info->{Default} eq '' || $info->{Default} eq '0'
 239             $rv .= "DEFAULT ". $dbh->quote($info->{Default}). " ";
 240         }
 241     } elsif( !$info->{Default} && $info->{Type} =~ /timestamp/ ) { # Peculiar correction for nullable timestamps
 242         $rv .= 'NULL DEFAULT NULL ' if $info->{Null} eq 'YES';
 243     } else {
 244         $rv .= "DEFAULT ". ( $info->{Default} // 'NULL' ). " ";
 245     }
 246
 247     # Extra (like autoincrement)
 248     $info->{Extra} =~ s/DEFAULT_GENERATED//; # need to remove it for mysql8 timestamps
 249     $rv .= $info->{Extra}. ' ' if $info->{Extra};
 250
 251     # Comment if passed; not passing means clearing actually.
 252     if( $comment ) {
 253         $comment = $dbh->quote($comment) unless $comment =~ /\\'/; # Prevent quoting twice
 254         $rv .= "COMMENT ". $comment;
 255     }
 256     $rv =~ s/\s+$//; # remove trailing spaces
 257
 258     # Dry run
 259     if( $params->{dry_run} ) {
 260         push @$messages, "$rv;" if $messages;
 261         return;
 262     }
 263
 264     # Deploy
 265     eval { $dbh->do($rv) };
 266     if( $@ ) {
 267         warn "Failure for $table_name:$column_name";
 268         push @$messages, "-- FAILED: $rv;" if $messages;
 269     } else {
 270         push @$messages, "$rv;" if $messages;
 271     }
 272 }
 273
 274 sub _columns_info {
 275     my ( $self, $table ) = @_;
 276     return $self->{dbh}->selectall_hashref( 'SHOW FULL COLUMNS FROM '. $self->{database}. '.'. $table, 'Field' );
 277 }
 278
 279 1;
 280 __END__
 281
 282 =head1 ADDITIONAL COMMENTS
 283
 284     The module contains the core code for the options of the maintenance
 285     script sync_db_comments.pl.
 286
 287     It can be tested additionally with Commenter.t, but note that since
 288     SQL DDL statements - as generated by this module - implicitly commit,
 289     we are not modifying actual Koha tables in that test.
 290
 291 =head1 AUTHOR
 292
 293     Marcel de Rooy, Rijksmuseum Amsterdam, The Netherlands
 294
 295 =cut