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

###########################################################################
#
# gsmysql.pm -- Uses DBI for MySQL related utility functions used by
# GreenstoneSQLPlugout and GreenstoneSQLPlugin too.
# A component of the Greenstone digital library software
# from the New Zealand Digital Library Project at the 
# University of Waikato, New Zealand.
#
# Copyright (C) 1999 New Zealand Digital Library Project
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
#
###########################################################################

package gsmysql;

use strict;
no strict 'refs';
no strict 'subs';

use DBI; # the central package for this module used by GreenstoneSQL Plugout and Plugin

#################
# Database functions that use the perl DBI module (with the DBD driver module for mysql)
# https://metacpan.org/pod/release/TIMB/DBI-1.634_50/DBI.pm
# https://metacpan.org/pod/DBD::mysql
#################

##############################

# TODO Q: If disconnect is automatically called when object destroyed, what does that mean
# for our file-global handle object, is disconnect only called at end of perl process?
# Does that mean we don't need to explicitly call disconnect in gsmysql object's destroy during
# the GLOBAL destruction phase?
# https://perldoc.perl.org/perlobj.html#Destructors

#+ TODO: add infrastructure for db_port, AutoCommit etc
# For port, see https://stackoverflow.com/questions/2248665/perl-script-to-connect-to-mysql-server-port-3307

# + TODO: remove unnecessary warn() since PrintError is active

# + TODO: drop table if exists and create table if exists are available in MySQL. Use those cmds
# instead of always first checking for existence ourselves? Only when subclassing to specific
# mysql class?


# + 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)?
# 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? 
# https://stackoverflow.com/questions/3280006/duplicating-a-mysql-table-indexes-and-data
# BUT what if the table is HUGE? (Think of a collection with millions of docs.) Huge overhead in copying?
# 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.
# Unless they do a full rebuild, which will recreate the table from scratch?
# SOLUTION-> rollback transaction on error, see https://www.effectiveperlprogramming.com/2010/07/set-custom-dbi-error-handlers/
# In that case, should set AutoCommit to off on connection, and remember to commit at end.

# + TODO: Consider AutoCommit status (and Autocommit off allowing commit or rollback for GS coll build cancel) later


##############################

# singleton connection
my $_dbh_instance = undef; # calls undef() function. See https://perlmaven.com/undef-and-defined-in-perl
my $ref_count = 0;

# Need params_map keys:
# - collection_name
# - db_encoding (db content encoding) - MySQL can set this at server, db, table levels. For MySQL
# we set the enc during connect at server level. Not sure whether other DB's support it at the
# same levels.

# For connection to MySQL, need:
#  - db_driver, db_client_user, db_client_pwd, db_host, (db_port not used at present)
# So these will be parameterised, but in a hashmap, for just the connect method.

# Parameterise (one or more methods may use them):
# - db_name (which is the GS3 sitename, or "greenstone2" for GS2)

# Database access related functions
# http://g2pc1.bu.edu/~qzpeng/manual/MySQL%20Commands.htm
# https://www.guru99.com/insert-into.html

# Add signal handlers to cleanup and disconnect from db on sudden termination, incl cancel build
# https://www.perl.com/article/37/2013/8/18/Catch-and-Handle-Signals-in-Perl/
$SIG{INT}  = \&finish_signal_handler;
$SIG{TERM}  = \&finish_signal_handler;
$SIG{KILL}  = \&finish_signal_handler;

sub finish_signal_handler {
    my ($sig) = @_; # one of INT|KILL|TERM

    if ($_dbh_instance) { # database handle (note, using singleton) still active.
    
    # If autocommit wasn't set, then this is a cancel operation.
    # If we've not disconnected from the sql db yet and if we've not committed
    # transactions yet, then cancel means we do a rollback here
    
    if($_dbh_instance->{AutoCommit} == 0) {
        print STDERR "   User cancelled: rolling back SQL database transaction.\n";
        $_dbh_instance->rollback(); # will warn on failure, nothing more we can/want to do,
    }
    }
    
    die "Caught a $sig signal $!"; # die() will always call destructor (sub DESTROY)
}

