Link Here
|
|
|
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 Data::Dumper qw(Dumper); |
22 |
use File::Slurp qw(read_file); |
23 |
|
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, fh => $fh, schema_file => $s |
59 |
}); |
60 |
|
61 |
Object constructor. |
62 |
Param dbh is mandatory. Params database, fh and schema_file are |
63 |
optional. |
64 |
Param database can be used to move away from current database of |
65 |
db handle. |
66 |
Param fh can be used to redirect output. |
67 |
Param schema_file is needed for resetting to schema. Falls back to |
68 |
the constant for Koha structure file. |
69 |
|
70 |
=cut |
71 |
|
72 |
sub new { |
73 |
my ( $class, $params ) = @_; # params: database, dbh, fh, schema_file |
74 |
my $self = bless $params // {}, $class; |
75 |
|
76 |
Koha::Exceptions::MissingParameter->throw( parameter => 'dbh' ) unless $self->{dbh}; |
77 |
Koha::Exceptions::WrongParameter->throw( name => 'dbh', type => ref($self->{dbh}) ) |
78 |
unless ref($self->{dbh}) eq DBI_HANDLE_CLASS; |
79 |
|
80 |
$self->{database} //= ( $self->{dbh}->selectrow_array('SELECT DATABASE()') )[0]; |
81 |
$self->{fh} //= *STDOUT; |
82 |
$self->{schema_file} //= KOHA_STRUCTURE; |
83 |
$self->{schema_info} = {}; |
84 |
|
85 |
return $self; |
86 |
} |
87 |
|
88 |
=head2 clear |
89 |
|
90 |
$object->clear({ dry_run => 0, table => $table, verbose => 0 }); |
91 |
|
92 |
Clears all current column comments in storage. |
93 |
If table is passed, only that table is changed. |
94 |
Dry run only prints sql statements. |
95 |
|
96 |
=cut |
97 |
|
98 |
sub clear { |
99 |
my ( $self, $params ) = @_; # dry_run, table, verbose |
100 |
my $cols = $self->_fetch_stored_comments($params); |
101 |
foreach my $col ( @$cols ) { |
102 |
next if !$col->{column_comment}; |
103 |
next if $params->{table} && $col->{table_name} ne $params->{table}; |
104 |
$self->_change_column( $col->{table_name}, $col->{column_name}, undef, $params ); # undef clears |
105 |
} |
106 |
} |
107 |
|
108 |
=head2 reset_to_schema |
109 |
|
110 |
$object->reset_to_schema({ dry_run => 0, table => $table, verbose => 0 }); |
111 |
|
112 |
Resets column comments in storage to schema definition. |
113 |
Other column comments are cleared. |
114 |
When you pass table, only that table is changed. |
115 |
Dry run only prints sql statements. |
116 |
|
117 |
=cut |
118 |
|
119 |
sub reset_to_schema { |
120 |
my ( $self, $params ) = @_; # dry_run, table, verbose |
121 |
$self->clear($params); |
122 |
my $schema_comments = $self->_fetch_schema_comments; |
123 |
foreach my $table ( sort keys %$schema_comments ) { |
124 |
next if $params->{table} && $table ne $params->{table}; |
125 |
foreach my $col ( sort keys %{$schema_comments->{$table}} ) { |
126 |
$self->_change_column( $table, $col, $schema_comments->{$table}->{$col}, $params ); |
127 |
} |
128 |
} |
129 |
} |
130 |
|
131 |
=head2 renumber |
132 |
|
133 |
$object->renumber({ dry_run => 0, table => $table, verbose => 0 }); |
134 |
|
135 |
This is primarily meant for testing purposes (verifying results across |
136 |
whole database). |
137 |
It adds comments like Comment_1, Comment_2 etc. |
138 |
When you pass table, only that table is changed. Otherwise all tables |
139 |
are affected; note that the column counter does not reset by table. |
140 |
Dry run only prints sql statements. |
141 |
|
142 |
=cut |
143 |
|
144 |
sub renumber { |
145 |
my ( $self, $params ) = @_; # dry_run, table, verbose |
146 |
my $cols = $self->_fetch_stored_comments($params); |
147 |
my $i = 0; |
148 |
foreach my $col ( @$cols ) { |
149 |
next if $params->{table} && $col->{table_name} ne $params->{table}; |
150 |
$i++; |
151 |
$self->_change_column( $col->{table_name}, $col->{column_name}, "Column_$i", $params ); |
152 |
} |
153 |
} |
154 |
|
155 |
=head1 INTERNAL ROUTINES |
156 |
|
157 |
=cut |
158 |
|
159 |
=head2 _fetch_schema_comments |
160 |
|
161 |
=cut |
162 |
|
163 |
sub _fetch_schema_comments { |
164 |
# Wish we had a DBIC function for this, showing comments too ;) Now using kohastructure as source of truth. |
165 |
my ( $self ) = @_; |
166 |
my $file = $self->{schema_file}; |
167 |
Koha::Exceptions::FileNotFound->throw( filename => $file ) unless -e $file; |
168 |
|
169 |
return $self->{schema_info} if keys %{$self->{schema_info}}; |
170 |
|
171 |
my @schema_lines = read_file( $file ); |
172 |
my $info = {}; |
173 |
my $current_table = q{}; |
174 |
foreach my $line ( @schema_lines ) { |
175 |
if( $line =~ /^CREATE TABLE `?(\w+)`?/ ) { |
176 |
$current_table = $1; |
177 |
} elsif( $line =~ /^\s+`?(\w+)`?.*COMMENT ['"](.+)['"][,)]?$/ ) { |
178 |
my ( $col, $comment ) = ( $1, $2 ); |
179 |
$comment =~ s/''/'/g; # we call quote later on |
180 |
$info->{$current_table}->{$col} = $comment; |
181 |
} |
182 |
} |
183 |
return $self->{schema_info} = $info; |
184 |
} |
185 |
|
186 |
=head2 _fetch_stored_comments |
187 |
|
188 |
=cut |
189 |
|
190 |
sub _fetch_stored_comments { |
191 |
my ( $self, $params ) = @_; # params: table |
192 |
my $sql = q| |
193 |
SELECT table_name, column_name, column_comment FROM information_schema.columns |
194 |
WHERE table_schema=? AND table_name=? |
195 |
ORDER BY table_name, column_name|; |
196 |
$sql =~ s/AND table_name=\?// unless $params->{table}; |
197 |
return $self->{dbh}->selectall_arrayref( $sql, { Slice => {} }, $self->{database}, $params->{table} || () ); |
198 |
} |
199 |
|
200 |
=head2 _change_column |
201 |
|
202 |
=cut |
203 |
|
204 |
sub _change_column { |
205 |
# NOTE: We do not want to use DBIx schema here, but we use stored structure, |
206 |
# since we only want to change comment not actual table structure. |
207 |
my ( $self, $table_name, $column_name, $comment, $params ) = @_; # params: dry_run, verbose |
208 |
$params //= {}; |
209 |
|
210 |
my $dbh = $self->{dbh}; |
211 |
my $info = $self->_columns_info( $table_name )->{$column_name}; |
212 |
|
213 |
# datatype; nullable, collation |
214 |
my $rv = qq|ALTER TABLE $self->{database}.$table_name MODIFY COLUMN `$column_name` $info->{Type} |; |
215 |
$rv .= 'NOT NULL ' if $info->{Null} eq 'NO'; |
216 |
$rv .= "COLLATE $info->{Collation} " if $info->{Collation}; |
217 |
|
218 |
# Default - needs a bit of tweaking |
219 |
if( !defined $info->{Default} && $info->{Null} eq 'NO' ) { |
220 |
# Do not provide a default |
221 |
} elsif( $info->{Type} =~ /char|text|enum/i ) { |
222 |
if( !defined $info->{Default} ) { |
223 |
$rv .= "DEFAULT NULL "; |
224 |
} else { #includes: $info->{Default} eq '' || $info->{Default} eq '0' |
225 |
$rv .= "DEFAULT ". $dbh->quote($info->{Default}). " "; |
226 |
} |
227 |
} elsif( !$info->{Default} && $info->{Type} =~ /timestamp/ ) { # Peculiar correction for nullable timestamps |
228 |
$rv .= 'NULL DEFAULT NULL ' if $info->{Null} eq 'YES'; |
229 |
} else { |
230 |
$rv .= "DEFAULT ". ( $info->{Default} // 'NULL' ). " "; |
231 |
} |
232 |
|
233 |
# Extra (like autoincrement) |
234 |
$rv .= $info->{Extra}. ' ' if $info->{Extra}; |
235 |
|
236 |
# Comment if passed; not passing means clearing actually. |
237 |
if( $comment ) { |
238 |
$comment = $dbh->quote($comment) unless $comment =~ /\\'/; # Prevent quoting twice |
239 |
$rv .= "COMMENT ". $comment; |
240 |
} |
241 |
$rv =~ s/\s+$//; # remove trailing spaces |
242 |
|
243 |
# Print |
244 |
if( $params->{dry_run} ) { |
245 |
print { $self->{fh} } "$rv;\n"; |
246 |
return; |
247 |
} |
248 |
# Deploy |
249 |
eval { $dbh->do($rv) }; |
250 |
if( $@ ) { |
251 |
warn "Failure for $table_name:$column_name"; |
252 |
print { $self->{fh} } "-- FAILED: $rv;\n"; |
253 |
} elsif( $params->{verbose} ) { |
254 |
print { $self->{fh} } "$rv;\n"; |
255 |
} |
256 |
} |
257 |
|
258 |
sub _columns_info { |
259 |
my ( $self, $table ) = @_; |
260 |
return $self->{dbh}->selectall_hashref( 'SHOW FULL COLUMNS FROM '. $self->{database}. '.'. $table, 'Field' ); |
261 |
} |
262 |
|
263 |
1; |
264 |
__END__ |
265 |
|
266 |
=head1 ADDITIONAL COMMENTS |
267 |
|
268 |
The module contains the core code for the options of the maintenance |
269 |
script sync_db_comments.pl. |
270 |
|
271 |
It can be tested additionally with Commenter.t, but note that since |
272 |
SQL DDL statements - as generated by this module - implicitly commit, |
273 |
we are not modifying actual Koha tables in that test. |
274 |
|
275 |
=head1 AUTHOR |
276 |
|
277 |
Marcel de Rooy, Rijksmuseum Amsterdam, The Netherlands |
278 |
|
279 |
=cut |