source: main/trunk/greenstone2/perllib/gsmysql.pm@ 32595

Last change on this file since 32595 was 32595, checked in by ak19, 5 years ago

Major tidying up: last remaining debug statements, lots of comments, removed TODO lists.

File size: 36.0 KB
RevLine 
[32529]1###########################################################################
2#
[32592]3# gsmysql.pm -- Uses DBI for MySQL related utility functions used by
[32583]4# GreenstoneSQLPlugout and GreenstoneSQLPlugin too.
[32529]5# A component of the Greenstone digital library software
6# from the New Zealand Digital Library Project at the
7# University of Waikato, New Zealand.
8#
9# Copyright (C) 1999 New Zealand Digital Library Project
10#
11# This program is free software; you can redistribute it and/or modify
12# it under the terms of the GNU General Public License as published by
13# the Free Software Foundation; either version 2 of the License, or
14# (at your option) any later version.
15#
16# This program is distributed in the hope that it will be useful,
17# but WITHOUT ANY WARRANTY; without even the implied warranty of
18# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
19# GNU General Public License for more details.
20#
21# You should have received a copy of the GNU General Public License
22# along with this program; if not, write to the Free Software
23# Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
24#
25###########################################################################
26
[32592]27package gsmysql;
[32529]28
29use strict;
30no strict 'refs';
31no strict 'subs';
32
[32536]33use DBI; # the central package for this module used by GreenstoneSQL Plugout and Plugin
[32594]34use FileUtils;
35use gsprintf;
[32529]36
[32588]37#################
38# Database functions that use the perl DBI module (with the DBD driver module for mysql)
39# https://metacpan.org/pod/release/TIMB/DBI-1.634_50/DBI.pm
40# https://metacpan.org/pod/DBD::mysql
41#################
[32581]42
[32580]43
[32578]44# singleton connection
45my $_dbh_instance = undef; # calls undef() function. See https://perlmaven.com/undef-and-defined-in-perl
46my $ref_count = 0;
47
[32530]48
[32588]49# Add signal handlers to cleanup and disconnect from db on sudden termination, incl cancel build
50# https://www.perl.com/article/37/2013/8/18/Catch-and-Handle-Signals-in-Perl/
[32582]51$SIG{INT} = \&finish_signal_handler;
52$SIG{TERM} = \&finish_signal_handler;
53$SIG{KILL} = \&finish_signal_handler;
54
55sub finish_signal_handler {
56 my ($sig) = @_; # one of INT|KILL|TERM
57
58 if ($_dbh_instance) { # database handle (note, using singleton) still active.
59
[32588]60 # If autocommit wasn't set, then this is a cancel operation.
[32582]61 # If we've not disconnected from the sql db yet and if we've not committed
62 # transactions yet, then cancel means we do a rollback here
63
64 if($_dbh_instance->{AutoCommit} == 0) {
65 print STDERR " User cancelled: rolling back SQL database transaction.\n";
66 $_dbh_instance->rollback(); # will warn on failure, nothing more we can/want to do,
[32594]67
68 print STDERR "****************************\n";
69 &gsprintf::gsprintf(STDERR, "{gsmysql.restore_backups_on_build_cancel_msg}\n");
70 print STDERR "****************************\n";
[32595]71
72 # TODO?
73 # Since we'll be disconnecting (cancel -> die() -> dbi::DESTROY() -> dbi::disconnect()),
74 # ensure $sth->finish() called on statement handles if any fetch remnants remain
[32582]75 }
76 }
77
78 die "Caught a $sig signal $!"; # die() will always call destructor (sub DESTROY)
79}
80
[32595]81
82# Need to pass in to constructor for creating member variables:
83# - collection_name
84# - verbosity
85
86# For connection to MySQL, need:
87# - db_driver, db_client_user, db_client_pwd, db_host, (db_port not used at present)
88# So these will be parameterised, but in a hashmap, for just the connect() method.
89
90# Parameterise (one or more methods may use them):
91# - db_name (which is the GS3 sitename, or "greenstone2" for GS2)
92
93# Don't need to parameterise the db_encoding (db content encoding)
94# This is for now an internal variable, as the Greenstone db contents are always going to be utf8
95# reflecting how their doc.xml counterparts should only contain utf8.
96#
97# - MySQL can set the desired db_encoding at server, db, table levels.
98# Not sure whether other DBs support it at the same levels.
99# For MySQL we set the enc during connect at server level.
100#
[32529]101sub new
[32561]102{
[32529]103 my $class = shift(@_);
104
105 my ($params_map) = @_;
106
107
[32531]108 # https://stackoverflow.com/questions/7083453/copying-a-hashref-in-perl
109 # Making a shallow copy works, and can handle unknown params:
110 #my $self = $params_map;
[32529]111
[32531]112 # but being explicit for class params needed for MySQL:
113 my $self = {
114 'collection_name' => $params_map->{'collection_name'},
[32560]115 'verbosity' => $params_map->{'verbosity'} || 1
[32531]116 };
117
[32559]118 # The db_encoding option is presently not passed in to this constructor as parameter.
119 # Placed here to indicate it's sort of optional.
120 # Since docxml are all in utf8, the contents of the GS SQL database should be too,
121 # So making utf8 the hidden default at present.
122 $self->{'db_encoding'} = $params_map->{'db_encoding'} || "utf8";
123
[32561]124 $self = bless($self, $class);
125
126 $self->{'tablename_prefix'} = $self->sanitize_name($params_map->{'collection_name'});
127
128 return $self;
[32529]129}
130
[32581]131# On die(), an object's destructor is called.
132# See https://www.perl.com/article/37/2013/8/18/Catch-and-Handle-Signals-in-Perl/
133# We want to ensure we've closed the db connection in such cases.
134# "It’s common to call die when handling SIGINT and SIGTERM. die is useful because it will ensure that Perl stops correctly: for example Perl will execute a destructor method if present when die is called, but the destructor method will not be called if a SIGINT or SIGTERM is received and no signal handler calls die."
[32582]135#
[32583]136# Useful: https://perldoc.perl.org/perlobj.html#Destructors
[32588]137# For more on when destroy is called, see https://www.perlmonks.org/?node_id=1020920
[32582]138#
[32595]139# However, database is automatically disconnected on DBI DESTROY method called by perl on
140# a perl process' termination:
141#
[32582]142# https://metacpan.org/pod/release/TIMB/DBI-1.634_50/DBI.pm#disconnect
[32595]143# 'Disconnects the database from the database handle. disconnect is typically only used before exiting the program. The handle is of little use after disconnecting.
[32582]144#
145# The transaction behaviour of the disconnect method is, sadly, undefined. Some database systems (such as Oracle and Ingres) will automatically commit any outstanding changes, but others (such as Informix) will rollback any outstanding changes. Applications not using AutoCommit should explicitly call commit or rollback before calling disconnect.
146#
147# The database is automatically disconnected by the DESTROY method if still connected when there are no longer any references to the handle. The DESTROY method for each driver should implicitly call rollback to undo any uncommitted changes. This is vital behaviour to ensure that incomplete transactions don't get committed simply because Perl calls DESTROY on every object before exiting. Also, do not rely on the order of object destruction during "global destruction", as it is undefined.
148#
149# Generally, if you want your changes to be committed or rolled back when you disconnect, then you should explicitly call "commit" or "rollback" before disconnecting.
150#
[32595]151# If you disconnect from a database while you still have active statement handles (e.g., SELECT statement handles that may have more data to fetch), you will get a warning. The warning may indicate that a fetch loop terminated early, perhaps due to an uncaught error. To avoid the warning call the finish method on the active handles.'
[32582]152#
[32591]153#
[32581]154sub DESTROY {
155 my $self = shift;
[32585]156
[32581]157 if (${^GLOBAL_PHASE} eq 'DESTRUCT') {
[32591]158
[32582]159 if ($_dbh_instance) { # database handle still active. Use singleton handle!
[32591]160 # dbh instance being active implies build was cancelled
[32582]161
[32591]162 # rollback code has moved to finish_signal_handler() where it belongs
163 # as rollback() should only happen on cancel/unnatural termination
164 # vs commit() happening in finished() before disconnect, which is natural termination.
165
[32583]166
167 # We're now finally ready to disconnect, as is required for both natural and premature termination
[32591]168 # (Though natural termination would have disconnected already)
169 # We now leave DBI's own destructor to do the disconnection when perl calls its DESTROY()
170 # We'll just print a message to stop anyone from worrying whether cancelling build
171 # will ensure disconnection still happens. It happens, but silently.
172 print STDERR " Global Destruct Phase: DBI's own destructor will disconnect database\n";
[32595]173
174 # When we did the disconnection manually on premature termination:
[32591]175 #$_dbh_instance->disconnect or warn $_dbh_instance->errstr;
176 #$_dbh_instance = undef;
177 #$ref_count = 0;
[32581]178 }
179 return;
180 }
[32583]181
[32585]182 # "Always include a call to $self->SUPER::DESTROY in our destructors (even if we don't yet have any base/parent classes). (p. 145)"
183 # Superclass and destroy, call to SUPER: https://www.perlmonks.org/?node_id=879920
[32588]184 # discussion also covers multiple-inheritance (MI)
[32585]185 $self->SUPER::DESTROY if $self->can("SUPER::DESTROY");
186
[32581]187}
[32578]188
[32529]189
190
[32538]191################### BASIC DB OPERATIONS ##################
192
[32529]193# NOTE: FULLTEXT is a reserved keyword in (My)SQL. So we can't name a table or any of its columns "fulltext".
194# https://dev.mysql.com/doc/refman/5.5/en/keywords.html
195
196
[32578]197
198# SINGLETON / GET INSTANCE PATTERN
199# https://stackoverflow.com/questions/16655603/perl-objects-class-variable-initialization
200# https://stackoverflow.com/questions/7587157/how-can-i-set-a-static-variable-that-can-be-accessed-by-all-subclasses-of-the-sa
201# Singleton without Moose: https://www.perl.com/article/52/2013/12/11/Implementing-the-singleton-pattern-in-Perl/
202
203sub connect_to_db
204{
[32529]205 my $self= shift (@_);
[32594]206 my ($params_map) = @_; # map instead of named vars with an eye on gssql inheritance
[32578]207
208 $params_map->{'db_encoding'} = $self->{'db_encoding'};
209 $params_map->{'verbosity'} = $self->{'verbosity'};
210
211 $self->{'db_handle'} = &_get_connection_instance($params_map); # getting singleton (class method)
212 if($self->{'db_handle'}) {
213 $ref_count++; # if successful, keep track of the number of refs to the single db connection
214 return $self->{'db_handle'};
215 }
216 return undef;
217}
218
219# SINGLETON METHOD #
220sub _get_connection_instance
221{
222 #my $self= shift (@_); # singleton method doesn't use self, but callers don't need to know that
[32594]223 my ($params_map) = @_;
224
[32582]225
[32578]226 return $_dbh_instance if($_dbh_instance);
[32595]227 # or else make the connection, as happens below
[32578]228
[32594]229
230 # some useful user messages first
231 if(!defined $params_map->{'autocommit'} && $params_map->{'verbosity'}) {
232 print STDERR " Autocommit parameter not defined\n";
233 }
234 if($params_map->{'autocommit'}) {
235 print STDERR " SQL DB CANCEL SUPPORT OFF.\n" if($params_map->{'verbosity'} > 2);
236 } else { # rollback on cancel support on
237 &issue_backup_on_build_message();
238 }
239
[32578]240
[32559]241 # For proper utf8 support in MySQL, encoding should be 'utf8mb4' as 'utf8' is insufficient
[32578]242 my $db_enc = "utf8mb4" if $params_map->{'db_encoding'} eq "utf8";
[32529]243
[32591]244 # Params for connecting to MySQL
245 # These params are ensured default/fallback values by the GS SQL Plugs
246 # so no need to set it here
247 my $db_driver = $params_map->{'db_driver'};
248 my $db_host = $params_map->{'db_host'};
249 my $db_user = $params_map->{'db_client_user'};
250
251 # params that can be undef are db_client_pwd and db_port
[32580]252 my $db_pwd = $params_map->{'db_client_pwd'}; # even if undef and password was necessary,
253 # we'll see a sensible error message when connect fails
254 # localhost doesn't work for us, but 127.0.0.1 works
255 # https://metacpan.org/pod/DBD::mysql
256 # "The hostname, if not specified or specified as '' or 'localhost', will default to a MySQL server
257 # running on the local machine using the default for the UNIX socket. To connect to a MySQL server
258 # on the local machine via TCP, you must specify the loopback IP address (127.0.0.1) as the host."
259 my $db_port = $params_map->{'db_port'}; # leave as undef if unspecified,
260 # as our tests never used port anyway (must have internally
261 # defaulted to whatever default port is used for MySQL)
262
263
[32529]264 #my $connect_str = "dbi:$db_driver:database=$db_name;host=$db_host";
[32580]265 # But don't provide db now - this allows checking the db exists later when loading the db
266 my $connect_str = "dbi:$db_driver:host=$db_host";
267 $connect_str .= ";port=$db_port" if $db_port;
[32558]268
[32578]269 if($params_map->{'verbosity'}) {
[32560]270 print STDERR "Away to make connection to $db_driver database with:\n";
271 print STDERR " - hostname $db_host; username: $db_user";
[32563]272 print STDERR "; and the provided password" if $db_pwd;
[32560]273 print STDERR "\nAssuming the mysql server has been started with: --character_set_server=utf8mb4\n" if $db_driver eq "mysql";
274 }
[32582]275
276 # DBI AutoCommit connection param is on/1 by default, so if a value for this is not defined
277 # as a method parameter to _get_connection_instance, then fallback to the default of on/1
[32588]278 # More: https://www.oreilly.com/library/view/programming-the-perl/1565926994/re44.html
[32582]279 my $autocommit = (defined $params_map->{'autocommit'}) ? $params_map->{'autocommit'} : 1;
[32595]280
281 # Useful: https://www.effectiveperlprogramming.com/2010/07/set-custom-dbi-error-handlers/
[32558]282
[32529]283 my $dbh = DBI->connect("$connect_str", $db_user, $db_pwd,
284 {
285 ShowErrorStatement => 1, # more informative as DBI will append failed SQL stmt to error message
286 PrintError => 1, # on by default, but being explicit
287 RaiseError => 0, # off by default, but being explicit
[32582]288 AutoCommit => $autocommit,
[32595]289 mysql_enable_utf8mb4 => 1 # tells MySQL to use (4 byte) UTF-8 for
290 # communication and tells DBD::mysql to use it to decode the data,
291 # see https://stackoverflow.com/questions/46727362/perl-mysql-utf8mb4-issue-possible-bug
[32529]292 });
293
294 if(!$dbh) {
[32557]295 # NOTE, despite handle dbh being undefined, error code will be in DBI->err (note caps)
[32529]296 return 0;
297 }
298
299 # set encoding https://metacpan.org/pod/DBD::mysql
300 # https://dev.mysql.com/doc/refman/5.7/en/charset.html
301 # https://dev.mysql.com/doc/refman/5.7/en/charset-conversion.html
[32557]302 # Setting the encoding at db server level: $dbh->do("set NAMES '" . $db_enc . "'");
303 # HOWEVER:
304 # It turned out insufficient setting the encoding to utf8, as that only supports utf8 chars that
305 # need up to 3 bytes. We may need up to 4 bytes per utf8 character, e.g. chars with macron,
306 # and for that, we need the encoding to be set to utf8mb4.
307 # To set up a MySQL db to use utf8mb4 requires configuration on the server side too.
308 # https://stackoverflow.com/questions/10957238/incorrect-string-value-when-trying-to-insert-utf-8-into-mysql-via-jdbc
309 # https://stackoverflow.com/questions/46727362/perl-mysql-utf8mb4-issue-possible-bug
310 # To set up the db for utf8mb4, therefore,
311 # the MySQL server needs to be configured for that char encoding by running the server as:
[32595]312 # mysql/mysql-5.7.23-linux-glibc2.12-x86_64/bin>./mysqld_safe --datadir=/PATHTO/mysql/data --character_set_server=utf8mb4
[32557]313 # AND when connecting to the server, we can can either set mysql_enable_utf8mb4 => 1
314 # as a connection option
315 # OR we need to do both "set NAMES utf8mb4" AND "$dbh->{mysql_enable_utf8mb4} = 1;" after connecting
316 #
317 # Search results for DBI Set Names imply the "SET NAMES '<enc>'" command is mysql specific too,
318 # so setting the mysql specific option during connection above as "mysql_enable_utf8mb4 => 1"
319 # is no more objectionable. It has the advantage of cutting out the 2 extra lines of doing
320 # set NAMES '<enc>' and $dbh->{mysql_enable_utf8mb4} = 1 here.
[32595]321 # These lines may be preferred if more db_driver options are to be supported in future?
322 # (see https://www.perlmonks.org/?node_id=259456)
[32529]323
[32557]324 #my $stmt = "set NAMES '" . $db_enc . "'";
325 #$dbh->do($stmt) || warn("Unable to set charset encoding at db server level to: " . $db_enc . "\n"); # tells MySQL to use UTF-8 for communication
326 #$dbh->{mysql_enable_utf8mb4} = 1; # tells DBD::mysql to decode the data
327
[32529]328 # if we're here, then connection succeeded, store handle
[32578]329 $_dbh_instance = $dbh;
330 return $_dbh_instance;
331
[32529]332}
333
[32592]334# Will disconnect if this instance of gsmysql holds the last reference to the db connection
[32583]335# If disconnecting and autocommit is off, then this will commit before disconnecting
[32579]336sub finished {
[32578]337 my $self= shift (@_);
[32583]338 my $dbh = $self->{'db_handle'};
[32582]339
[32583]340 my $rc = 1; # return code: everything went fine, regardless of whether we needed to commit
341 # (AutoCommit on or off)
342
[32578]343 $ref_count--;
[32583]344 if($ref_count == 0) { # Only commit transaction when we're about to actually disconnect, not before
[32582]345
[32595]346 # If AutoCommit was off, meaning transactions were on/enabled,
[32583]347 # then here is where we commit our one long transaction.
348 # https://metacpan.org/pod/release/TIMB/DBI-1.634_50/DBI.pm#commit
349 if($dbh->{AutoCommit} == 0) {
350 print STDERR " Committing transaction to SQL database now.\n" if $self->{'verbosity'};
351 $rc = $dbh->commit() or warn("SQL DB COMMIT FAILED: " . $dbh->errstr); # important problem
352 # worth embellishing error message
353 }
354 # else if autocommit was on, then we'd have committed after every db operation, so nothing to do
355
356 $self->_force_disconnect_from_db();
[32582]357 }
358
359 return $rc;
[32578]360}
361
[32582]362
[32578]363# Call this method on die(), so that you're sure the perl process has disconnected from SQL db
364# Disconnect from db - https://metacpan.org/pod/DBI#disconnect
[32595]365# Make sure to have committed or rolled back before disconnect
[32583]366sub _force_disconnect_from_db {
[32578]367 my $self= shift (@_);
368
369 if($_dbh_instance) {
370 # make sure any active stmt handles are finished
371 # NO: "When all the data has been fetched from a SELECT statement, the driver will automatically call finish for you. So you should not call it explicitly except when you know that you've not fetched all the data from a statement handle and the handle won't be destroyed soon."
372
[32592]373 print STDERR " GSMySQL disconnecting from database\n" if $self->{'verbosity'};
[32578]374 # Just go through the singleton db handle to disconnect
375 $_dbh_instance->disconnect or warn $_dbh_instance->errstr;
376 $_dbh_instance = undef;
377 }
[32592]378 # Number of gsmysql objects that share a live connection is now 0, as the connection's dead
379 # either because the last gsmysql object finished() or because connection was killed (force)
[32578]380 $ref_count = 0;
381}
382
383
[32595]384# Loads the designated database, i.e. 'use <dbname>;'.
[32563]385# If the database doesn't yet exist, creates it and loads it.
386# (Don't create the collection's tables yet, though)
387# At the end it will have loaded the requested database (in MySQL: "use <db>;") on success.
388# As usual, returns success or failure value that can be evaluated in a boolean context.
389sub use_db {
[32529]390 my $self= shift (@_);
[32563]391 my ($db_name) = @_;
[32529]392 my $dbh = $self->{'db_handle'};
[32561]393 $db_name = $self->sanitize_name($db_name);
[32529]394
[32560]395 print STDERR "Attempting to use database $db_name\n" if($self->{'verbosity'});
[32558]396
[32529]397 # perl DBI switch database: https://www.perlmonks.org/?node_id=995434
398 # do() returns undef on error.
399 # connection succeeded, try to load our database. If that didn't work, attempt to create db
400 my $success = $dbh->do("use $db_name");
401
402 if(!$success && $dbh->err == 1049) { # "Unknown database" error has code 1049 (mysql only?) meaning db doesn't exist yet
[32558]403
[32561]404 print STDERR "Database $db_name didn't exist, creating it along with the tables for the current collection...\n" if($self->{'verbosity'});
[32558]405
[32529]406 # attempt to create the db and its tables
407 $self->create_db($db_name) || return 0;
408
[32560]409 print STDERR " Created database $db_name\n" if($self->{'verbosity'} > 1);
[32529]410
411 # once more attempt to use db, now that it exists
412 $dbh->do("use $db_name") || return 0;
[32563]413 #$dbh->do("use $db_name") or die "Error (code" . $dbh->err ."): " . $dbh->errstr . "\n";
[32529]414
415 $success = 1;
416 }
417 elsif($success) { # database existed and loaded successfully, but
418 # before proceeding check that the current collection's tables exist
419
[32560]420 print STDERR "@@@ DATABASE $db_name EXISTED\n" if($self->{'verbosity'} > 2);
[32529]421 }
422
423 return $success; # could still return 0, if database failed to load with an error code != 1049
424}
425
[32571]426
[32563]427# We should already have done "use <database>;" if this gets called.
428# Just load this collection's metatable
429sub ensure_meta_table_exists {
430 my $self = shift (@_);
431
432 my $tablename = $self->get_metadata_table_name();
[32593]433 # if(!$self->table_exists($tablename)) {
434 # $self->create_metadata_table() || return 0;
435 # } else {
436 # print STDERR "@@@ Meta table exists\n" if($self->{'verbosity'} > 2);
437 # }
438 $self->create_metadata_table() || return 0; # will now only create it if it doesn't already exist
[32563]439 return 1;
440}
[32558]441
[32563]442# We should already have done "use <database>;" if this gets called.
443# Just load this collection's metatable
444sub ensure_fulltxt_table_exists {
445 my $self = shift (@_);
[32561]446
[32563]447 my $tablename = $self->get_fulltext_table_name();
[32593]448 # if(!$self->table_exists($tablename)) {
449 # $self->create_fulltext_table() || return 0;
450 # } else {
451 # print STDERR "@@@ Fulltxt table exists\n" if($self->{'verbosity'} > 2);
452 # }
453 $self->create_fulltext_table() || return 0; # will now only create it if it doesn't already exist
[32563]454 return 1;
[32529]455}
456
457
458sub create_db {
459 my $self= shift (@_);
[32557]460 my ($db_name) = @_;
[32529]461 my $dbh = $self->{'db_handle'};
[32561]462 $db_name = $self->sanitize_name($db_name);
[32529]463
464 # https://stackoverflow.com/questions/5025768/how-can-i-create-a-mysql-database-from-a-perl-script
465 return $dbh->do("create database $db_name"); # do() will return undef on fail, https://metacpan.org/pod/DBI#do
466}
467
[32593]468## NOTE: these 2 create_table methods use mysql specific "CREATE TABLE IF NOT EXISTS" syntax
469## vs general SQL CREATE TABLE syntax which would produce an error message if the table
470## already existed
471## And unless do() fails, these two create methods will now always return true,
472## even if table existed and didn't need to be created.
[32529]473sub create_metadata_table {
474 my $self= shift (@_);
475 my $dbh = $self->{'db_handle'};
476
477 my $table_name = $self->get_metadata_table_name();
[32593]478 print STDERR " Will create table $table_name if it doesn't exist\n" if($self->{'verbosity'} > 2);
[32558]479
[32529]480 # If using an auto incremented primary key:
[32593]481 my $stmt = "CREATE TABLE IF NOT EXISTS $table_name (id INT NOT NULL AUTO_INCREMENT, did VARCHAR(63) NOT NULL, sid VARCHAR(63) NOT NULL, metaname VARCHAR(127) NOT NULL, metavalue VARCHAR(1023) NOT NULL, PRIMARY KEY(id));";
[32529]482 return $dbh->do($stmt);
483}
484
485# TODO: Investigate: https://dev.mysql.com/doc/search/?d=10&p=1&q=FULLTEXT
486# 12.9.1 Natural Language Full-Text Searches
487# to see whether we have to index the 'fulltxt' column of the 'fulltext' tables
488# or let user edit this file, or add it as another option
489sub create_fulltext_table {
490 my $self= shift (@_);
491 my $dbh = $self->{'db_handle'};
492
493 my $table_name = $self->get_fulltext_table_name();
[32593]494 print STDERR " Will create table $table_name if it doesn't exist\n" if($self->{'verbosity'} > 2);
[32558]495
[32529]496 # If using an auto incremented primary key:
[32593]497 my $stmt = "CREATE TABLE IF NOT EXISTS $table_name (id INT NOT NULL AUTO_INCREMENT, did VARCHAR(63) NOT NULL, sid VARCHAR(63) NOT NULL, fulltxt LONGTEXT, PRIMARY KEY(id));";
[32529]498 return $dbh->do($stmt);
499
500}
501
[32593]502## NOTE: this method uses mysql specific "DROP TABLE IF EXISTS" syntax vs general SQL DROP TABLE
503## syntax which would produce an error message if the table didn't exist
[32538]504sub delete_collection_tables {
505 my $self= shift (@_);
506 my $dbh = $self->{'db_handle'};
[32580]507
[32538]508 # drop table <tablename>
[32593]509 # my $table = $self->get_metadata_table_name();
510 # if($self->table_exists($table)) {
511 # $dbh->do("drop table $table");
512 # }
513 # $table = $self->get_fulltext_table_name();
514 # if($self->table_exists($table)) {
515 # $dbh->do("drop table $table");
516 # }
517 my $table = $self->get_metadata_table_name();
518 $dbh->do("drop table if exists $table");
519
[32538]520 $table = $self->get_fulltext_table_name();
[32593]521 $dbh->do("drop table if exists $table");
[32582]522
[32593]523 # If prepared select statement handles already exist, would need to commit here
524 # so that future select statements using those prepared handles work.
[32582]525 # See https://metacpan.org/pod/release/TIMB/DBI-1.634_50/DBI.pm#Transactions
[32538]526}
[32529]527
[32538]528# Don't call this: it will delete the meta and full text tables for ALL collections in $db_name (localsite by default)!
[32541]529# This method is just here for debugging (for testing creating a database when there is none)
[32580]530#
531# "IF EXISTS is used to prevent an error from occurring if the database does not exist. ... DROP DATABASE returns the number of tables that were removed. The DROP DATABASE statement removes from the given database directory those files and directories that MySQL itself may create during normal operation.Jun 20, 2012"
532# MySQL 8.0 Reference Manual :: 13.1.22 DROP DATABASE Syntax
533# https://dev.mysql.com/doc/en/drop-database.html
[32538]534sub _delete_database {
535 my $self= shift (@_);
536 my ($db_name) = @_;
537 my $dbh = $self->{'db_handle'};
[32561]538 $db_name = $self->sanitize_name($db_name);
539
[32560]540 print STDERR "!!! Deleting database $db_name\n" if($self->{'verbosity'});
[32538]541
542 # "drop database dbname"
543 $dbh->do("drop database $db_name") || return 0;
544
545 return 1;
546}
547
548
549########################### DB STATEMENTS ###########################
550
[32529]551# USEFUL: https://metacpan.org/pod/DBI
552# "Many methods have an optional \%attr parameter which can be used to pass information to the driver implementing the method. Except where specifically documented, the \%attr parameter can only be used to pass driver specific hints. In general, you can ignore \%attr parameters or pass it as undef."
553
[32574]554# More efficient to use prepare() to prepare an SQL statement once and then execute() it many times
555# (binding different values to placeholders) than running do() which will prepare each time and
556# execute each time. Also, do() is not useful with SQL select statements as it doesn't fetch rows.
557# Can prepare and cache prepared statements or retrieve prepared statements if cached in one step:
558# https://metacpan.org/pod/release/TIMB/DBI-1.634_50/DBI.pm#prepare_cached
[32529]559
560# https://www.guru99.com/insert-into.html
561# and https://dev.mysql.com/doc/refman/8.0/en/example-auto-increment.html
562# for inserting multiple rows at once
563# https://www.perlmonks.org/bare/?node_id=316183
564# https://metacpan.org/pod/DBI#do
565# https://www.quora.com/What-is-the-difference-between-prepare-and-do-statements-in-Perl-while-we-make-a-connection-to-the-database-for-executing-the-query
566# https://docstore.mik.ua/orelly/linux/dbi/ch05_05.htm
567
568# https://metacpan.org/pod/DBI#performance
569# 'The q{...} style quoting used in this example avoids clashing with quotes that may be used in the SQL statement. Use the double-quote like qq{...} operator if you want to interpolate variables into the string. See "Quote and Quote-like Operators" in perlop for more details.'
[32573]570#
[32595]571# Each insert method uses lazy loading to prepare the SQL insert stmts once for a table and
572# store it, then executes the (stored) statement each time it's needed for that table.
[32573]573sub insert_row_into_metadata_table {
574 my $self = shift (@_);
[32580]575 my ($doc_oid, $section_name, $meta_name, $escaped_meta_value, $debug_only) = @_;
[32573]576
[32529]577 my $dbh = $self->{'db_handle'};
[32574]578
579 my $tablename = $self->get_metadata_table_name();
[32595]580 my $sth = $dbh->prepare_cached(qq{INSERT INTO $tablename (did, sid, metaname, metavalue) VALUES (?, ?, ?, ?)});
[32529]581
[32573]582 # Now we're ready to execute the command, unless we're only debugging
[32529]583
[32573]584 if($debug_only) {
585 # just print the statement we were going to execute
[32580]586 print STDERR $sth->{'Statement'} . "($doc_oid, $section_name, $meta_name, $escaped_meta_value)\n";
[32576]587 }
588 else {
589 print STDERR $sth->{'Statement'} . "($doc_oid, $section_name, $meta_name, $escaped_meta_value)\n" if $self->{'verbosity'} > 2;
[32573]590
591 $sth->execute($doc_oid, $section_name, $meta_name, $escaped_meta_value)
592 || warn ("Unable to write metadata row to db:\n\tOID $doc_oid, section $section_name,\n\tmeta name: $meta_name, val: $escaped_meta_value");
593 # Execution failure will print out info anyway: since db connection sets PrintError
594 }
[32529]595}
596
[32573]597# As above. Likewise uses lazy loading to prepare the SQL insert stmt once for a table and store it,
598# then execute the (stored) statement each time it's needed for that table.
599sub insert_row_into_fulltxt_table {
[32529]600 my $self = shift (@_);
601 #my ($did, $sid, $fulltext) = @_;
[32580]602 my ($doc_oid, $section_name, $section_textref, $debug_only) = @_;
[32573]603
[32529]604 my $dbh = $self->{'db_handle'};
605
[32574]606 my $tablename = $self->get_fulltext_table_name();
[32595]607 my $sth = $dbh->prepare_cached(qq{INSERT INTO $tablename (did, sid, fulltxt) VALUES (?, ?, ?)});
[32574]608
[32573]609 # Now we're ready to execute the command, unless we're only debugging
610
[32580]611 # don't display the fulltxt value as it could be too long
[32576]612 my $txt_repr = $$section_textref ? "<TXT>" : "NULL";
[32580]613 if($debug_only) { # only print statement, don't execute it
614 print STDERR $sth->{'Statement'} . "($doc_oid, $section_name, $txt_repr)\n";
[32576]615 }
616 else {
617 print STDERR $sth->{'Statement'} . "($doc_oid, $section_name, $txt_repr)\n" if $self->{'verbosity'} > 2;
618
[32573]619 $sth->execute($doc_oid, $section_name, $$section_textref)
[32580]620 || warn ("Unable to write fulltxt row to db for row:\n\tOID $doc_oid, section $section_name"); # Execution failure will print out info anyway: since db connection sets PrintError
[32573]621 }
[32529]622}
623
[32538]624
625## The 2 select statements used by GreenstoneSQLPlugin
626
[32575]627# Using fetchall_arrayref on statement handle, to run on prepared and executed stmt
628# https://metacpan.org/pod/release/TIMB/DBI-1.634_50/DBI.pm#fetchall_arrayref
629# instead of selectall_arrayref on database handle which will prepare, execute and fetch
630# https://metacpan.org/pod/release/TIMB/DBI-1.634_50/DBI.pm#selectall_arrayref
631#
[32595]632# Returns the resulting records of preparing and executing
[32538]633# a "SELECT * FROM <COLL>_metadata WHERE did = $oid" SQL statement.
634# Have to use prepare() and execute() instead of do() since do() does
635# not allow for fetching result set thereafter:
636# do(): "This method is typically most useful for non-SELECT statements that either cannot be prepared in advance (due to a limitation of the driver) or do not need to be executed repeatedly. It should not be used for SELECT statements because it does not return a statement handle (so you can't fetch any data)." https://metacpan.org/pod/release/TIMB/DBI-1.634_50/DBI.pm#do
637sub select_from_metatable_matching_docid {
[32529]638 my $self= shift (@_);
[32575]639 my ($oid, $outhandle) = @_;
[32538]640
[32529]641 my $dbh = $self->{'db_handle'};
[32575]642 my $tablename = $self->get_metadata_table_name();
[32529]643
[32575]644 my $sth = $dbh->prepare_cached(qq{SELECT * FROM $tablename WHERE did = ?});
[32538]645 $sth->execute( $oid ); # will print msg on fail
[32575]646
647 print $outhandle "### SQL select stmt: ".$sth->{'Statement'}."\n"
648 if ($self->{'verbosity'} > 2);
[32529]649
[32575]650 my $rows_ref = $sth->fetchall_arrayref();
651 # "If an error occurs, fetchall_arrayref returns the data fetched thus far, which may be none.
652 # You should check $sth->err afterwards (or use the RaiseError attribute) to discover if the
653 # data is complete or was truncated due to an error."
654 # https://metacpan.org/pod/release/TIMB/DBI-1.634_50/DBI.pm#fetchall_arrayref
655 # https://www.oreilly.com/library/view/programming-the-perl/1565926994/ch04s05.html
656 warn("Data fetching from $tablename terminated early by error: " . $dbh->err) if $dbh->err;
657 return $rows_ref;
[32529]658}
659
[32574]660
[32575]661# See select_from_metatable_matching_docid() above.
[32595]662# Returns the resulting records from preparing and executing
663# a "SELECT * FROM <COLL>_fulltxt WHERE did = $oid" SQL statement.
[32538]664sub select_from_texttable_matching_docid {
[32529]665 my $self= shift (@_);
[32575]666 my ($oid, $outhandle) = @_;
[32538]667
[32529]668 my $dbh = $self->{'db_handle'};
[32575]669 my $tablename = $self->get_fulltext_table_name();
[32529]670
[32575]671 my $sth = $dbh->prepare_cached(qq{SELECT * FROM $tablename WHERE did = ?});
[32538]672 $sth->execute( $oid ); # will print msg on fail
673
[32575]674 print $outhandle "### SQL select stmt: ".$sth->{'Statement'}."\n"
675 if ($self->{'verbosity'} > 2);
676
677 my $rows_ref = $sth->fetchall_arrayref();
678 # Need explicit warning:
679 warn("Data fetching from $tablename terminated early by error: " . $dbh->err) if $dbh->err;
680 return $rows_ref;
681
[32538]682}
[32529]683
[32544]684# delete all records in metatable with specified docid
685# https://www.tutorialspoint.com/mysql/mysql-delete-query.htm
686# DELETE FROM table_name [WHERE Clause]
687# see example under 'do' at https://metacpan.org/pod/release/TIMB/DBI-1.634_50/DBI.pm
688sub delete_recs_from_metatable_with_docid {
689 my $self= shift (@_);
690 my ($oid) = @_;
691
692 my $dbh = $self->{'db_handle'};
[32571]693
[32574]694 my $tablename = $self->get_metadata_table_name();
695 my $sth = $dbh->prepare_cached(qq{DELETE FROM $tablename WHERE did = ?});
[32571]696 $sth->execute( $oid ) or warn $dbh->errstr; # dbh set to print errors even without doing warn()
[32544]697}
[32538]698
[32595]699# delete all records in fulltxt table with the specified docid
[32544]700sub delete_recs_from_texttable_with_docid {
701 my $self= shift (@_);
702 my ($oid) = @_;
703
[32571]704 my $dbh = $self->{'db_handle'};
705
[32574]706 my $tablename = $self->get_fulltext_table_name();
707 my $sth = $dbh->prepare_cached(qq{DELETE FROM $tablename WHERE did = ?});
[32571]708 $sth->execute( $oid ) or warn $dbh->errstr; # dbh set to print errors even without doing warn()
[32544]709}
710
[32538]711# Can call this after connection succeeded to get the database handle, dbh,
712# if any specific DB operation (SQL statement, create/delete)
713# needs to be executed that is not already provided as a method of this class.
714sub get_db_handle {
715 my $self= shift (@_);
716 return $self->{'db_handle'};
[32529]717}
718
[32538]719################ HELPER METHODS ##############
720
[32529]721# More basic helper methods
722sub get_metadata_table_name {
723 my $self= shift (@_);
[32531]724 my $table_name = $self->{'tablename_prefix'} . "_metadata";
[32529]725 return $table_name;
726}
727
728# FULLTEXT is a reserved keyword in (My)SQL. https://dev.mysql.com/doc/refman/5.5/en/keywords.html
729# So we can't name a table or any of its columns "fulltext". We use "fulltxt" instead.
730sub get_fulltext_table_name {
731 my $self= shift (@_);
[32531]732 my $table_name = $self->{'tablename_prefix'} . "_fulltxt";
[32529]733 return $table_name;
734}
735
[32561]736# Attempt to make sure the name parameter (for db or table name) is acceptable syntax
[32595]737# for the db in question, e.g. for mysql. For example, MySQL doesn't like tables or
[32561]738# databases with '-' (hyphens) in their names
739sub sanitize_name {
740 my $self= shift (@_);
741 my ($name) = @_;
742 $name =~ s/-/_/g;
743 return $name;
744}
[32531]745
[32561]746
[32595]747# MySQL has non-standard command to CREATE TABLE IF NOT EXISTS and DROP TABLE IF EXISTS, using that.
748# See https://www.perlmonks.org/bare/?node=DBI%20Recipes
749# The page further has a table_exists function that could work with proper comparison
750# Couldn't get the first solution at https://www.perlmonks.org/bare/?node_id=500050 to work though
[32529]751# I can get my version of table_exists to work, but it's not so ideal
752sub table_exists {
753 my $self = shift (@_);
754 my $dbh = $self->{'db_handle'};
755 my ($table_name) = @_;
756
757 my @table_list = $dbh->tables;
758 #my $tables_str = @table_list[0];
759 foreach my $table (@table_list) {
760 return 1 if ($table =~ m/$table_name/);
761 }
762 return 0;
763}
764
[32594]765# regular function, not method
766# Called when rollback_on_cancel is on.
767# Warns they user to make backups of their archives and index dir
768# and sleeps for 5 seconds so they can do that
769sub issue_backup_on_build_message
770{
771 # warn the user they'll need to backup their archives (and index?) folders
772 # plugout stores archivedir in $self->{'output_dir'}, but not available in plugin
773 # But we're only making an example copy command anyway:
774 my $archivesdir = &FileUtils::filenameConcatenate($ENV{'GSDLCOLLECTDIR'}, "archives");
775 my $archives_rollbackdir = $archivesdir.".rollback";
776
777 # Assume user knows what they're doing if a rollback directory already exists
778 # instead of wasting time waiting for sleep to terminate
779 return if FileUtils::directoryExists("$archives_rollbackdir");
780
781 my $indexdir = &FileUtils::filenameConcatenate($ENV{'GSDLCOLLECTDIR'}, "index");
782
783
784 # use rsync command on unix
785 my $example_copy_cmds = "rsync -pavH $archivesdir $archivesdir.rollback\n";
786 $example_copy_cmds .= "rsync -pavH $indexdir $indexdir.rollback\n";
787
788 if (($ENV{'GSDLOS'} =~ /^windows$/i) && ($^O ne "cygwin")) {
789 # https://stackoverflow.com/questions/4601161/copying-all-contents-of-folder-to-another-folder-using-batch-file
790 $example_copy_cmds = "xcopy /EVI $archivesdir $archivesdir.rollback\n";
791 $example_copy_cmds .= "xcopy /EVI $indexdir $indexdir.rollback\n";
792
793 }
794 print STDERR "****************************\n";
795 &gsprintf::gsprintf(STDERR, "{gsmysql.backup_on_build_msg}\n", $example_copy_cmds);
796 print STDERR "****************************\n";
797 sleep 5; # 5s
798}
799
[32529]8001;
Note: See TracBrowser for help on using the repository browser.