root/main/trunk/greenstone2/perllib/gssql.pm @ 32578

Revision 32578, 27.9 KB (checked in by ak19, 10 months ago)

Optimising. The gssql class internally has only one shared connection to the db, making the connection only the first time and disconnecting only when the last gssql is finished(). For keywords: this is implemented using the singleton coding (anti-) pattern. Now each perl process (import or buildcol) will connect to the SQL DB only once, not twice during import where it used to be once for GS SQL plugout and once for GSSQL plugin.

Line 
1###########################################################################
2#
3# gssql.pm -- DBI for SQL related utility functions used by
4# GreenstoneSQLPlugout and hereafter by GreenstoneSQLPlugin too.
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
27package gssql;
28
29use strict;
30no strict 'refs';
31no strict 'subs';
32
33use DBI; # the central package for this module used by GreenstoneSQL Plugout and Plugin
34
35# singleton connection
36my $_dbh_instance = undef; # calls undef() function. See https://perlmaven.com/undef-and-defined-in-perl
37my $ref_count = 0;
38
39# Need params_map keys:
40# - collection_name
41# - db_encoding (db content encoding) - MySQL can set this at server, db, table levels. For MySQL
42# we set the enc during connect at server level. Not sure whether other DB's support it at the
43# same levels.
44
45# For connection to MySQL, need:
46#  - db_driver, db_client_user, db_client_pwd, db_host, (db_port not used at present)
47# So these will be parameterised, but in a hashmap, for just the connect method.
48
49# Parameterise (one or more methods may use them):
50# - db_name (which is the GS3 sitename)
51
52# TODO: add infrastructure for db_port, AutoCommit etc
53# For port, see https://stackoverflow.com/questions/2248665/perl-script-to-connect-to-mysql-server-port-3307
54
55# TODO: remove unnecessary warn() since PrintError is active
56# https://perldoc.perl.org/perlobj.html#Destructors
57
58# TODO: drop table if exists and create table if exists are available in MySQL. Use those cmds
59# instead of always first checking for existence ourselves?
60
61sub new
62
63    my $class = shift(@_);
64   
65    my ($params_map) = @_;
66   
67    # library_url: to be specified on the cmdline if not using a GS-included web server
68    # the GSDL_LIBRARY_URL env var is useful when running cmdline buildcol.pl in the linux package manager versions of GS3
69   
70    # https://stackoverflow.com/questions/7083453/copying-a-hashref-in-perl
71    # Making a shallow copy works, and can handle unknown params:
72    #my $self = $params_map;
73
74    # but being explicit for class params needed for MySQL:
75    my $self = {
76    'collection_name' => $params_map->{'collection_name'},
77    'verbosity' => $params_map->{'verbosity'} || 1
78    };
79
80    # The db_encoding option is presently not passed in to this constructor as parameter.
81    # Placed here to indicate it's sort of optional.
82    # Since docxml are all in utf8, the contents of the GS SQL database should be too,
83    # So making utf8 the hidden default at present.
84    $self->{'db_encoding'} = $params_map->{'db_encoding'} || "utf8";
85   
86    $self = bless($self, $class);   
87
88    $self->{'tablename_prefix'} = $self->sanitize_name($params_map->{'collection_name'});
89   
90    return $self;
91}
92
93
94
95#################################
96
97# Database access related functions
98# http://g2pc1.bu.edu/~qzpeng/manual/MySQL%20Commands.htm
99# https://www.guru99.com/insert-into.html
100
101# TODO Q: What on cancelling a build: delete table? But what if it was a rebuild and the rebuild is cancelled (not the original build)?
102# Do we create a copy of the orig database as backup, then start populating current db, and if cancelled, delete current db and RENAME backup table to current?
103# https://stackoverflow.com/questions/3280006/duplicating-a-mysql-table-indexes-and-data
104# BUT what if the table is HUGE? (Think of a collection with millions of docs.) Huge overhead in copying?
105# The alternative is we just quit on cancel, but then: cancel could leave the table in a partial committed state, with no way of rolling back.
106# Unless they do a full rebuild, which will recreate the table from scratch?
107# SOLUTION-> rollback transaction on error, see https://www.effectiveperlprogramming.com/2010/07/set-custom-dbi-error-handlers/
108# But then should set AutoCommit to off on connection, and remember to commit every time
109
110#################
111# Database functions that use the perl DBI module (with the DBD driver module for mysql)
112#################
113
114################### BASIC DB OPERATIONS ##################
115
116# THE NEW DB FUNCTIONS
117# NOTE: FULLTEXT is a reserved keyword in (My)SQL. So we can't name a table or any of its columns "fulltext".
118# https://dev.mysql.com/doc/refman/5.5/en/keywords.html
119
120# TODO: Consider AutoCommit status (and Autocommit off allowing commit or rollback for GS coll build cancel) later
121
122
123
124# SINGLETON / GET INSTANCE PATTERN
125# https://stackoverflow.com/questions/16655603/perl-objects-class-variable-initialization
126# https://stackoverflow.com/questions/7587157/how-can-i-set-a-static-variable-that-can-be-accessed-by-all-subclasses-of-the-sa
127# Singleton without Moose: https://www.perl.com/article/52/2013/12/11/Implementing-the-singleton-pattern-in-Perl/
128
129sub connect_to_db
130{
131    my $self= shift (@_);
132    my ($params_map) = @_;
133   
134    $params_map->{'db_encoding'} = $self->{'db_encoding'};
135    $params_map->{'verbosity'} = $self->{'verbosity'};
136   
137    $self->{'db_handle'} = &_get_connection_instance($params_map); # getting singleton (class method)
138    if($self->{'db_handle'}) {
139    $ref_count++; # if successful, keep track of the number of refs to the single db connection
140    return $self->{'db_handle'};
141    }
142    return undef;
143}
144
145# SINGLETON METHOD #
146# TODO: where should the defaults for these params be, here or in GS-SQLPlugin/Plugout?
147sub _get_connection_instance
148{
149    #my $self= shift (@_); # singleton method doesn't use self, but callers don't need to know that
150    my ($params_map) = @_;
151
152    return $_dbh_instance if($_dbh_instance);
153
154    # or make the connection
155   
156    # For proper utf8 support in MySQL, encoding should be 'utf8mb4' as 'utf8' is insufficient
157    my $db_enc = "utf8mb4" if $params_map->{'db_encoding'} eq "utf8";
158
159    # these are the params for connecting to MySQL
160    my $db_driver = $params_map->{'db_driver'} || "mysql";
161    my $db_user = $params_map->{'db_client_user'} || "root";
162    my $db_pwd = $params_map->{'db_client_pwd'}; # even if undef, we'll see a sensible error message
163                                           # when connect fails
164    my $db_host = $params_map->{'db_host'} || "127.0.0.1";
165    # localhost doesn't work for us, but 127.0.0.1 works
166    # https://metacpan.org/pod/DBD::mysql
167    # "The hostname, if not specified or specified as '' or 'localhost', will default to a MySQL server
168    # running on the local machine using the default for the UNIX socket. To connect to a MySQL server
169    # on the local machine via TCP, you must specify the loopback IP address (127.0.0.1) as the host."
170    #my $connect_str = "dbi:$db_driver:database=$db_name;host=$db_host";
171    my $connect_str = "dbi:$db_driver:host=$db_host"; # don't provide db - allows checking the db exists later when loading the db
172
173    if($params_map->{'verbosity'}) {
174    print STDERR "Away to make connection to $db_driver database with:\n";
175    print STDERR " - hostname $db_host; username: $db_user";
176    print STDERR "; and the provided password" if $db_pwd;
177    print STDERR "\nAssuming the mysql server has been started with: --character_set_server=utf8mb4\n" if $db_driver eq "mysql";
178    }
179   
180    my $dbh = DBI->connect("$connect_str", $db_user, $db_pwd,
181               {
182                   ShowErrorStatement => 1, # more informative as DBI will append failed SQL stmt to error message
183                   PrintError => 1, # on by default, but being explicit
184                   RaiseError => 0, # off by default, but being explicit
185                   AutoCommit => 1, # on by default, but being explicit
186                   mysql_enable_utf8mb4 => 1 # tells MySQL to use UTF-8 for communication and tells DBD::mysql to decode the data, see https://stackoverflow.com/questions/46727362/perl-mysql-utf8mb4-issue-possible-bug
187               });
188
189    if(!$dbh) {
190    # NOTE, despite handle dbh being undefined, error code will be in DBI->err (note caps)
191    return 0;   
192    }
193
194    # set encoding https://metacpan.org/pod/DBD::mysql
195    # https://dev.mysql.com/doc/refman/5.7/en/charset.html
196    # https://dev.mysql.com/doc/refman/5.7/en/charset-conversion.html
197    # Setting the encoding at db server level: $dbh->do("set NAMES '" . $db_enc . "'");
198    # HOWEVER:
199    # It turned out insufficient setting the encoding to utf8, as that only supports utf8 chars that
200    # need up to 3 bytes. We may need up to 4 bytes per utf8 character, e.g. chars with macron,
201    # and for that, we need the encoding to be set to utf8mb4.
202    # To set up a MySQL db to use utf8mb4 requires configuration on the server side too.
203    # https://stackoverflow.com/questions/10957238/incorrect-string-value-when-trying-to-insert-utf-8-into-mysql-via-jdbc
204    # https://stackoverflow.com/questions/46727362/perl-mysql-utf8mb4-issue-possible-bug
205    # To set up the db for utf8mb4, therefore,
206    # the MySQL server needs to be configured for that char encoding by running the server as:
207    # mysql-5.7.23-linux-glibc2.12-x86_64/bin>./mysqld_safe --datadir=/Scratch/ak19/mysql/data --character_set_server=utf8mb4
208    # AND when connecting to the server, we can can either set mysql_enable_utf8mb4 => 1
209    # as a connection option
210    # OR we need to do both "set NAMES utf8mb4" AND "$dbh->{mysql_enable_utf8mb4} = 1;" after connecting
211    #
212    # Search results for DBI Set Names imply the "SET NAMES '<enc>'" command is mysql specific too,
213    # so setting the mysql specific option during connection above as "mysql_enable_utf8mb4 => 1"
214    # is no more objectionable. It has the advantage of cutting out the 2 extra lines of doing
215    # set NAMES '<enc>' and $dbh->{mysql_enable_utf8mb4} = 1 here.
216    # These lines may be preferred if more db_driver options are to be supported in future:
217    # then a separate method called set_db_encoding($enc) can work out what db_driver we're using
218    # and if mysql and enc=utfy, then it can do the following whereas it will issue other do stmts
219    # for other db_drivers, see https://www.perlmonks.org/?node_id=259456:
220   
221    #my $stmt = "set NAMES '" . $db_enc . "'";
222    #$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
223    #$dbh->{mysql_enable_utf8mb4} = 1; # tells DBD::mysql to decode the data
224   
225    # if we're here, then connection succeeded, store handle
226    $_dbh_instance = $dbh;
227    return $_dbh_instance;
228   
229}
230
231# Will disconnect if this instance of gssql holds the last reference to the db connection
232sub finished() {
233    my $self= shift (@_);
234
235    $ref_count--;
236    if($ref_count == 0) {
237    $self->force_disconnect_from_db();
238    }   
239}
240
241# Call this method on die(), so that you're sure the perl process has disconnected from SQL db
242# Disconnect from db - https://metacpan.org/pod/DBI#disconnect
243# TODO: make sure to have committed or rolled back before disconnect
244# and that you've call finish() on statement handles if any fetch remnants remain
245sub force_disconnect_from_db {
246    my $self= shift (@_);
247
248    if($_dbh_instance) {
249    # make sure any active stmt handles are finished
250    # 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."
251   
252    print STDERR "    GSSQL disconnecting from database\n";
253    # Just go through the singleton db handle to disconnect
254    $_dbh_instance->disconnect or warn $_dbh_instance->errstr;
255    $_dbh_instance = undef;
256    }
257    # Number of gssql objects that share a live connection is now 0, as the connection's dead
258    # either because the last gssql object finished() or because connection was killed (force)
259    $ref_count = 0;
260}
261
262
263# Load the designated database, i.e. 'use <dbname>;'.
264# If the database doesn't yet exist, creates it and loads it.
265# (Don't create the collection's tables yet, though)
266# At the end it will have loaded the requested database (in MySQL: "use <db>;") on success.
267# As usual, returns success or failure value that can be evaluated in a boolean context.
268sub use_db {
269    my $self= shift (@_);
270    my ($db_name) = @_;
271    my $dbh = $self->{'db_handle'};
272    $db_name = $self->sanitize_name($db_name);
273   
274    print STDERR "Attempting to use database $db_name\n" if($self->{'verbosity'});
275   
276    # perl DBI switch database: https://www.perlmonks.org/?node_id=995434
277    # do() returns undef on error.
278    # connection succeeded, try to load our database. If that didn't work, attempt to create db
279    my $success = $dbh->do("use $db_name");
280   
281    if(!$success && $dbh->err == 1049) { # "Unknown database" error has code 1049 (mysql only?) meaning db doesn't exist yet
282
283    print STDERR "Database $db_name didn't exist, creating it along with the tables for the current collection...\n" if($self->{'verbosity'});
284   
285    # attempt to create the db and its tables
286    $self->create_db($db_name) || return 0;
287
288    print STDERR "   Created database $db_name\n" if($self->{'verbosity'} > 1);
289   
290    # once more attempt to use db, now that it exists
291    $dbh->do("use $db_name") || return 0;
292    #$dbh->do("use $db_name") or die "Error (code" . $dbh->err ."): " . $dbh->errstr . "\n";
293
294    $success = 1;
295    }
296    elsif($success) { # database existed and loaded successfully, but
297    # before proceeding check that the current collection's tables exist
298
299    print STDERR "@@@ DATABASE $db_name EXISTED\n" if($self->{'verbosity'} > 2);
300    }
301   
302    return $success; # could still return 0, if database failed to load with an error code != 1049
303}
304
305
306# We should already have done "use <database>;" if this gets called.
307# Just load this collection's metatable
308sub ensure_meta_table_exists {
309    my $self = shift (@_);
310   
311    my $tablename = $self->get_metadata_table_name();
312    if(!$self->table_exists($tablename)) {
313    #print STDERR "   Creating metadata table $tablename\n" if($self->{'verbosity'} > 1);
314    $self->create_metadata_table() || return 0;
315    } else {
316    print STDERR "@@@ Meta table exists\n" if($self->{'verbosity'} > 2);
317    }
318    return 1;
319}
320
321# We should already have done "use <database>;" if this gets called.
322# Just load this collection's metatable
323sub ensure_fulltxt_table_exists {
324    my $self = shift (@_);
325   
326    my $tablename = $self->get_fulltext_table_name();   
327    if(!$self->table_exists($tablename)) {
328    #print STDERR "   Creating fulltxt table $tablename\n" if($self->{'verbosity'} > 1);
329    $self->create_fulltext_table() || return 0;
330    } else {
331    print STDERR "@@@ Fulltxt table exists\n" if($self->{'verbosity'} > 2);
332    }
333    return 1;
334}
335
336
337sub create_db {
338    my $self= shift (@_);
339    my ($db_name) = @_;
340    my $dbh = $self->{'db_handle'};
341    $db_name = $self->sanitize_name($db_name);
342   
343    # https://stackoverflow.com/questions/5025768/how-can-i-create-a-mysql-database-from-a-perl-script
344    return $dbh->do("create database $db_name"); # do() will return undef on fail, https://metacpan.org/pod/DBI#do
345}
346
347
348sub create_metadata_table {
349    my $self= shift (@_);
350    my $dbh = $self->{'db_handle'};
351   
352    my $table_name = $self->get_metadata_table_name();
353    print STDERR "   Creating table $table_name\n" if($self->{'verbosity'} > 1);
354   
355    # If using an auto incremented primary key:
356    my $stmt = "CREATE TABLE $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));";
357    return $dbh->do($stmt);
358}
359
360# TODO: Investigate: https://dev.mysql.com/doc/search/?d=10&p=1&q=FULLTEXT
361# 12.9.1 Natural Language Full-Text Searches
362# to see whether we have to index the 'fulltxt' column of the 'fulltext' tables
363# or let user edit this file, or add it as another option
364sub create_fulltext_table {
365    my $self= shift (@_);
366    my $dbh = $self->{'db_handle'};
367   
368    my $table_name = $self->get_fulltext_table_name();
369    print STDERR "   Creating table $table_name\n" if($self->{'verbosity'} > 1);
370   
371    # If using an auto incremented primary key:
372    my $stmt = "CREATE TABLE $table_name (id INT NOT NULL AUTO_INCREMENT, did VARCHAR(63) NOT NULL, sid VARCHAR(63) NOT NULL, fulltxt LONGTEXT, PRIMARY KEY(id));";
373    return $dbh->do($stmt);
374
375}
376
377# "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"
378# MySQL 8.0 Reference Manual :: 13.1.22 DROP DATABASE Syntax
379# https://dev.mysql.com/doc/en/drop-database.html
380sub delete_collection_tables {
381    my $self= shift (@_);
382    my $dbh = $self->{'db_handle'};
383   
384    # drop table <tablename>
385    my $table = $self->get_metadata_table_name();
386    if($self->table_exists($table)) {
387    $dbh->do("drop table $table") || warn("@@@ Couldn't delete $table");
388    }
389    $table = $self->get_fulltext_table_name();
390    if($self->table_exists($table)) {
391    $dbh->do("drop table $table") || warn("@@@ Couldn't delete $table");
392    }
393}
394
395# Don't call this: it will delete the meta and full text tables for ALL collections in $db_name (localsite by default)!
396# This method is just here for debugging (for testing creating a database when there is none)
397sub _delete_database {
398    my $self= shift (@_);
399    my ($db_name) = @_;
400    my $dbh = $self->{'db_handle'};
401    $db_name = $self->sanitize_name($db_name);
402   
403    print STDERR "!!! Deleting database $db_name\n" if($self->{'verbosity'});
404   
405    # "drop database dbname"
406    $dbh->do("drop database $db_name") || return 0;
407
408    return 1;
409}
410
411
412########################### DB STATEMENTS ###########################
413
414# USEFUL: https://metacpan.org/pod/DBI
415# "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."
416
417# More efficient to use prepare() to prepare an SQL statement once and then execute() it many times
418# (binding different values to placeholders) than running do() which will prepare each time and
419# execute each time. Also, do() is not useful with SQL select statements as it doesn't fetch rows.
420# Can prepare and cache prepared statements or retrieve prepared statements if cached in one step:
421# https://metacpan.org/pod/release/TIMB/DBI-1.634_50/DBI.pm#prepare_cached
422
423# https://www.guru99.com/insert-into.html
424# and https://dev.mysql.com/doc/refman/8.0/en/example-auto-increment.html
425#     for inserting multiple rows at once
426# https://www.perlmonks.org/bare/?node_id=316183
427# https://metacpan.org/pod/DBI#do
428# 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
429# https://docstore.mik.ua/orelly/linux/dbi/ch05_05.htm
430
431# https://metacpan.org/pod/DBI#performance
432# '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.'
433#
434# This method uses lazy loading to prepare the SQL insert stmt once for a table and store it,
435# then execute the (stored) statement each time it's needed for that table.
436sub insert_row_into_metadata_table {
437    my $self = shift (@_);
438    my ($doc_oid, $section_name, $meta_name, $escaped_meta_value, $debug_only, $debug_out) = @_;
439   
440    my $dbh = $self->{'db_handle'};
441   
442    my $tablename = $self->get_metadata_table_name();
443    my $sth = $dbh->prepare_cached(qq{INSERT INTO $tablename (did, sid, metaname, metavalue) VALUES (?, ?, ?, ?)}) || warn("Could not prepare insert statement for metadata table\n");
444
445    # Now we're ready to execute the command, unless we're only debugging
446   
447    if($debug_only) {
448    # just print the statement we were going to execute
449    print $debug_out $sth->{'Statement'} . "($doc_oid, $section_name, $meta_name, $escaped_meta_value)\n";
450    }
451    else {
452    print STDERR $sth->{'Statement'} . "($doc_oid, $section_name, $meta_name, $escaped_meta_value)\n" if $self->{'verbosity'} > 2;
453   
454    $sth->execute($doc_oid, $section_name, $meta_name, $escaped_meta_value)
455        || warn ("Unable to write metadata row to db:\n\tOID $doc_oid, section $section_name,\n\tmeta name: $meta_name, val: $escaped_meta_value");
456    # Execution failure will print out info anyway: since db connection sets PrintError
457    }
458}
459
460# As above. Likewise uses lazy loading to prepare the SQL insert stmt once for a table and store it,
461# then execute the (stored) statement each time it's needed for that table.
462sub insert_row_into_fulltxt_table {
463    my $self = shift (@_);
464    #my ($did, $sid, $fulltext) = @_;
465    my ($doc_oid, $section_name, $section_textref, $debug_only, $debug_out) = @_;
466   
467    my $dbh = $self->{'db_handle'};
468   
469    my $tablename = $self->get_fulltext_table_name();
470    my $sth = $dbh->prepare_cached(qq{INSERT INTO $tablename (did, sid, fulltxt) VALUES (?, ?, ?)}) || warn("Could not prepare insert statement for fulltxt table\n");
471   
472    # Now we're ready to execute the command, unless we're only debugging
473
474    # just print the statement we were going to execute, minus the fulltxt value
475    my $txt_repr = $$section_textref ? "<TXT>" : "NULL";   
476    if($debug_only) {
477    print $debug_out $sth->{'Statement'} . "($doc_oid, $section_name, $txt_repr)\n";
478    }
479    else { 
480    print STDERR $sth->{'Statement'} . "($doc_oid, $section_name, $txt_repr)\n" if $self->{'verbosity'} > 2;
481   
482    $sth->execute($doc_oid, $section_name, $$section_textref)
483        || warn ("Unable to write fulltxt row to db for row:\n\tOID $doc_oid, section $section_name");
484    }
485}
486
487
488## The 2 select statements used by GreenstoneSQLPlugin
489
490# Using fetchall_arrayref on statement handle, to run on prepared and executed stmt
491#   https://metacpan.org/pod/release/TIMB/DBI-1.634_50/DBI.pm#fetchall_arrayref
492# instead of selectall_arrayref on database handle which will prepare, execute and fetch
493#   https://metacpan.org/pod/release/TIMB/DBI-1.634_50/DBI.pm#selectall_arrayref
494#
495# Returns the statement handle that prepared and executed
496# a "SELECT * FROM <COLL>_metadata WHERE did = $oid" SQL statement.
497# Caller can call fetchrow_array() on returned statement handle, $sth
498# Have to use prepare() and execute() instead of do() since do() does
499# not allow for fetching result set thereafter:
500# 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
501sub select_from_metatable_matching_docid {
502    my $self= shift (@_);
503    my ($oid, $outhandle) = @_;
504   
505    my $dbh = $self->{'db_handle'};
506    my $tablename = $self->get_metadata_table_name();
507   
508    my $sth = $dbh->prepare_cached(qq{SELECT * FROM $tablename WHERE did = ?});
509    $sth->execute( $oid ); # will print msg on fail
510
511    print $outhandle "### SQL select stmt: ".$sth->{'Statement'}."\n"
512    if ($self->{'verbosity'} > 2);
513   
514    my $rows_ref = $sth->fetchall_arrayref();
515    # "If an error occurs, fetchall_arrayref returns the data fetched thus far, which may be none.
516    # You should check $sth->err afterwards (or use the RaiseError attribute) to discover if the
517    # data is complete or was truncated due to an error."
518    # https://metacpan.org/pod/release/TIMB/DBI-1.634_50/DBI.pm#fetchall_arrayref
519    # https://www.oreilly.com/library/view/programming-the-perl/1565926994/ch04s05.html
520    warn("Data fetching from $tablename terminated early by error: " . $dbh->err) if $dbh->err;
521    return $rows_ref;
522}
523
524
525# See select_from_metatable_matching_docid() above.
526# Returns the statement handle that prepared and executed
527# a "SELECT * FROM <COLL>_metadata WHERE did = $oid" SQL statement.
528# Caller can call fetchrow_array() on returned statement handle, $sth
529sub select_from_texttable_matching_docid {
530    my $self= shift (@_);
531    my ($oid, $outhandle) = @_;
532   
533    my $dbh = $self->{'db_handle'};
534    my $tablename = $self->get_fulltext_table_name();
535   
536    my $sth = $dbh->prepare_cached(qq{SELECT * FROM $tablename WHERE did = ?});
537    $sth->execute( $oid ); # will print msg on fail
538   
539    print $outhandle "### SQL select stmt: ".$sth->{'Statement'}."\n"
540    if ($self->{'verbosity'} > 2);
541   
542    my $rows_ref = $sth->fetchall_arrayref();
543    # Need explicit warning:
544    warn("Data fetching from $tablename terminated early by error: " . $dbh->err) if $dbh->err;
545    return $rows_ref;
546
547}
548
549# delete all records in metatable with specified docid
550# https://www.tutorialspoint.com/mysql/mysql-delete-query.htm
551# DELETE FROM table_name [WHERE Clause]
552# see example under 'do' at https://metacpan.org/pod/release/TIMB/DBI-1.634_50/DBI.pm
553sub delete_recs_from_metatable_with_docid {
554    my $self= shift (@_);
555    my ($oid) = @_;
556   
557    my $dbh = $self->{'db_handle'};
558
559    my $tablename = $self->get_metadata_table_name();
560    my $sth = $dbh->prepare_cached(qq{DELETE FROM $tablename WHERE did = ?});
561    $sth->execute( $oid ) or warn $dbh->errstr; # dbh set to print errors even without doing warn()
562}
563
564# delete all records in metatable with specified docid
565sub delete_recs_from_texttable_with_docid {
566    my $self= shift (@_);
567    my ($oid) = @_;
568   
569    my $dbh = $self->{'db_handle'};
570
571    my $tablename = $self->get_fulltext_table_name();
572    my $sth = $dbh->prepare_cached(qq{DELETE FROM $tablename WHERE did = ?});
573    $sth->execute( $oid ) or warn $dbh->errstr; # dbh set to print errors even without doing warn()
574}
575
576# Can call this after connection succeeded to get the database handle, dbh,
577# if any specific DB operation (SQL statement, create/delete)
578# needs to be executed that is not already provided as a method of this class.
579sub get_db_handle {
580    my $self= shift (@_);
581    return $self->{'db_handle'};
582}
583
584################ HELPER METHODS ##############
585
586# More basic helper methods
587sub get_metadata_table_name {
588    my $self= shift (@_);
589    my $table_name = $self->{'tablename_prefix'} . "_metadata";
590    return $table_name;
591}
592
593# FULLTEXT is a reserved keyword in (My)SQL. https://dev.mysql.com/doc/refman/5.5/en/keywords.html
594# So we can't name a table or any of its columns "fulltext". We use "fulltxt" instead.
595sub get_fulltext_table_name {
596    my $self= shift (@_);
597    my $table_name = $self->{'tablename_prefix'} . "_fulltxt";
598    return $table_name;
599}
600
601# Attempt to make sure the name parameter (for db or table name) is acceptable syntax
602# for the db in question, e.g. for mysql. For example, (My)SQL doesn't like tables or
603# databases with '-' (hyphens) in their names
604sub sanitize_name {
605    my $self= shift (@_);
606    my ($name) = @_;
607    $name =~ s/-/_/g;
608    return $name;
609}
610
611
612# I can get my version of table_exists to work, but it's not so ideal
613# Interesting that MySQL has non-standard command to CREATE TABLE IF NOT EXISTS and DROP TABLE IF EXISTS,
614# see https://www.perlmonks.org/bare/?node=DBI%20Recipes
615#    The page further has a table_exists function that could work with proper comparison
616# TODO Q: Couldn't get the first solution at https://www.perlmonks.org/bare/?node_id=500050 to work though
617sub table_exists {
618    my $self = shift (@_);
619    my $dbh = $self->{'db_handle'};
620    my ($table_name) = @_;
621
622    my @table_list = $dbh->tables;
623    #my $tables_str = @table_list[0];
624    foreach my $table (@table_list) {
625    return 1 if ($table =~ m/$table_name/);
626    }
627    return 0;
628}
629
6301;
Note: See TracBrowser for help on using the browser.