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

Revision 32557, 22.3 KB (checked in by ak19, 10 months ago)

1. Bugfix to create_database method: db_name is now a parameter to the method and no longer a member variable of gssql object. 2. UTF8 encodings finally made to work with GreenstoneSQL connections. Doing: 'set NAMES utf8' was insufficient and further causes an error when building a collection with macrons as the utf8 encoding thus specified only supports utf8 chars that take up to 3 bytes to encode. For utf8 chars that can take up to 4 bytes, need to do two things. First, run the mysqld server with minus-minus character_set_server=utf8mb4. Second, EITHER set mysql_enable_utf8mb4 => 1 option when using perl DBI to connect to the db (which in one step tells MySQL to use UTF-8 for communication AND DBD::mysql to decode the data) OR after connection, do BOTH set NAMES 'utf8mb4' (instead of utf8) to tell MySQL to use UTF-8 for communication AND ->{mysql_enable_utf8mb4} = 1 to tell DBD::mysql to decode the data. See  https://stackoverflow.com/questions/10957238/incorrect-string-value-when-trying-to-insert-utf-8-into-mysql-via-jdbc and  https://stackoverflow.com/questions/46727362/perl-mysql-utf8mb4-issue-possible-bug

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    'db_encoding' => $params_map->{'db_encoding'}
70    };
71
72    # (My)SQL doesn't like tables with - (hyphens) in their names
73    my $coll_name = $params_map->{'collection_name'};
74    $coll_name =~ s/-/_/g;
75    $self->{'tablename_prefix'} = $coll_name;
76
77    return bless($self, $class);
78}
79
80
81#################################
82
83# Database access related functions
84# http://g2pc1.bu.edu/~qzpeng/manual/MySQL%20Commands.htm
85# https://www.guru99.com/insert-into.html
86
87# 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)?
88# 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?
89# https://stackoverflow.com/questions/3280006/duplicating-a-mysql-table-indexes-and-data
90# BUT what if the table is HUGE? (Think of a collection with millions of docs.) Huge overhead in copying?
91# 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.
92# Unless they do a full rebuild, which will recreate the table from scratch?
93# SOLUTION-> rollback transaction on error, see https://www.effectiveperlprogramming.com/2010/07/set-custom-dbi-error-handlers/
94# But then should set AutoCommit to off on connection, and remember to commit every time
95
96#################
97# Database functions that use the perl DBI module (with the DBD driver module for mysql)
98#################
99
100################### BASIC DB OPERATIONS ##################
101
102# THE NEW DB FUNCTIONS
103# NOTE: FULLTEXT is a reserved keyword in (My)SQL. So we can't name a table or any of its columns "fulltext".
104# https://dev.mysql.com/doc/refman/5.5/en/keywords.html
105
106# TODO: Consider AutoCommit status (and Autocommit off allowing commit or rollback for GS coll build cancel) later
107
108# TODO: where should the defaults for these params be, here or in GS-SQLPlugin/Plugout?
109sub connect_to_db {
110    my $self= shift (@_);
111    my ($params_map) = @_;
112    #my $db_enc = $self->{'db_encoding'} || "utf8";
113    my $db_enc = "utf8mb4";
114
115    # these are the params for connecting to MySQL
116    my $db_driver = $params_map->{'db_driver'} || "mysql";
117    my $db_user = $params_map->{'db_client_user'} || "root";
118    my $db_pwd = $params_map->{'db_client_pwd'}; # even if undef, we'll see a sensible error message
119                                           # when connect fails
120    my $db_host = $params_map->{'db_host'} || "127.0.0.1";
121    # localhost doesn't work for us, but 127.0.0.1 works
122    # https://metacpan.org/pod/DBD::mysql
123    # "The hostname, if not specified or specified as '' or 'localhost', will default to a MySQL server
124    # running on the local machine using the default for the UNIX socket. To connect to a MySQL server
125    # on the local machine via TCP, you must specify the loopback IP address (127.0.0.1) as the host."
126    #my $connect_str = "dbi:$db_driver:database=$db_name;host=$db_host";
127    my $connect_str = "dbi:$db_driver:host=$db_host"; # don't provide db - allows checking the db exists
128    my $dbh = DBI->connect("$connect_str", $db_user, $db_pwd,
129               {
130                   ShowErrorStatement => 1, # more informative as DBI will append failed SQL stmt to error message
131                   PrintError => 1, # on by default, but being explicit
132                   RaiseError => 0, # off by default, but being explicit
133                   AutoCommit => 1, # on by default, but being explicit
134                   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
135               });
136
137    if(!$dbh) {
138    # NOTE, despite handle dbh being undefined, error code will be in DBI->err (note caps)
139    return 0;   
140    }
141
142    # set encoding https://metacpan.org/pod/DBD::mysql
143    # https://dev.mysql.com/doc/refman/5.7/en/charset.html
144    # https://dev.mysql.com/doc/refman/5.7/en/charset-conversion.html
145    # Setting the encoding at db server level: $dbh->do("set NAMES '" . $db_enc . "'");
146    # HOWEVER:
147    # It turned out insufficient setting the encoding to utf8, as that only supports utf8 chars that
148    # need up to 3 bytes. We may need up to 4 bytes per utf8 character, e.g. chars with macron,
149    # and for that, we need the encoding to be set to utf8mb4.
150    # To set up a MySQL db to use utf8mb4 requires configuration on the server side too.
151    # https://stackoverflow.com/questions/10957238/incorrect-string-value-when-trying-to-insert-utf-8-into-mysql-via-jdbc
152    # https://stackoverflow.com/questions/46727362/perl-mysql-utf8mb4-issue-possible-bug
153    # To set up the db for utf8mb4, therefore,
154    # the MySQL server needs to be configured for that char encoding by running the server as:
155    # mysql-5.7.23-linux-glibc2.12-x86_64/bin>./mysqld_safe --datadir=/Scratch/ak19/mysql/data --character_set_server=utf8mb4
156    # AND when connecting to the server, we can can either set mysql_enable_utf8mb4 => 1
157    # as a connection option
158    # OR we need to do both "set NAMES utf8mb4" AND "$dbh->{mysql_enable_utf8mb4} = 1;" after connecting
159    #
160    # Search results for DBI Set Names imply the "SET NAMES '<enc>'" command is mysql specific too,
161    # so setting the mysql specific option during connection above as "mysql_enable_utf8mb4 => 1"
162    # is no more objectionable. It has the advantage of cutting out the 2 extra lines of doing
163    # set NAMES '<enc>' and $dbh->{mysql_enable_utf8mb4} = 1 here.
164    # These lines may be preferred if more db_driver options are to be supported in future:
165    # then a separate method called set_db_encoding($enc) can work out what db_driver we're using
166    # and if mysql and enc=utfy, then it can do the following whereas it will issue other do stmts
167    # for other db_drivers, see https://www.perlmonks.org/?node_id=259456:
168   
169    #my $stmt = "set NAMES '" . $db_enc . "'";
170    #$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
171    #$dbh->{mysql_enable_utf8mb4} = 1; # tells DBD::mysql to decode the data
172   
173    # if we're here, then connection succeeded, store handle
174    $self->{'db_handle'} = $dbh;
175    return 1;
176}
177
178# will attempt to load the specified db and the <coll>_metadata and <coll>_fulltxt for this
179# collection, or create any of these (db, tables) that don't yet exist. At the end
180# it will have loaded the requested database (in MySQL: "use <db>;")
181sub load_db_and_tables {
182    my $self= shift (@_);
183    my ($db_name, $build_mode) = @_;
184    my $dbh = $self->{'db_handle'};
185   
186    # perl DBI switch database: https://www.perlmonks.org/?node_id=995434
187    # do() returns undef on error.
188    # connection succeeded, try to load our database. If that didn't work, attempt to create db
189    my $success = $dbh->do("use $db_name");
190   
191    if(!$success && $dbh->err == 1049) { # "Unknown database" error has code 1049 (mysql only?) meaning db doesn't exist yet
192    # attempt to create the db and its tables
193    $self->create_db($db_name) || return 0;
194
195    print STDERR "@@@ CREATED DATABASE $db_name\n";
196   
197    # once more attempt to use db, now that it exists
198    $dbh->do("use $db_name") || return 0;
199    #$dbh->do("use localsite") or die "Error (code" . $dbh->err ."): " . $dbh->errstr . "\n";
200
201    # attempt to create tables in current db
202    $self->create_metadata_table() || return 0;
203    $self->create_fulltext_table() || return 0;
204
205    $success = 1;
206    }
207    elsif($success) { # database existed and loaded successfully, but
208    # before proceeding check that the current collection's tables exist
209
210    print STDERR "@@@ DATABASE $db_name EXISTED\n";
211   
212
213    # build_mode can be removeold or incremental. We only do something special on removeold:
214    # deleting the existing tables for this collection and recreating empty ones
215    if($build_mode eq "removeold") {
216        $self->delete_collection_tables();
217    }
218
219    # use existing tables if any
220    # attempt to create tables in current db   
221    if($build_mode eq "removeold" || !$self->table_exists($self->get_metadata_table_name())) {
222        $self->create_metadata_table() || return 0;
223    } else {
224        print STDERR "@@@ Meta table exists\n";
225    }
226    if($build_mode eq "removeold" || !$self->table_exists($self->get_fulltext_table_name())) {
227        $self->create_fulltext_table() || return 0;
228    } else {
229        print STDERR "@@@ Fulltxt table exists\n";
230    }
231   
232    }
233   
234    return $success; # could still return 0, if database failed to load with an error code != 1049
235}
236
237# GreenstoneSQLPlugin calls this method to load an existing db.
238# This will terminate if the db does not exist. Unlike load_db_and_tables() above, used by
239# GreenstoneSQLPlugout, this method will not attempt to create the requested db (nor its tables)
240# TODO: GS SQLPlugin is called before GS SQLPlugout and attempts to use_db() - called in plugin's
241# init() method. This will fail if the db does not exist. Ideally want the gssqlplugin only called
242# during buildcol.pl
243sub use_db {
244    my $self= shift (@_);
245    my ($db_name) = @_;
246    my $dbh = $self->{'db_handle'};
247   
248    # perl DBI switch database: https://www.perlmonks.org/?node_id=995434
249    # do() returns undef on error.
250    # connection succeeded, try to load our database. If that didn't work, attempt to create db
251    return $dbh->do("use $db_name") || warn();
252}
253
254# disconnect from db - https://metacpan.org/pod/DBI#disconnect
255# TODO: make sure to have committed or rolled back before disconnect
256# and that you've call finish() on statement handles if any fetch remnants remain
257sub disconnect_from_db {
258    my $self= shift (@_);   
259    my $dbh = $self->{'db_handle'};
260
261    # make sure any active stmt handles are finished
262    # 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."
263   
264    #$meta_sth = $self->{'metadata_prepared_insert_statement_handle'};
265    #$txt_sth = $self->{'fulltxt_prepared_insert_statement_handle'};
266    #$meta_sth->finish() if($meta_sth);
267    #$txt_sth->finish() if($txt_sth);
268   
269    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?
270    return $rc;
271}
272
273sub create_db {
274    my $self= shift (@_);
275    my ($db_name) = @_;
276    my $dbh = $self->{'db_handle'};
277   
278    # https://stackoverflow.com/questions/5025768/how-can-i-create-a-mysql-database-from-a-perl-script
279    return $dbh->do("create database $db_name"); # do() will return undef on fail, https://metacpan.org/pod/DBI#do
280}
281
282
283sub create_metadata_table {
284    my $self= shift (@_);
285    my $dbh = $self->{'db_handle'};
286   
287    my $table_name = $self->get_metadata_table_name();
288
289    # If using an auto incremented primary key:
290    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));";
291    return $dbh->do($stmt);
292}
293
294# TODO: Investigate: https://dev.mysql.com/doc/search/?d=10&p=1&q=FULLTEXT
295# 12.9.1 Natural Language Full-Text Searches
296# to see whether we have to index the 'fulltxt' column of the 'fulltext' tables
297# or let user edit this file, or add it as another option
298sub create_fulltext_table {
299    my $self= shift (@_);
300    my $dbh = $self->{'db_handle'};
301   
302    my $table_name = $self->get_fulltext_table_name();
303
304    # If using an auto incremented primary key:
305    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));";
306    return $dbh->do($stmt);
307
308}
309
310# "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"
311# MySQL 8.0 Reference Manual :: 13.1.22 DROP DATABASE Syntax
312# https://dev.mysql.com/doc/en/drop-database.html
313sub delete_collection_tables {
314    my $self= shift (@_);
315    my $dbh = $self->{'db_handle'};
316   
317    print STDERR "### Build mode is removeold, so deleting tables for current collection\n";
318   
319    # drop table <tablename>
320    my $table = $self->get_metadata_table_name();
321    if($self->table_exists($table)) {
322    $dbh->do("drop table $table") || warn("@@@ Couldn't delete $table");
323    }
324    $table = $self->get_fulltext_table_name();
325    if($self->table_exists($table)) {
326    $dbh->do("drop table $table") || warn("@@@ Couldn't delete $table");
327    }
328}
329
330# Don't call this: it will delete the meta and full text tables for ALL collections in $db_name (localsite by default)!
331# This method is just here for debugging (for testing creating a database when there is none)
332sub _delete_database {
333    my $self= shift (@_);
334    my ($db_name) = @_;
335    my $dbh = $self->{'db_handle'};
336   
337    # "drop database dbname"
338    $dbh->do("drop database $db_name") || return 0;
339
340    return 1;
341}
342
343
344########################### DB STATEMENTS ###########################
345
346# USEFUL: https://metacpan.org/pod/DBI
347# "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."
348
349
350# https://www.guru99.com/insert-into.html
351# and https://dev.mysql.com/doc/refman/8.0/en/example-auto-increment.html
352#     for inserting multiple rows at once
353# https://www.perlmonks.org/bare/?node_id=316183
354# https://metacpan.org/pod/DBI#do
355# 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
356# https://docstore.mik.ua/orelly/linux/dbi/ch05_05.htm
357
358# https://metacpan.org/pod/DBI#performance
359# '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.'
360sub prepare_insert_metadata_row_stmthandle {
361    my $self = shift (@_);   
362    #my ($did, $sid, $metaname, $metavalue) = @_;
363    my $dbh = $self->{'db_handle'};
364   
365    my $tablename = $self->get_metadata_table_name();
366
367    #my $stmt = "INSERT INTO $tablename (did, sid, metaname, metavalue) VALUES ('$did', '$sid', '$metaname', '$metavalue');"; # ?, ?, ?, ?
368
369    # using qq{} since we want $tablename placeholder to be filled in
370    # returns Statement Handle object!
371    my $sth = $dbh->prepare(qq{INSERT INTO $tablename (did, sid, metaname, metavalue) VALUES (?, ?, ?, ?)}) || warn("Could not prepare insert statement for metadata table\n");
372
373    print STDERR "@@@@ Prepared meta insert statement: ".$sth->{'Statement'}."\n";
374   
375    return $sth;
376}
377
378sub prepare_insert_fulltxt_row_stmthandle {
379    my $self = shift (@_);
380    #my ($did, $sid, $fulltext) = @_;
381    my $dbh = $self->{'db_handle'};
382   
383    my $tablename = $self->get_fulltext_table_name();
384
385    #my $stmt = "INSERT INTO $tablename (did, sid, fulltxt) VALUES ('$did', '$sid', '$fulltext');"; ?, ?, ?
386
387    # using qq{} since we want $tablename placeholder to be filled in
388    # returns Statement Handle object!
389    my $sth = $dbh->prepare(qq{INSERT INTO $tablename (did, sid, fulltxt) VALUES (?, ?, ?)}) || warn("Could not prepare insert statement for fulltxt table\n");
390   
391    print STDERR "@@@@ Prepared fulltext insert statement: ".$sth->{'Statement'}."\n";
392   
393    return $sth;
394}
395
396
397## The 2 select statements used by GreenstoneSQLPlugin
398
399# Returns the statement handle that prepared and executed
400# a "SELECT * FROM <COLL>_metadata WHERE did = $oid" SQL statement.
401# Caller can call fetchrow_array() on returned statement handle, $sth
402# Have to use prepare() and execute() instead of do() since do() does
403# not allow for fetching result set thereafter:
404# 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
405sub select_from_metatable_matching_docid {
406    my $self= shift (@_);
407    my ($oid) = @_;
408   
409    my $dbh = $self->{'db_handle'};
410    my $meta_table = $self->get_metadata_table_name();
411   
412    my $sth = $dbh->prepare(qq{SELECT * FROM $meta_table WHERE did = ?});
413    $sth->execute( $oid ); # will print msg on fail
414   
415    return $sth; # caller can call fetchrow_array() on returned statement handle, sth
416}
417
418# Returns the statement handle that prepared and executed
419# a "SELECT * FROM <COLL>_metadata WHERE did = $oid" SQL statement.
420# Caller can call fetchrow_array() on returned statement handle, $sth
421sub select_from_texttable_matching_docid {
422    my $self= shift (@_);
423    my ($oid) = @_;
424   
425    my $dbh = $self->{'db_handle'};
426    my $fulltxt_table = $self->get_fulltext_table_name();
427   
428    my $sth = $dbh->prepare(qq{SELECT * FROM $fulltxt_table WHERE did = ?});
429    $sth->execute( $oid ); # will print msg on fail
430   
431    return $sth; # caller can call fetchrow_array() on returned statement handle, sth
432}
433
434# delete all records in metatable with specified docid
435# https://www.tutorialspoint.com/mysql/mysql-delete-query.htm
436# DELETE FROM table_name [WHERE Clause]
437# see example under 'do' at https://metacpan.org/pod/release/TIMB/DBI-1.634_50/DBI.pm
438sub delete_recs_from_metatable_with_docid {
439    my $self= shift (@_);
440    my ($oid) = @_;
441   
442    my $dbh = $self->{'db_handle'};
443    my $meta_table = $self->get_metadata_table_name();
444   
445    #my $rows_deleted =
446    $dbh->do(qq{DELETE FROM $meta_table WHERE did = ?}, undef, $oid)
447    or warn $dbh->errstr;
448}
449
450# delete all records in metatable with specified docid
451sub delete_recs_from_texttable_with_docid {
452    my $self= shift (@_);
453    my ($oid) = @_;
454   
455    my $dbh = $self->{'db_handle'};   
456    my $fulltxt_table = $self->get_fulltext_table_name();
457   
458    $dbh->do(qq{DELETE FROM $fulltxt_table WHERE did = ?}, undef, $oid)
459    or warn $dbh->errstr;
460}
461
462# Can call this after connection succeeded to get the database handle, dbh,
463# if any specific DB operation (SQL statement, create/delete)
464# needs to be executed that is not already provided as a method of this class.
465sub get_db_handle {
466    my $self= shift (@_);
467    return $self->{'db_handle'};
468}
469
470################ HELPER METHODS ##############
471
472# More basic helper methods
473sub get_metadata_table_name {
474    my $self= shift (@_);
475    my $table_name = $self->{'tablename_prefix'} . "_metadata";
476    return $table_name;
477}
478
479# FULLTEXT is a reserved keyword in (My)SQL. https://dev.mysql.com/doc/refman/5.5/en/keywords.html
480# So we can't name a table or any of its columns "fulltext". We use "fulltxt" instead.
481sub get_fulltext_table_name {
482    my $self= shift (@_);
483    my $table_name = $self->{'tablename_prefix'} . "_fulltxt";
484    return $table_name;
485}
486
487
488# I can get my version of table_exists to work, but it's not so ideal
489# Interesting that MySQL has non-standard command to CREATE TABLE IF NOT EXISTS and DROP TABLE IF EXISTS,
490# see https://www.perlmonks.org/bare/?node=DBI%20Recipes
491#    The page further has a table_exists function that could work with proper comparison
492# TODO Q: Couldn't get the first solution at https://www.perlmonks.org/bare/?node_id=500050 to work though
493sub table_exists {
494    my $self = shift (@_);
495    my $dbh = $self->{'db_handle'};
496    my ($table_name) = @_;
497
498    my @table_list = $dbh->tables;
499    #my $tables_str = @table_list[0];
500    foreach my $table (@table_list) {
501    return 1 if ($table =~ m/$table_name/);
502    }
503    return 0;
504}
505
5061;
Note: See TracBrowser for help on using the browser.