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

Last change on this file since 32559 was 32559, checked in by ak19, 3 years ago

Removing db_encoding as parameters to GreenstoneSQLPlugout and GreenstoneSQLPlugin: as doc.xml is always in utf8, the same contents stored in the MySQL db should be too.

File size: 23.5 KB
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# Need params_map keys:
36# - collection_name
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:
42# - db_driver, db_client_user, db_client_pwd, db_host, (db_port not used at present)
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# - build_mode (like removeold)
47# - db_name (which is the GS3 sitename)
48
49# TODO: add infrastructure for db_port, AutoCommit etc
50# For port, see https://stackoverflow.com/questions/2248665/perl-script-to-connect-to-mysql-server-port-3307
51
52sub new
53{
54
55 my $class = shift(@_);
56
57 my ($params_map) = @_;
58
59 # library_url: to be specified on the cmdline if not using a GS-included web server
60 # the GSDL_LIBRARY_URL env var is useful when running cmdline buildcol.pl in the linux package manager versions of GS3
61
62 # https://stackoverflow.com/questions/7083453/copying-a-hashref-in-perl
63 # Making a shallow copy works, and can handle unknown params:
64 #my $self = $params_map;
65
66 # but being explicit for class params needed for MySQL:
67 my $self = {
68 'collection_name' => $params_map->{'collection_name'},
69 };
70
71 # (My)SQL doesn't like tables with - (hyphens) in their names
72 my $coll_name = $params_map->{'collection_name'};
73 $coll_name =~ s/-/_/g;
74 $self->{'tablename_prefix'} = $coll_name;
75
76 # The db_encoding option is presently not passed in to this constructor as parameter.
77 # Placed here to indicate it's sort of optional.
78 # Since docxml are all in utf8, the contents of the GS SQL database should be too,
79 # So making utf8 the hidden default at present.
80 $self->{'db_encoding'} = $params_map->{'db_encoding'} || "utf8";
81
82 return bless($self, $class);
83}
84
85
86#################################
87
88# Database access related functions
89# http://g2pc1.bu.edu/~qzpeng/manual/MySQL%20Commands.htm
90# https://www.guru99.com/insert-into.html
91
92# 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)?
93# 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?
94# https://stackoverflow.com/questions/3280006/duplicating-a-mysql-table-indexes-and-data
95# BUT what if the table is HUGE? (Think of a collection with millions of docs.) Huge overhead in copying?
96# 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.
97# Unless they do a full rebuild, which will recreate the table from scratch?
98# SOLUTION-> rollback transaction on error, see https://www.effectiveperlprogramming.com/2010/07/set-custom-dbi-error-handlers/
99# But then should set AutoCommit to off on connection, and remember to commit every time
100
101#################
102# Database functions that use the perl DBI module (with the DBD driver module for mysql)
103#################
104
105################### BASIC DB OPERATIONS ##################
106
107# THE NEW DB FUNCTIONS
108# NOTE: FULLTEXT is a reserved keyword in (My)SQL. So we can't name a table or any of its columns "fulltext".
109# https://dev.mysql.com/doc/refman/5.5/en/keywords.html
110
111# TODO: Consider AutoCommit status (and Autocommit off allowing commit or rollback for GS coll build cancel) later
112
113# TODO: where should the defaults for these params be, here or in GS-SQLPlugin/Plugout?
114sub connect_to_db {
115 my $self= shift (@_);
116 my ($params_map) = @_;
117 # For proper utf8 support in MySQL, encoding should be 'utf8mb4' as 'utf8' is insufficient
118 my $db_enc = "utf8mb4" if $self->{'db_encoding'} eq "utf8";
119
120 # these are the params for connecting to MySQL
121 my $db_driver = $params_map->{'db_driver'} || "mysql";
122 my $db_user = $params_map->{'db_client_user'} || "root";
123 my $db_pwd = $params_map->{'db_client_pwd'}; # even if undef, we'll see a sensible error message
124 # when connect fails
125 my $db_host = $params_map->{'db_host'} || "127.0.0.1";
126 # localhost doesn't work for us, but 127.0.0.1 works
127 # https://metacpan.org/pod/DBD::mysql
128 # "The hostname, if not specified or specified as '' or 'localhost', will default to a MySQL server
129 # running on the local machine using the default for the UNIX socket. To connect to a MySQL server
130 # on the local machine via TCP, you must specify the loopback IP address (127.0.0.1) as the host."
131 #my $connect_str = "dbi:$db_driver:database=$db_name;host=$db_host";
132 my $connect_str = "dbi:$db_driver:host=$db_host"; # don't provide db - allows checking the db exists later when loading the db
133
134 print STDERR "Away to make connection to $db_driver database with:\n";
135 print STDERR " - hostname $db_host; username: $db_user";
136 print STDERR "; and the password provided" if $db_pwd;
137 print STDERR "\nAssuming the mysql server has been started with: --character_set_server=utf8mb4\n" if $db_driver eq "mysql";
138
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
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
146 });
147
148 if(!$dbh) {
149 # NOTE, despite handle dbh being undefined, error code will be in DBI->err (note caps)
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
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:
179
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
184 # if we're here, then connection succeeded, store handle
185 $self->{'db_handle'} = $dbh;
186 return 1;
187}
188
189# will attempt to load the specified db and the <coll>_metadata and <coll>_fulltxt for this
190# collection, or create any of these (db, tables) that don't yet exist. At the end
191# it will have loaded the requested database (in MySQL: "use <db>;")
192sub load_db_and_tables {
193 my $self= shift (@_);
194 my ($db_name, $build_mode) = @_;
195 my $dbh = $self->{'db_handle'};
196
197 print STDERR "Attempting to use database $db_name\n";
198
199 # perl DBI switch database: https://www.perlmonks.org/?node_id=995434
200 # do() returns undef on error.
201 # connection succeeded, try to load our database. If that didn't work, attempt to create db
202 my $success = $dbh->do("use $db_name");
203
204 if(!$success && $dbh->err == 1049) { # "Unknown database" error has code 1049 (mysql only?) meaning db doesn't exist yet
205
206 print STDERR "Database $db_name didn't exist, creating it and tables for the current collection...\n";
207
208 # attempt to create the db and its tables
209 $self->create_db($db_name) || return 0;
210
211 print STDERR " Created database $db_name\n";
212
213 # once more attempt to use db, now that it exists
214 $dbh->do("use $db_name") || return 0;
215 #$dbh->do("use localsite") or die "Error (code" . $dbh->err ."): " . $dbh->errstr . "\n";
216
217 # attempt to create tables in current db
218 $self->create_metadata_table() || return 0;
219 $self->create_fulltext_table() || return 0;
220
221 $success = 1;
222 }
223 elsif($success) { # database existed and loaded successfully, but
224 # before proceeding check that the current collection's tables exist
225
226 print STDERR "@@@ DATABASE $db_name EXISTED\n";
227
228
229 # build_mode can be removeold or incremental. We only do something special on removeold:
230 # deleting the existing tables for this collection and recreating empty ones
231 if($build_mode eq "removeold") {
232 print STDERR " Building with removeold option set, so deleting current collection's tables if they exist\n";
233 $self->delete_collection_tables();
234 }
235
236 # use existing tables if any
237 # attempt to create tables in current db
238 if($build_mode eq "removeold" || !$self->table_exists($self->get_metadata_table_name())) {
239 $self->create_metadata_table() || return 0;
240 } else {
241 print STDERR "@@@ Meta table exists\n";
242 }
243 if($build_mode eq "removeold" || !$self->table_exists($self->get_fulltext_table_name())) {
244 $self->create_fulltext_table() || return 0;
245 } else {
246 print STDERR "@@@ Fulltxt table exists\n";
247 }
248
249 }
250
251 return $success; # could still return 0, if database failed to load with an error code != 1049
252}
253
254# GreenstoneSQLPlugin calls this method to load an existing db.
255# This will terminate if the db does not exist. Unlike load_db_and_tables() above, used by
256# GreenstoneSQLPlugout, this method will not attempt to create the requested db (nor its tables)
257# TODO: GS SQLPlugin is called before GS SQLPlugout and attempts to use_db() - called in plugin's
258# init() method. This will fail if the db does not exist. Ideally want the gssqlplugin only called
259# during buildcol.pl
260sub use_db {
261 my $self= shift (@_);
262 my ($db_name) = @_;
263 my $dbh = $self->{'db_handle'};
264
265 print STDERR "Loading database $db_name\n";
266
267 # perl DBI switch database: https://www.perlmonks.org/?node_id=995434
268 # do() returns undef on error.
269 # connection succeeded, try to load our database. If that didn't work, attempt to create db
270 return $dbh->do("use $db_name") || warn();
271}
272
273# disconnect from db - https://metacpan.org/pod/DBI#disconnect
274# TODO: make sure to have committed or rolled back before disconnect
275# and that you've call finish() on statement handles if any fetch remnants remain
276sub disconnect_from_db {
277 my $self= shift (@_);
278 my $dbh = $self->{'db_handle'};
279
280 # make sure any active stmt handles are finished
281 # 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."
282
283 #$meta_sth = $self->{'metadata_prepared_insert_statement_handle'};
284 #$txt_sth = $self->{'fulltxt_prepared_insert_statement_handle'};
285 #$meta_sth->finish() if($meta_sth);
286 #$txt_sth->finish() if($txt_sth);
287
288 print STDERR "Disconnecting from database\n";
289
290 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?
291 return $rc;
292}
293
294sub create_db {
295 my $self= shift (@_);
296 my ($db_name) = @_;
297 my $dbh = $self->{'db_handle'};
298
299 # https://stackoverflow.com/questions/5025768/how-can-i-create-a-mysql-database-from-a-perl-script
300 return $dbh->do("create database $db_name"); # do() will return undef on fail, https://metacpan.org/pod/DBI#do
301}
302
303
304sub create_metadata_table {
305 my $self= shift (@_);
306 my $dbh = $self->{'db_handle'};
307
308 my $table_name = $self->get_metadata_table_name();
309 print STDERR " Creating table $table_name\n";
310
311 # If using an auto incremented primary key:
312 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));";
313 return $dbh->do($stmt);
314}
315
316# TODO: Investigate: https://dev.mysql.com/doc/search/?d=10&p=1&q=FULLTEXT
317# 12.9.1 Natural Language Full-Text Searches
318# to see whether we have to index the 'fulltxt' column of the 'fulltext' tables
319# or let user edit this file, or add it as another option
320sub create_fulltext_table {
321 my $self= shift (@_);
322 my $dbh = $self->{'db_handle'};
323
324 my $table_name = $self->get_fulltext_table_name();
325 print STDERR " Creating table $table_name\n";
326
327 # If using an auto incremented primary key:
328 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));";
329 return $dbh->do($stmt);
330
331}
332
333# "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"
334# MySQL 8.0 Reference Manual :: 13.1.22 DROP DATABASE Syntax
335# https://dev.mysql.com/doc/en/drop-database.html
336sub delete_collection_tables {
337 my $self= shift (@_);
338 my $dbh = $self->{'db_handle'};
339
340 # drop table <tablename>
341 my $table = $self->get_metadata_table_name();
342 if($self->table_exists($table)) {
343 $dbh->do("drop table $table") || warn("@@@ Couldn't delete $table");
344 }
345 $table = $self->get_fulltext_table_name();
346 if($self->table_exists($table)) {
347 $dbh->do("drop table $table") || warn("@@@ Couldn't delete $table");
348 }
349}
350
351# Don't call this: it will delete the meta and full text tables for ALL collections in $db_name (localsite by default)!
352# This method is just here for debugging (for testing creating a database when there is none)
353sub _delete_database {
354 my $self= shift (@_);
355 my ($db_name) = @_;
356 my $dbh = $self->{'db_handle'};
357
358 print STDERR "!!! Deleting database $db_name\n";
359
360 # "drop database dbname"
361 $dbh->do("drop database $db_name") || return 0;
362
363 return 1;
364}
365
366
367########################### DB STATEMENTS ###########################
368
369# USEFUL: https://metacpan.org/pod/DBI
370# "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."
371
372
373# https://www.guru99.com/insert-into.html
374# and https://dev.mysql.com/doc/refman/8.0/en/example-auto-increment.html
375# for inserting multiple rows at once
376# https://www.perlmonks.org/bare/?node_id=316183
377# https://metacpan.org/pod/DBI#do
378# 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
379# https://docstore.mik.ua/orelly/linux/dbi/ch05_05.htm
380
381# https://metacpan.org/pod/DBI#performance
382# '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.'
383sub prepare_insert_metadata_row_stmthandle {
384 my $self = shift (@_);
385 #my ($did, $sid, $metaname, $metavalue) = @_;
386 my $dbh = $self->{'db_handle'};
387
388 my $tablename = $self->get_metadata_table_name();
389
390 #my $stmt = "INSERT INTO $tablename (did, sid, metaname, metavalue) VALUES ('$did', '$sid', '$metaname', '$metavalue');"; # ?, ?, ?, ?
391
392 # using qq{} since we want $tablename placeholder to be filled in
393 # returns Statement Handle object!
394 my $sth = $dbh->prepare(qq{INSERT INTO $tablename (did, sid, metaname, metavalue) VALUES (?, ?, ?, ?)}) || warn("Could not prepare insert statement for metadata table\n");
395
396 print STDERR "@@@@ Prepared meta insert statement: ".$sth->{'Statement'}."\n";
397
398 return $sth;
399}
400
401sub prepare_insert_fulltxt_row_stmthandle {
402 my $self = shift (@_);
403 #my ($did, $sid, $fulltext) = @_;
404 my $dbh = $self->{'db_handle'};
405
406 my $tablename = $self->get_fulltext_table_name();
407
408 #my $stmt = "INSERT INTO $tablename (did, sid, fulltxt) VALUES ('$did', '$sid', '$fulltext');"; ?, ?, ?
409
410 # using qq{} since we want $tablename placeholder to be filled in
411 # returns Statement Handle object!
412 my $sth = $dbh->prepare(qq{INSERT INTO $tablename (did, sid, fulltxt) VALUES (?, ?, ?)}) || warn("Could not prepare insert statement for fulltxt table\n");
413
414 print STDERR "@@@@ Prepared fulltext insert statement: ".$sth->{'Statement'}."\n";
415
416 return $sth;
417}
418
419
420## The 2 select statements used by GreenstoneSQLPlugin
421
422# Returns the statement handle that prepared and executed
423# a "SELECT * FROM <COLL>_metadata WHERE did = $oid" SQL statement.
424# Caller can call fetchrow_array() on returned statement handle, $sth
425# Have to use prepare() and execute() instead of do() since do() does
426# not allow for fetching result set thereafter:
427# 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
428sub select_from_metatable_matching_docid {
429 my $self= shift (@_);
430 my ($oid) = @_;
431
432 my $dbh = $self->{'db_handle'};
433 my $meta_table = $self->get_metadata_table_name();
434
435 my $sth = $dbh->prepare(qq{SELECT * FROM $meta_table WHERE did = ?});
436 $sth->execute( $oid ); # will print msg on fail
437
438 return $sth; # caller can call fetchrow_array() on returned statement handle, sth
439}
440
441# Returns the statement handle that prepared and executed
442# a "SELECT * FROM <COLL>_metadata WHERE did = $oid" SQL statement.
443# Caller can call fetchrow_array() on returned statement handle, $sth
444sub select_from_texttable_matching_docid {
445 my $self= shift (@_);
446 my ($oid) = @_;
447
448 my $dbh = $self->{'db_handle'};
449 my $fulltxt_table = $self->get_fulltext_table_name();
450
451 my $sth = $dbh->prepare(qq{SELECT * FROM $fulltxt_table WHERE did = ?});
452 $sth->execute( $oid ); # will print msg on fail
453
454 return $sth; # caller can call fetchrow_array() on returned statement handle, sth
455}
456
457# delete all records in metatable with specified docid
458# https://www.tutorialspoint.com/mysql/mysql-delete-query.htm
459# DELETE FROM table_name [WHERE Clause]
460# see example under 'do' at https://metacpan.org/pod/release/TIMB/DBI-1.634_50/DBI.pm
461sub delete_recs_from_metatable_with_docid {
462 my $self= shift (@_);
463 my ($oid) = @_;
464
465 my $dbh = $self->{'db_handle'};
466 my $meta_table = $self->get_metadata_table_name();
467
468 #my $rows_deleted =
469 $dbh->do(qq{DELETE FROM $meta_table WHERE did = ?}, undef, $oid)
470 or warn $dbh->errstr;
471}
472
473# delete all records in metatable with specified docid
474sub delete_recs_from_texttable_with_docid {
475 my $self= shift (@_);
476 my ($oid) = @_;
477
478 my $dbh = $self->{'db_handle'};
479 my $fulltxt_table = $self->get_fulltext_table_name();
480
481 $dbh->do(qq{DELETE FROM $fulltxt_table WHERE did = ?}, undef, $oid)
482 or warn $dbh->errstr;
483}
484
485# Can call this after connection succeeded to get the database handle, dbh,
486# if any specific DB operation (SQL statement, create/delete)
487# needs to be executed that is not already provided as a method of this class.
488sub get_db_handle {
489 my $self= shift (@_);
490 return $self->{'db_handle'};
491}
492
493################ HELPER METHODS ##############
494
495# More basic helper methods
496sub get_metadata_table_name {
497 my $self= shift (@_);
498 my $table_name = $self->{'tablename_prefix'} . "_metadata";
499 return $table_name;
500}
501
502# FULLTEXT is a reserved keyword in (My)SQL. https://dev.mysql.com/doc/refman/5.5/en/keywords.html
503# So we can't name a table or any of its columns "fulltext". We use "fulltxt" instead.
504sub get_fulltext_table_name {
505 my $self= shift (@_);
506 my $table_name = $self->{'tablename_prefix'} . "_fulltxt";
507 return $table_name;
508}
509
510
511# I can get my version of table_exists to work, but it's not so ideal
512# Interesting that MySQL has non-standard command to CREATE TABLE IF NOT EXISTS and DROP TABLE IF EXISTS,
513# see https://www.perlmonks.org/bare/?node=DBI%20Recipes
514# The page further has a table_exists function that could work with proper comparison
515# TODO Q: Couldn't get the first solution at https://www.perlmonks.org/bare/?node_id=500050 to work though
516sub table_exists {
517 my $self = shift (@_);
518 my $dbh = $self->{'db_handle'};
519 my ($table_name) = @_;
520
521 my @table_list = $dbh->tables;
522 #my $tables_str = @table_list[0];
523 foreach my $table (@table_list) {
524 return 1 if ($table =~ m/$table_name/);
525 }
526 return 0;
527}
528
5291;
Note: See TracBrowser for help on using the repository browser.