source: main/trunk/greenstone2/perllib/gssql.pm@ 32575

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