Changeset 32578 for main/trunk/greenstone2/perllib

Timestamp:

2018-11-06T19:26:08+13:00 (5 years ago)

Author:

ak19

Message:

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

Location:

main/trunk/greenstone2/perllib

Files:

• gssql.pm (modified) (7 diffs)
• plugins/GreenstoneSQLPlugin.pm (modified) (4 diffs)
• plugouts/GreenstoneSQLPlugout.pm (modified) (3 diffs)

main/trunk/greenstone2/perllib/gssql.pm

@@ -33 +33 @@
 use DBI; # the central package for this module used by GreenstoneSQL Plugout and Plugin
 
+# 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
@@ -49 +53 @@
 # 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
+# https://perldoc.perl.org/perlobj.html#Destructors
+
+# 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?
+
 sub new
 {  
@@ -80 +90 @@
     return $self;
 }
+
 
 
@@ -109 +120 @@
 # TODO: Consider AutoCommit status (and Autocommit off allowing commit or rollback for GS coll build cancel) later
 
+
+
+# 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 connect_to_db {
-    my $self= shift (@_);
+sub _get_connection_instance
+{
+    #my $self= shift (@_); # singleton method doesn't use self, but callers don't need to know that
     my ($params_map) = @_;
+
+    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 $self->{'db_encoding'} eq "utf8";
+    my $db_enc = "utf8mb4" if $params_map->{'db_encoding'} eq "utf8";
 
     # these are the params for connecting to MySQL
@@ -130 +171 @@
     my $connect_str = "dbi:$db_driver:host=$db_host"; # don't provide db - allows checking the db exists later when loading the db
 
-    if($self->{'verbosity'}) {
+    if($params_map->{'verbosity'}) {
     print STDERR "Away to make connection to $db_driver database with:\n";
     print STDERR " - hostname $db_host; username: $db_user";
@@ -183 +224 @@
     
     # if we're here, then connection succeeded, store handle
-    $self->{'db_handle'} = $dbh;
-    return 1;
-}
+    $_dbh_instance = $dbh;
+    return $_dbh_instance;
+    
+}
+
+# Will disconnect if this instance of gssql holds the last reference to the db connection
+sub finished() {
+    my $self= shift (@_);
+
+    $ref_count--;
+    if($ref_count == 0) {
+    $self->force_disconnect_from_db();
+    }    
+}
+
+# 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 "    GSSQL disconnecting from database\n";
+    # Just go through the singleton db handle to disconnect
+    $_dbh_instance->disconnect or warn $_dbh_instance->errstr;
+    $_dbh_instance = undef;
+    }
+    # Number of gssql objects that share a live connection is now 0, as the connection's dead
+    # either because the last gssql object finished() or because connection was killed (force)
+    $ref_count = 0;
+}
+
 
 # Load the designated database, i.e. 'use <dbname>;'.
@@ -260 +334 @@
 }
 
-# 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 disconnect_from_db {
-    my $self= shift (@_);    
-    my $dbh = $self->{'db_handle'};
-
-    # 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 "Disconnecting from database\n" if($self->{'verbosity'} > 1);
-    
-    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?
-    return $rc;
-}
 
 sub create_db {

main/trunk/greenstone2/perllib/plugins/GreenstoneSQLPlugin.pm

@@ -250 +250 @@
     #return undef unless $self->can_process_this_file($file); # NO, DON'T DO THIS (inherited remove_one behaviour) HERE: 
            # WE DON'T CARE IF IT'S AN IMAGE FILE THAT WAS DELETED.
-           # WE CARE ABOUT REMOVING THE DOCOID OF THAT IMAGE FILE FROM THE SQL DB
+           # WE CARE ABOUT REMOVING THE DOC_OID OF THAT IMAGE FILE FROM THE SQL DB
            # SO DON'T RETURN IF CAN'T_PROCESS_THIS_FILE
     
@@ -430 +430 @@
                });
 
-    # try connecting to the mysql db, if that fails it will die
+    # try connecting to the mysql db, die if that fails
     if(!$gs_sql->connect_to_db({
     'db_driver' => $self->{'db_driver'},
@@ -452 +452 @@
     # This is fatal for the plugout, let's terminate here after disconnecting again
     # PrintError would already have displayed the warning message on load fail
-    $gs_sql->disconnect_from_db()
-        || warn("Unable to disconnect from database.\n");
+    $gs_sql->force_disconnect_from_db();
     die("Could not use db $db_name. Can't proceed.\n");
     }
@@ -475 +474 @@
     if($self->{'gs_sql'}) { # only want to work with sql db if buildcol.pl, gs_sql won't have
     # a value except during buildcol, so when processor =~ m/buildproc$/.
-    $self->{'gs_sql'}->disconnect_from_db()
-        || warn("Unable to disconnect from database " . $self->{'site_name'} . "\n");
-
-    # explicitly delete gs_sql key (setting key to undef has a different meaning from deleting)
-    # so all future use has to make the connection again
+    $self->{'gs_sql'}->finished();
+
+    # Clear gs_sql (setting key to undef has a different meaning from deleting:
+    # undef makes key still exist but its value is unded whereas delete deletes the key)
+    # So all future use has to make the connection again
     delete $self->{'gs_sql'};
     }

main/trunk/greenstone2/perllib/plugouts/GreenstoneSQLPlugout.pm

@@ -143 +143 @@
     my $db_params = {
     'collection_name' => $ENV{'GSDLCOLLECTION'},
-    'verbosity' => 1    
+    'verbosity' => 1
     };
 
     my $gs_sql = new gssql($db_params);
     
-    # try connecting to the mysql db, if that fails it will die
-    # so don't bother preparing GreenstoneXMLPlugout by calling superclass' begin()
+    # try connecting to the mysql db, die if that fails
+    # So don't bother preparing GreenstoneXMLPlugout by calling superclass' begin() yet
     if(!$gs_sql->connect_to_db({
     'db_driver' => $self->{'db_driver'},
@@ -181 +181 @@
     # This is fatal for the plugout, let's terminate here after disconnecting again
     # PrintError would already have displayed the warning message on load fail
-    $gs_sql->disconnect_from_db()
-        || warn("Unable to disconnect from database.\n");
+    $gs_sql->force_disconnect_from_db(); # disconnect_from_db() will issue a warning on error
     die("Could not use db $db_name and/or prepare its tables. Can't proceed.\n");
     }
@@ -205 +204 @@
     $self->SUPER::end(@_);    
     
-    $self->{'gs_sql'}->disconnect_from_db() || warn("Unable to disconnect from database " . $self->{'site_name'} . "\n"); # disconnect_from_db() will also issue a warning, but this may be clearer
+    $self->{'gs_sql'}->finished(); # will disconnect from db if last instance
+    delete $self->{'gs_sql'}; # key gs_sql no longer exists, not just the value being undef
 }