sub new
{  
    my $class = shift(@_);
    
    my ($params_map) = @_;
    
    # library_url: to be specified on the cmdline if not using a GS-included web server
    # the GSDL_LIBRARY_URL env var is useful when running cmdline buildcol.pl in the linux package manager versions of GS3
    
    # https://stackoverflow.com/questions/7083453/copying-a-hashref-in-perl 
    # Making a shallow copy works, and can handle unknown params:
    #my $self = $params_map;

    # but being explicit for class params needed for MySQL:
    my $self = {
    'collection_name' => $params_map->{'collection_name'},
    'verbosity' => $params_map->{'verbosity'} || 1
    };

    # The db_encoding option is presently not passed in to this constructor as parameter.
    # Placed here to indicate it's sort of optional.
    # Since docxml are all in utf8, the contents of the GS SQL database should be too,
    # So making utf8 the hidden default at present.
    $self->{'db_encoding'} = $params_map->{'db_encoding'} || "utf8";
    
    $self = bless($self, $class);    

    $self->{'tablename_prefix'} = $self->sanitize_name($params_map->{'collection_name'});
    
    return $self;
}

# On die(), an object's destructor is called. 
# See https://www.perl.com/article/37/2013/8/18/Catch-and-Handle-Signals-in-Perl/
# We want to ensure we've closed the db connection in such cases.
# "It’s common to call die when handling SIGINT and SIGTERM. die is useful because it will ensure that Perl stops correctly: for example Perl will execute a destructor method if present when die is called, but the destructor method will not be called if a SIGINT or SIGTERM is received and no signal handler calls die."
#
# Useful: https://perldoc.perl.org/perlobj.html#Destructors
# For more on when destroy is called, see https://www.perlmonks.org/?node_id=1020920
#
# https://metacpan.org/pod/release/TIMB/DBI-1.634_50/DBI.pm#disconnect
# "Disconnects the database from the database handle. disconnect is typically only used before exiting the program. The handle is of little use after disconnecting.
#
# The transaction behaviour of the disconnect method is, sadly, undefined. Some database systems (such as Oracle and Ingres) will automatically commit any outstanding changes, but others (such as Informix) will rollback any outstanding changes. Applications not using AutoCommit should explicitly call commit or rollback before calling disconnect.
#
# The database is automatically disconnected by the DESTROY method if still connected when there are no longer any references to the handle. The DESTROY method for each driver should implicitly call rollback to undo any uncommitted changes. This is vital behaviour to ensure that incomplete transactions don't get committed simply because Perl calls DESTROY on every object before exiting. Also, do not rely on the order of object destruction during "global destruction", as it is undefined.
#
# Generally, if you want your changes to be committed or rolled back when you disconnect, then you should explicitly call "commit" or "rollback" before disconnecting.
#
# If you disconnect from a database while you still have active statement handles (e.g., SELECT statement handles that may have more data to fetch), you will get a warning. The warning may indicate that a fetch loop terminated early, perhaps due to an uncaught error. To avoid the warning call the finish method on the active handles."
#
#
sub DESTROY {
    my $self = shift;
    
    if (${^GLOBAL_PHASE} eq 'DESTRUCT') {

    if ($_dbh_instance) { # database handle still active. Use singleton handle!
                          # dbh instance being active implies build was cancelled

        # rollback code has moved to finish_signal_handler() where it belongs
        # as rollback() should only happen on cancel/unnatural termination
        # vs commit() happening in finished() before disconnect, which is natural termination.

        
        # We're now finally ready to disconnect, as is required for both natural and premature termination
        # (Though natural termination would have disconnected already)
        # We now leave DBI's own destructor to do the disconnection when perl calls its DESTROY()
        # We'll just print a message to stop anyone from worrying whether cancelling build
        # will ensure disconnection still happens. It happens, but silently.
        print STDERR "   Global Destruct Phase: DBI's own destructor will disconnect database\n";
        #$_dbh_instance->disconnect or warn $_dbh_instance->errstr;
        #$_dbh_instance = undef;
        #$ref_count = 0;
    }
    return;
    }

    # "Always include a call to $self->SUPER::DESTROY in our destructors (even if we don't yet have any base/parent classes). (p. 145)"
    # Superclass and destroy, call to SUPER: https://www.perlmonks.org/?node_id=879920
    # discussion also covers multiple-inheritance (MI)    
    $self->SUPER::DESTROY if $self->can("SUPER::DESTROY");

}



