Changeset 32578 for main/trunk
- Timestamp:
- 2018-11-06T19:26:08+13:00 (5 years ago)
- Location:
- main/trunk/greenstone2/perllib
- Files:
-
- 3 edited
Legend:
- Unmodified
- Added
- Removed
-
main/trunk/greenstone2/perllib/gssql.pm
r32576 r32578 33 33 use DBI; # the central package for this module used by GreenstoneSQL Plugout and Plugin 34 34 35 # singleton connection 36 my $_dbh_instance = undef; # calls undef() function. See https://perlmaven.com/undef-and-defined-in-perl 37 my $ref_count = 0; 38 35 39 # Need params_map keys: 36 40 # - collection_name … … 49 53 # For port, see https://stackoverflow.com/questions/2248665/perl-script-to-connect-to-mysql-server-port-3307 50 54 55 # TODO: remove unnecessary warn() since PrintError is active 56 # https://perldoc.perl.org/perlobj.html#Destructors 57 58 # TODO: drop table if exists and create table if exists are available in MySQL. Use those cmds 59 # instead of always first checking for existence ourselves? 60 51 61 sub new 52 62 { … … 80 90 return $self; 81 91 } 92 82 93 83 94 … … 109 120 # TODO: Consider AutoCommit status (and Autocommit off allowing commit or rollback for GS coll build cancel) later 110 121 122 123 124 # SINGLETON / GET INSTANCE PATTERN 125 # https://stackoverflow.com/questions/16655603/perl-objects-class-variable-initialization 126 # https://stackoverflow.com/questions/7587157/how-can-i-set-a-static-variable-that-can-be-accessed-by-all-subclasses-of-the-sa 127 # Singleton without Moose: https://www.perl.com/article/52/2013/12/11/Implementing-the-singleton-pattern-in-Perl/ 128 129 sub connect_to_db 130 { 131 my $self= shift (@_); 132 my ($params_map) = @_; 133 134 $params_map->{'db_encoding'} = $self->{'db_encoding'}; 135 $params_map->{'verbosity'} = $self->{'verbosity'}; 136 137 $self->{'db_handle'} = &_get_connection_instance($params_map); # getting singleton (class method) 138 if($self->{'db_handle'}) { 139 $ref_count++; # if successful, keep track of the number of refs to the single db connection 140 return $self->{'db_handle'}; 141 } 142 return undef; 143 } 144 145 # SINGLETON METHOD # 111 146 # TODO: where should the defaults for these params be, here or in GS-SQLPlugin/Plugout? 112 sub connect_to_db { 113 my $self= shift (@_); 147 sub _get_connection_instance 148 { 149 #my $self= shift (@_); # singleton method doesn't use self, but callers don't need to know that 114 150 my ($params_map) = @_; 151 152 return $_dbh_instance if($_dbh_instance); 153 154 # or make the connection 155 115 156 # For proper utf8 support in MySQL, encoding should be 'utf8mb4' as 'utf8' is insufficient 116 my $db_enc = "utf8mb4" if $ self->{'db_encoding'} eq "utf8";157 my $db_enc = "utf8mb4" if $params_map->{'db_encoding'} eq "utf8"; 117 158 118 159 # 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 131 172 132 if($ self->{'verbosity'}) {173 if($params_map->{'verbosity'}) { 133 174 print STDERR "Away to make connection to $db_driver database with:\n"; 134 175 print STDERR " - hostname $db_host; username: $db_user"; … … 183 224 184 225 # if we're here, then connection succeeded, store handle 185 $self->{'db_handle'} = $dbh; 186 return 1; 187 } 226 $_dbh_instance = $dbh; 227 return $_dbh_instance; 228 229 } 230 231 # Will disconnect if this instance of gssql holds the last reference to the db connection 232 sub finished() { 233 my $self= shift (@_); 234 235 $ref_count--; 236 if($ref_count == 0) { 237 $self->force_disconnect_from_db(); 238 } 239 } 240 241 # Call this method on die(), so that you're sure the perl process has disconnected from SQL db 242 # Disconnect from db - https://metacpan.org/pod/DBI#disconnect 243 # TODO: make sure to have committed or rolled back before disconnect 244 # and that you've call finish() on statement handles if any fetch remnants remain 245 sub force_disconnect_from_db { 246 my $self= shift (@_); 247 248 if($_dbh_instance) { 249 # make sure any active stmt handles are finished 250 # 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." 251 252 print STDERR " GSSQL disconnecting from database\n"; 253 # Just go through the singleton db handle to disconnect 254 $_dbh_instance->disconnect or warn $_dbh_instance->errstr; 255 $_dbh_instance = undef; 256 } 257 # Number of gssql objects that share a live connection is now 0, as the connection's dead 258 # either because the last gssql object finished() or because connection was killed (force) 259 $ref_count = 0; 260 } 261 188 262 189 263 # Load the designated database, i.e. 'use <dbname>;'. … … 260 334 } 261 335 262 # disconnect from db - https://metacpan.org/pod/DBI#disconnect263 # TODO: make sure to have committed or rolled back before disconnect264 # and that you've call finish() on statement handles if any fetch remnants remain265 sub disconnect_from_db {266 my $self= shift (@_);267 my $dbh = $self->{'db_handle'};268 269 # make sure any active stmt handles are finished270 # NO: "When all the data has been fetched from a SELECT statement, the driver will automatically call finish for you. So you should not call it explicitly except when you know that you've not fetched all the data from a statement handle and the handle won't be destroyed soon."271 272 print STDERR "Disconnecting from database\n" if($self->{'verbosity'} > 1);273 274 my $rc = $dbh->disconnect or warn $dbh->errstr; # The handle is of little use after disconnecting. Possibly PrintError already prints a warning and this duplicates it?275 return $rc;276 }277 336 278 337 sub create_db { -
main/trunk/greenstone2/perllib/plugins/GreenstoneSQLPlugin.pm
r32577 r32578 250 250 #return undef unless $self->can_process_this_file($file); # NO, DON'T DO THIS (inherited remove_one behaviour) HERE: 251 251 # WE DON'T CARE IF IT'S AN IMAGE FILE THAT WAS DELETED. 252 # WE CARE ABOUT REMOVING THE DOC OID OF THAT IMAGE FILE FROM THE SQL DB252 # WE CARE ABOUT REMOVING THE DOC_OID OF THAT IMAGE FILE FROM THE SQL DB 253 253 # SO DON'T RETURN IF CAN'T_PROCESS_THIS_FILE 254 254 … … 430 430 }); 431 431 432 # try connecting to the mysql db, if that fails it will die432 # try connecting to the mysql db, die if that fails 433 433 if(!$gs_sql->connect_to_db({ 434 434 'db_driver' => $self->{'db_driver'}, … … 452 452 # This is fatal for the plugout, let's terminate here after disconnecting again 453 453 # PrintError would already have displayed the warning message on load fail 454 $gs_sql->disconnect_from_db() 455 || warn("Unable to disconnect from database.\n"); 454 $gs_sql->force_disconnect_from_db(); 456 455 die("Could not use db $db_name. Can't proceed.\n"); 457 456 } … … 475 474 if($self->{'gs_sql'}) { # only want to work with sql db if buildcol.pl, gs_sql won't have 476 475 # a value except during buildcol, so when processor =~ m/buildproc$/. 477 $self->{'gs_sql'}-> disconnect_from_db()478 || warn("Unable to disconnect from database " . $self->{'site_name'} . "\n"); 479 480 # explicitly delete gs_sql key (setting key to undef has a different meaning from deleting)481 # so all future use has to make the connection again476 $self->{'gs_sql'}->finished(); 477 478 # Clear gs_sql (setting key to undef has a different meaning from deleting: 479 # undef makes key still exist but its value is unded whereas delete deletes the key) 480 # So all future use has to make the connection again 482 481 delete $self->{'gs_sql'}; 483 482 } -
main/trunk/greenstone2/perllib/plugouts/GreenstoneSQLPlugout.pm
r32573 r32578 143 143 my $db_params = { 144 144 'collection_name' => $ENV{'GSDLCOLLECTION'}, 145 'verbosity' => 1 145 'verbosity' => 1 146 146 }; 147 147 148 148 my $gs_sql = new gssql($db_params); 149 149 150 # try connecting to the mysql db, if that fails it will die151 # so don't bother preparing GreenstoneXMLPlugout by calling superclass' begin()150 # try connecting to the mysql db, die if that fails 151 # So don't bother preparing GreenstoneXMLPlugout by calling superclass' begin() yet 152 152 if(!$gs_sql->connect_to_db({ 153 153 'db_driver' => $self->{'db_driver'}, … … 181 181 # This is fatal for the plugout, let's terminate here after disconnecting again 182 182 # PrintError would already have displayed the warning message on load fail 183 $gs_sql->disconnect_from_db() 184 || warn("Unable to disconnect from database.\n"); 183 $gs_sql->force_disconnect_from_db(); # disconnect_from_db() will issue a warning on error 185 184 die("Could not use db $db_name and/or prepare its tables. Can't proceed.\n"); 186 185 } … … 205 204 $self->SUPER::end(@_); 206 205 207 $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 206 $self->{'gs_sql'}->finished(); # will disconnect from db if last instance 207 delete $self->{'gs_sql'}; # key gs_sql no longer exists, not just the value being undef 208 208 } 209 209
Note:
See TracChangeset
for help on using the changeset viewer.