Changeset 32578 for main/trunk/greenstone2/perllib/gssql.pm
- Timestamp:
- 2018-11-06T19:26:08+13:00 (5 years ago)
- File:
-
- 1 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 {
Note:
See TracChangeset
for help on using the changeset viewer.