################### BASIC DB OPERATIONS ##################

# THE NEW DB FUNCTIONS
# NOTE: FULLTEXT is a reserved keyword in (My)SQL. So we can't name a table or any of its columns "fulltext".
# https://dev.mysql.com/doc/refman/5.5/en/keywords.html



# SINGLETON / GET INSTANCE PATTERN
# https://stackoverflow.com/questions/16655603/perl-objects-class-variable-initialization
# https://stackoverflow.com/questions/7587157/how-can-i-set-a-static-variable-that-can-be-accessed-by-all-subclasses-of-the-sa
# Singleton without Moose: https://www.perl.com/article/52/2013/12/11/Implementing-the-singleton-pattern-in-Perl/

sub connect_to_db
{
    my $self= shift (@_);
    my ($params_map) = @_;
    
    $params_map->{'db_encoding'} = $self->{'db_encoding'};
    $params_map->{'verbosity'} = $self->{'verbosity'};
    
    $self->{'db_handle'} = &_get_connection_instance($params_map); # getting singleton (class method)
    if($self->{'db_handle'}) {
    $ref_count++; # if successful, keep track of the number of refs to the single db connection
    return $self->{'db_handle'};
    }
    return undef;
}

# SINGLETON METHOD #
# TODO: where should the defaults for these params be, here or in GS-SQLPlugin/Plugout?
sub _get_connection_instance
{
    #my $self= shift (@_); # singleton method doesn't use self, but callers don't need to know that
    my ($params_map) = @_;
    
    if($params_map->{'verbosity'}) {
    if(!defined $params_map->{'autocommit'}) {
        print STDERR "  Autocommit parameter not defined\n";
    }
    if($params_map->{'autocommit'}) {
        print STDERR "   SQL DB CANCEL SUPPORT OFF.\n" if($params_map->{'verbosity'} > 2);
    } else {
        print STDERR "   SQL DB CANCEL SUPPORT ON.\n";
    }
    }
    
    return $_dbh_instance if($_dbh_instance);

    # or make the connection
    
    # For proper utf8 support in MySQL, encoding should be 'utf8mb4' as 'utf8' is insufficient
    my $db_enc = "utf8mb4" if $params_map->{'db_encoding'} eq "utf8";

    # Params for connecting to MySQL
    # These params are ensured default/fallback values by the GS SQL Plugs
    # so no need to set it here
    my $db_driver = $params_map->{'db_driver'};
    my $db_host = $params_map->{'db_host'};
    my $db_user = $params_map->{'db_client_user'};

    # params that can be undef are db_client_pwd and db_port
    my $db_pwd = $params_map->{'db_client_pwd'}; # even if undef and password was necessary,
                                     # we'll see a sensible error message when connect fails
        # localhost doesn't work for us, but 127.0.0.1 works
        # https://metacpan.org/pod/DBD::mysql
        # "The hostname, if not specified or specified as '' or 'localhost', will default to a MySQL server
        # running on the local machine using the default for the UNIX socket. To connect to a MySQL server
        # on the local machine via TCP, you must specify the loopback IP address (127.0.0.1) as the host."
    my $db_port = $params_map->{'db_port'}; # leave as undef if unspecified,
                 # as our tests never used port anyway (must have internally
                 # defaulted to whatever default port is used for MySQL)

    
    #my $connect_str = "dbi:$db_driver:database=$db_name;host=$db_host";
    # But don't provide db now - this allows checking the db exists later when loading the db
    my $connect_str = "dbi:$db_driver:host=$db_host";
    $connect_str .= ";port=$db_port" if $db_port;

    if($params_map->{'verbosity'}) {
    print STDERR "Away to make connection to $db_driver database with:\n";
    print STDERR " - hostname $db_host; username: $db_user";
    print STDERR "; and the provided password" if $db_pwd;
    print STDERR "\nAssuming the mysql server has been started with: --character_set_server=utf8mb4\n" if $db_driver eq "mysql";
    }

    # DBI AutoCommit connection param is on/1 by default, so if a value for this is not defined
    # as a method parameter to _get_connection_instance, then fallback to the default of on/1
    # More: https://www.oreilly.com/library/view/programming-the-perl/1565926994/re44.html
    my $autocommit = (defined $params_map->{'autocommit'}) ? $params_map->{'autocommit'} : 1;
    
    my $dbh = DBI->connect("$connect_str", $db_user, $db_pwd,
               {
                   ShowErrorStatement => 1, # more informative as DBI will append failed SQL stmt to error message
                   PrintError => 1, # on by default, but being explicit
                   RaiseError => 0, # off by default, but being explicit
                   AutoCommit => $autocommit,
                   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 
               });

    if(!$dbh) {
    # NOTE, despite handle dbh being undefined, error code will be in DBI->err (note caps)
    return 0;   
    }

    # set encoding https://metacpan.org/pod/DBD::mysql
    # https://dev.mysql.com/doc/refman/5.7/en/charset.html
    # https://dev.mysql.com/doc/refman/5.7/en/charset-conversion.html
    # Setting the encoding at db server level: $dbh->do("set NAMES '" . $db_enc . "'");
    # HOWEVER:
    # It turned out insufficient setting the encoding to utf8, as that only supports utf8 chars that
    # need up to 3 bytes. We may need up to 4 bytes per utf8 character, e.g. chars with macron,
    # and for that, we need the encoding to be set to utf8mb4.
    # To set up a MySQL db to use utf8mb4 requires configuration on the server side too.
    # https://stackoverflow.com/questions/10957238/incorrect-string-value-when-trying-to-insert-utf-8-into-mysql-via-jdbc
    # https://stackoverflow.com/questions/46727362/perl-mysql-utf8mb4-issue-possible-bug
    # To set up the db for utf8mb4, therefore, 
    # the MySQL server needs to be configured for that char encoding by running the server as:
    # mysql-5.7.23-linux-glibc2.12-x86_64/bin>./mysqld_safe --datadir=/Scratch/ak19/mysql/data --character_set_server=utf8mb4
    # AND when connecting to the server, we can can either set mysql_enable_utf8mb4 => 1
    # as a connection option
    # OR we need to do both "set NAMES utf8mb4" AND "$dbh->{mysql_enable_utf8mb4} = 1;" after connecting
    #
    # Search results for DBI Set Names imply the "SET NAMES '<enc>'" command is mysql specific too,
    # so setting the mysql specific option during connection above as "mysql_enable_utf8mb4 => 1"
    # is no more objectionable. It has the advantage of cutting out the 2 extra lines of doing
    # set NAMES '<enc>' and $dbh->{mysql_enable_utf8mb4} = 1 here.
    # These lines may be preferred if more db_driver options are to be supported in future:
    # then a separate method called set_db_encoding($enc) can work out what db_driver we're using
    # and if mysql and enc=utfy, then it can do the following whereas it will issue other do stmts
    # for other db_drivers, see https://www.perlmonks.org/?node_id=259456:
    
    #my $stmt = "set NAMES '" . $db_enc . "'";
    #$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
    #$dbh->{mysql_enable_utf8mb4} = 1; # tells DBD::mysql to decode the data
    
    # if we're here, then connection succeeded, store handle
    $_dbh_instance = $dbh;
    return $_dbh_instance;
    
}

# Will disconnect if this instance of gsmysql holds the last reference to the db connection
# If disconnecting and autocommit is off, then this will commit before disconnecting
sub finished {
    my $self= shift (@_);
    my $dbh = $self->{'db_handle'};
    
    my $rc = 1; # return code: everything went fine, regardless of whether we needed to commit
                # (AutoCommit on or off)
    
    $ref_count--;
    if($ref_count == 0) { # Only commit transaction when we're about to actually disconnect, not before
    
    # + TODO: If AutoCommit was off, meaning transactions were on/enabled,
    # then here is where we commit our one long transaction.
    # https://metacpan.org/pod/release/TIMB/DBI-1.634_50/DBI.pm#commit
    if($dbh->{AutoCommit} == 0) {
        print STDERR "   Committing transaction to SQL database now.\n" if $self->{'verbosity'};
        $rc = $dbh->commit() or warn("SQL DB COMMIT FAILED: " . $dbh->errstr); # important problem
        # worth embellishing error message
    }
    # else if autocommit was on, then we'd have committed after every db operation, so nothing to do
    
    $self->_force_disconnect_from_db();
    }

    return $rc;
}


# Call this method on die(), so that you're sure the perl process has disconnected from SQL db
# Disconnect from db - https://metacpan.org/pod/DBI#disconnect
# TODO: make sure to have committed or rolled back before disconnect
# and that you've call finish() on statement handles if any fetch remnants remain
sub _force_disconnect_from_db {
    my $self= shift (@_);

    if($_dbh_instance) {
    # make sure any active stmt handles are finished
    # 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."
    
    print STDERR "    GSMySQL disconnecting from database\n" if $self->{'verbosity'};
    # Just go through the singleton db handle to disconnect
    $_dbh_instance->disconnect or warn $_dbh_instance->errstr;
    $_dbh_instance = undef;
    }
    # Number of gsmysql objects that share a live connection is now 0, as the connection's dead
    # either because the last gsmysql object finished() or because connection was killed (force)
    $ref_count = 0;
}


# Load the designated database, i.e. 'use <dbname>;'.
# If the database doesn't yet exist, creates it and loads it.
# (Don't create the collection's tables yet, though)
# At the end it will have loaded the requested database (in MySQL: "use <db>;") on success.
# As usual, returns success or failure value that can be evaluated in a boolean context.
sub use_db {
    my $self= shift (@_);
    my ($db_name) = @_;
    my $dbh = $self->{'db_handle'};
    $db_name = $self->sanitize_name($db_name);
    
    print STDERR "Attempting to use database $db_name\n" if($self->{'verbosity'});
    
    # perl DBI switch database: https://www.perlmonks.org/?node_id=995434
    # do() returns undef on error.
    # connection succeeded, try to load our database. If that didn't work, attempt to create db
    my $success = $dbh->do("use $db_name");
    
    if(!$success && $dbh->err == 1049) { # "Unknown database" error has code 1049 (mysql only?) meaning db doesn't exist yet

    print STDERR "Database $db_name didn't exist, creating it along with the tables for the current collection...\n" if($self->{'verbosity'});
    
    # attempt to create the db and its tables
    $self->create_db($db_name) || return 0;

    print STDERR "   Created database $db_name\n" if($self->{'verbosity'} > 1);
    
    # once more attempt to use db, now that it exists
    $dbh->do("use $db_name") || return 0;
    #$dbh->do("use $db_name") or die "Error (code" . $dbh->err ."): " . $dbh->errstr . "\n";

    $success = 1;
    }
    elsif($success) { # database existed and loaded successfully, but
    # before proceeding check that the current collection's tables exist

    print STDERR "@@@ DATABASE $db_name EXISTED\n" if($self->{'verbosity'} > 2);
    }
    
    return $success; # could still return 0, if database failed to load with an error code != 1049
}


# We should already have done "use <database>;" if this gets called.
# Just load this collection's metatable
sub ensure_meta_table_exists {
    my $self = shift (@_);
    
    my $tablename = $self->get_metadata_table_name();
    if(!$self->table_exists($tablename)) {
    $self->create_metadata_table() || return 0;
    } else {
    print STDERR "@@@ Meta table exists\n" if($self->{'verbosity'} > 2);
    }
    return 1;
}

# We should already have done "use <database>;" if this gets called.
# Just load this collection's metatable
sub ensure_fulltxt_table_exists {
    my $self = shift (@_);
    
    my $tablename = $self->get_fulltext_table_name();    
    if(!$self->table_exists($tablename)) {
    $self->create_fulltext_table() || return 0;
    } else {
    print STDERR "@@@ Fulltxt table exists\n" if($self->{'verbosity'} > 2);
    }
    return 1;
}


sub create_db {
    my $self= shift (@_);
    my ($db_name) = @_;
    my $dbh = $self->{'db_handle'};
    $db_name = $self->sanitize_name($db_name);
    
    # https://stackoverflow.com/questions/5025768/how-can-i-create-a-mysql-database-from-a-perl-script
    return $dbh->do("create database $db_name"); # do() will return undef on fail, https://metacpan.org/pod/DBI#do
}


sub create_metadata_table {
    my $self= shift (@_);
    my $dbh = $self->{'db_handle'};
    
    my $table_name = $self->get_metadata_table_name();
    print STDERR "   Creating table $table_name\n" if($self->{'verbosity'} > 1);
    
    # If using an auto incremented primary key:
    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));";
    return $dbh->do($stmt);
}

# TODO: Investigate: https://dev.mysql.com/doc/search/?d=10&p=1&q=FULLTEXT
# 12.9.1 Natural Language Full-Text Searches
# to see whether we have to index the 'fulltxt' column of the 'fulltext' tables
# or let user edit this file, or add it as another option
sub create_fulltext_table {
    my $self= shift (@_);
    my $dbh = $self->{'db_handle'};
    
    my $table_name = $self->get_fulltext_table_name();
    print STDERR "   Creating table $table_name\n" if($self->{'verbosity'} > 1);
    
    # If using an auto incremented primary key:
    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));";
    return $dbh->do($stmt);

}


sub delete_collection_tables {
    my $self= shift (@_);
    my $dbh = $self->{'db_handle'};

    # drop table <tablename>
    my $table = $self->get_metadata_table_name();
    if($self->table_exists($table)) {
    $dbh->do("drop table $table");# || warn("@@@ Couldn't delete $table");
    }
    $table = $self->get_fulltext_table_name();
    if($self->table_exists($table)) {
    $dbh->do("drop table $table");# || warn("@@@ Couldn't delete $table");
    }

    # + TODO Q: commit here, so that future select statements work?
    # See https://metacpan.org/pod/release/TIMB/DBI-1.634_50/DBI.pm#Transactions
}

# Don't call this: it will delete the meta and full text tables for ALL collections in $db_name (localsite by default)!
# This method is just here for debugging (for testing creating a database when there is none)
#
# "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"
# MySQL 8.0 Reference Manual :: 13.1.22 DROP DATABASE Syntax
# https://dev.mysql.com/doc/en/drop-database.html
sub _delete_database {
    my $self= shift (@_);
    my ($db_name) = @_;
    my $dbh = $self->{'db_handle'};
    $db_name = $self->sanitize_name($db_name);
    
    print STDERR "!!! Deleting database $db_name\n" if($self->{'verbosity'});
    
    # "drop database dbname"
    $dbh->do("drop database $db_name") || return 0;

    return 1;
}


########################### DB STATEMENTS ###########################

# USEFUL: https://metacpan.org/pod/DBI
# "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."

# More efficient to use prepare() to prepare an SQL statement once and then execute() it many times
# (binding different values to placeholders) than running do() which will prepare each time and
# execute each time. Also, do() is not useful with SQL select statements as it doesn't fetch rows.
# Can prepare and cache prepared statements or retrieve prepared statements if cached in one step:
# https://metacpan.org/pod/release/TIMB/DBI-1.634_50/DBI.pm#prepare_cached

# https://www.guru99.com/insert-into.html
# and https://dev.mysql.com/doc/refman/8.0/en/example-auto-increment.html
#     for inserting multiple rows at once
# https://www.perlmonks.org/bare/?node_id=316183
# https://metacpan.org/pod/DBI#do
# 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
# https://docstore.mik.ua/orelly/linux/dbi/ch05_05.htm

# https://metacpan.org/pod/DBI#performance
# '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.'
#
# This method uses lazy loading to prepare the SQL insert stmt once for a table and store it,
# then execute the (stored) statement each time it's needed for that table.
sub insert_row_into_metadata_table {
    my $self = shift (@_);
    my ($doc_oid, $section_name, $meta_name, $escaped_meta_value, $debug_only) = @_;
    
    my $dbh = $self->{'db_handle'};
    
    my $tablename = $self->get_metadata_table_name();
    my $sth = $dbh->prepare_cached(qq{INSERT INTO $tablename (did, sid, metaname, metavalue) VALUES (?, ?, ?, ?)});# || warn("Could not prepare insert statement for metadata table\n");

    # Now we're ready to execute the command, unless we're only debugging
    
    if($debug_only) {
    # just print the statement we were going to execute
    print STDERR $sth->{'Statement'} . "($doc_oid, $section_name, $meta_name, $escaped_meta_value)\n";
    }
    else {
    print STDERR $sth->{'Statement'} . "($doc_oid, $section_name, $meta_name, $escaped_meta_value)\n" if $self->{'verbosity'} > 2;
    
    $sth->execute($doc_oid, $section_name, $meta_name, $escaped_meta_value)
        || warn ("Unable to write metadata row to db:\n\tOID $doc_oid, section $section_name,\n\tmeta name: $meta_name, val: $escaped_meta_value");
    # Execution failure will print out info anyway: since db connection sets PrintError
    }
}

# As above. Likewise uses lazy loading to prepare the SQL insert stmt once for a table and store it,
# then execute the (stored) statement each time it's needed for that table.
sub insert_row_into_fulltxt_table {
    my $self = shift (@_);
    #my ($did, $sid, $fulltext) = @_;
    my ($doc_oid, $section_name, $section_textref, $debug_only) = @_;
    
    my $dbh = $self->{'db_handle'};
    
    my $tablename = $self->get_fulltext_table_name();
    my $sth = $dbh->prepare_cached(qq{INSERT INTO $tablename (did, sid, fulltxt) VALUES (?, ?, ?)});# || warn("Could not prepare insert statement for fulltxt table\n");
    
    # Now we're ready to execute the command, unless we're only debugging

    # don't display the fulltxt value as it could be too long
    my $txt_repr = $$section_textref ? "<TXT>" : "NULL";    
    if($debug_only) { # only print statement, don't execute it
    print STDERR $sth->{'Statement'} . "($doc_oid, $section_name, $txt_repr)\n";
    }
    else {  
    print STDERR $sth->{'Statement'} . "($doc_oid, $section_name, $txt_repr)\n" if $self->{'verbosity'} > 2;
    
    $sth->execute($doc_oid, $section_name, $$section_textref)
        || warn ("Unable to write fulltxt row to db for row:\n\tOID $doc_oid, section $section_name"); # Execution failure will print out info anyway: since db connection sets PrintError
    }
}


## The 2 select statements used by GreenstoneSQLPlugin

# Using fetchall_arrayref on statement handle, to run on prepared and executed stmt
#   https://metacpan.org/pod/release/TIMB/DBI-1.634_50/DBI.pm#fetchall_arrayref
# instead of selectall_arrayref on database handle which will prepare, execute and fetch
#   https://metacpan.org/pod/release/TIMB/DBI-1.634_50/DBI.pm#selectall_arrayref
#
# Returns the statement handle that prepared and executed
# a "SELECT * FROM <COLL>_metadata WHERE did = $oid" SQL statement.
# Caller can call fetchrow_array() on returned statement handle, $sth
# Have to use prepare() and execute() instead of do() since do() does
# not allow for fetching result set thereafter:
# 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
sub select_from_metatable_matching_docid {
    my $self= shift (@_);
    my ($oid, $outhandle) = @_;
    
    my $dbh = $self->{'db_handle'};
    my $tablename = $self->get_metadata_table_name();
    
    my $sth = $dbh->prepare_cached(qq{SELECT * FROM $tablename WHERE did = ?});
    $sth->execute( $oid ); # will print msg on fail

    print $outhandle "### SQL select stmt: ".$sth->{'Statement'}."\n"
    if ($self->{'verbosity'} > 2);
    
    my $rows_ref = $sth->fetchall_arrayref();
    # "If an error occurs, fetchall_arrayref returns the data fetched thus far, which may be none.
    # You should check $sth->err afterwards (or use the RaiseError attribute) to discover if the
    # data is complete or was truncated due to an error."
    # https://metacpan.org/pod/release/TIMB/DBI-1.634_50/DBI.pm#fetchall_arrayref
    # https://www.oreilly.com/library/view/programming-the-perl/1565926994/ch04s05.html
    warn("Data fetching from $tablename terminated early by error: " . $dbh->err) if $dbh->err;
    return $rows_ref;
}


# See select_from_metatable_matching_docid() above.
# Returns the statement handle that prepared and executed
# a "SELECT * FROM <COLL>_metadata WHERE did = $oid" SQL statement.
# Caller can call fetchrow_array() on returned statement handle, $sth
sub select_from_texttable_matching_docid {
    my $self= shift (@_);
    my ($oid, $outhandle) = @_;
    
    my $dbh = $self->{'db_handle'};
    my $tablename = $self->get_fulltext_table_name();
    
    my $sth = $dbh->prepare_cached(qq{SELECT * FROM $tablename WHERE did = ?});
    $sth->execute( $oid ); # will print msg on fail
    
    print $outhandle "### SQL select stmt: ".$sth->{'Statement'}."\n"
    if ($self->{'verbosity'} > 2);
    
    my $rows_ref = $sth->fetchall_arrayref();
    # Need explicit warning:
    warn("Data fetching from $tablename terminated early by error: " . $dbh->err) if $dbh->err;
    return $rows_ref;

}

# delete all records in metatable with specified docid
# https://www.tutorialspoint.com/mysql/mysql-delete-query.htm
# DELETE FROM table_name [WHERE Clause]
# see example under 'do' at https://metacpan.org/pod/release/TIMB/DBI-1.634_50/DBI.pm
sub delete_recs_from_metatable_with_docid {
    my $self= shift (@_);
    my ($oid) = @_;
    
    my $dbh = $self->{'db_handle'};

    my $tablename = $self->get_metadata_table_name();
    my $sth = $dbh->prepare_cached(qq{DELETE FROM $tablename WHERE did = ?});
    $sth->execute( $oid ) or warn $dbh->errstr; # dbh set to print errors even without doing warn()
}

# delete all records in metatable with specified docid
sub delete_recs_from_texttable_with_docid {
    my $self= shift (@_);
    my ($oid) = @_;
    
    my $dbh = $self->{'db_handle'};

    my $tablename = $self->get_fulltext_table_name();
    my $sth = $dbh->prepare_cached(qq{DELETE FROM $tablename WHERE did = ?});
    $sth->execute( $oid ) or warn $dbh->errstr; # dbh set to print errors even without doing warn()
}

# Can call this after connection succeeded to get the database handle, dbh,
# if any specific DB operation (SQL statement, create/delete)
# needs to be executed that is not already provided as a method of this class.
sub get_db_handle {
    my $self= shift (@_);
    return $self->{'db_handle'};
}

################ HELPER METHODS ##############

# More basic helper methods
sub get_metadata_table_name {
    my $self= shift (@_);
    my $table_name = $self->{'tablename_prefix'} . "_metadata";
    return $table_name;
}

# FULLTEXT is a reserved keyword in (My)SQL. https://dev.mysql.com/doc/refman/5.5/en/keywords.html
# So we can't name a table or any of its columns "fulltext". We use "fulltxt" instead.
sub get_fulltext_table_name {
    my $self= shift (@_);
    my $table_name = $self->{'tablename_prefix'} . "_fulltxt";
    return $table_name;
}

# Attempt to make sure the name parameter (for db or table name) is acceptable syntax
# for the db in question, e.g. for mysql. For example, (My)SQL doesn't like tables or
# databases with '-' (hyphens) in their names
sub sanitize_name {
    my $self= shift (@_);
    my ($name) = @_;
    $name =~ s/-/_/g;
    return $name;
}


# I can get my version of table_exists to work, but it's not so ideal
# Interesting that MySQL has non-standard command to CREATE TABLE IF NOT EXISTS and DROP TABLE IF EXISTS, 
# see https://www.perlmonks.org/bare/?node=DBI%20Recipes
#    The page further has a table_exists function that could work with proper comparison
# TODO Q: Couldn't get the first solution at https://www.perlmonks.org/bare/?node_id=500050 to work though
sub table_exists {
    my $self = shift (@_);
    my $dbh = $self->{'db_handle'};
    my ($table_name) = @_;

    my @table_list = $dbh->tables;
    #my $tables_str = @table_list[0];
    foreach my $table (@table_list) {
    return 1 if ($table =~ m/$table_name/);
    }
    return 0;
}

1;