| 1 | ###########################################################################
|
|---|
| 2 | #
|
|---|
| 3 | # GreenstoneSQLPlugout.pm -- plugout module for writing all or some the
|
|---|
| 4 | # Greenstone document format (metadata and/or fulltext) into a (My)SQL db.
|
|---|
| 5 | # The rest is then still written out by GreenstoneXMLPlugout as usual.
|
|---|
| 6 | # A component of the Greenstone digital library software
|
|---|
| 7 | # from the New Zealand Digital Library Project at the
|
|---|
| 8 | # University of Waikato, New Zealand.
|
|---|
| 9 | #
|
|---|
| 10 | # Copyright (C) 2006 New Zealand Digital Library Project
|
|---|
| 11 | #
|
|---|
| 12 | # This program is free software; you can redistribute it and/or modify
|
|---|
| 13 | # it under the terms of the GNU General Public License as published by
|
|---|
| 14 | # the Free Software Foundation; either version 2 of the License, or
|
|---|
| 15 | # (at your option) any later version.
|
|---|
| 16 | #
|
|---|
| 17 | # This program is distributed in the hope that it will be useful,
|
|---|
| 18 | # but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|---|
| 19 | # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|---|
| 20 | # GNU General Public License for more details.
|
|---|
| 21 | #
|
|---|
| 22 | # You should have received a copy of the GNU General Public License
|
|---|
| 23 | # along with this program; if not, write to the Free Software
|
|---|
| 24 | # Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
|
|---|
| 25 | #
|
|---|
| 26 | ###########################################################################
|
|---|
| 27 |
|
|---|
| 28 | package GreenstoneSQLPlugout;
|
|---|
| 29 |
|
|---|
| 30 | use strict;
|
|---|
| 31 | no strict 'refs';
|
|---|
| 32 | no strict 'subs';
|
|---|
| 33 |
|
|---|
| 34 | use util;
|
|---|
| 35 | use FileUtils;
|
|---|
| 36 | use GreenstoneXMLPlugout;
|
|---|
| 37 | use docprint;
|
|---|
| 38 |
|
|---|
| 39 | use DBI; # the central package for this plugout
|
|---|
| 40 |
|
|---|
| 41 | use IPC::Open2;
|
|---|
| 42 | use POSIX ":sys_wait_h"; # for waitpid, http://perldoc.perl.org/functions/waitpid.html
|
|---|
| 43 |
|
|---|
| 44 |
|
|---|
| 45 | # TODO: SIGTERM rollback and disconnect?
|
|---|
| 46 |
|
|---|
| 47 | # TODO: rename class to GreenstoneSQLPlugout
|
|---|
| 48 |
|
|---|
| 49 |
|
|---|
| 50 | # this plugout does not output xml to a file, but outputs rows into a mysql table
|
|---|
| 51 | sub BEGIN {
|
|---|
| 52 | @GreenstoneSQLPlugout::ISA = ('GreenstoneXMLPlugout');
|
|---|
| 53 | }
|
|---|
| 54 |
|
|---|
| 55 |
|
|---|
| 56 | # TODO: deal with -removeold and everything? Or type out instructions for user
|
|---|
| 57 |
|
|---|
| 58 | # TODO Q: what is "group" in GreenstoneXMLPlugout?
|
|---|
| 59 | # TODO Q: site_name only exists for GS3. What about GS2?
|
|---|
| 60 |
|
|---|
| 61 | my $process_mode_list =
|
|---|
| 62 | [ { 'name' => "meta_only",
|
|---|
| 63 | 'desc' => "{GreenstoneSQLPlugout.process_mode.meta_only}" },
|
|---|
| 64 | { 'name' => "text_only",
|
|---|
| 65 | 'desc' => "{GreenstoneSQLPlugout.process_mode.text_only}" },
|
|---|
| 66 | { 'name' => "all",
|
|---|
| 67 | 'desc' => "{GreenstoneSQLPlugout.process_mode.all}" } ];
|
|---|
| 68 |
|
|---|
| 69 | my $arguments = [
|
|---|
| 70 | { 'name' => "process_mode",
|
|---|
| 71 | 'desc' => "{GreenstoneSQLPlugout.process_mode}",
|
|---|
| 72 | 'type' => "enum",
|
|---|
| 73 | 'list' => $process_mode_list,
|
|---|
| 74 | 'deft' => "all",
|
|---|
| 75 | 'reqd' => "no",
|
|---|
| 76 | 'hiddengli' => "no"} ];
|
|---|
| 77 |
|
|---|
| 78 | my $options = { 'name' => "GreenstoneSQLPlugout",
|
|---|
| 79 | 'desc' => "{GreenstoneSQLPlugout.desc}",
|
|---|
| 80 | 'abstract' => "no",
|
|---|
| 81 | 'inherits' => "yes",
|
|---|
| 82 | 'args' => $arguments };
|
|---|
| 83 |
|
|---|
| 84 | sub new {
|
|---|
| 85 | my ($class) = shift (@_);
|
|---|
| 86 | my ($plugoutlist, $inputargs,$hashArgOptLists) = @_;
|
|---|
| 87 | push(@$plugoutlist, $class);
|
|---|
| 88 |
|
|---|
| 89 | push(@{$hashArgOptLists->{"ArgList"}},@{$arguments});
|
|---|
| 90 | push(@{$hashArgOptLists->{"OptList"}},$options);
|
|---|
| 91 |
|
|---|
| 92 | my $self = new GreenstoneXMLPlugout($plugoutlist,$inputargs,$hashArgOptLists);
|
|---|
| 93 |
|
|---|
| 94 | if ($self->{'info_only'}) {
|
|---|
| 95 | # don't worry about any options etc
|
|---|
| 96 | return bless $self, $class;
|
|---|
| 97 | }
|
|---|
| 98 | print STDERR "***** GreenstoneSQLPlugout process mode = \"", $self->{'process_mode'}, "\"\n";
|
|---|
| 99 |
|
|---|
| 100 | return bless $self, $class;
|
|---|
| 101 | }
|
|---|
| 102 |
|
|---|
| 103 | # connect here and ensure all tables and databases exist
|
|---|
| 104 | sub begin {
|
|---|
| 105 |
|
|---|
| 106 | my $self= shift (@_);
|
|---|
| 107 |
|
|---|
| 108 | ########### TODO: these should be set from cmdline/GLI options to plugout #########
|
|---|
| 109 | $self->{'db_driver'} = "mysql";
|
|---|
| 110 | $self->{'site_name'} = "localsite";
|
|---|
| 111 | $self->{'db_client_user'} = "root";
|
|---|
| 112 | $self->{'db_client_pwd'} = "6reenstone3";
|
|---|
| 113 | $self->{'build_mode'} = "removeold";
|
|---|
| 114 | #$self->{'db_host'} = "127.0.0.1";
|
|---|
| 115 | #$self->{'db_encoding'} = "utf8";
|
|---|
| 116 | #TODO: proc_mode is also a saveas option
|
|---|
| 117 |
|
|---|
| 118 | ############ LOAD NECESSARY OPTIONS ###########
|
|---|
| 119 | print STDERR "########## COLLECTION: ". $ENV{'GSDLCOLLECTION'}."\n";
|
|---|
| 120 | $self->{'collection_name'} = $ENV{'GSDLCOLLECTION'};
|
|---|
| 121 | print STDERR "***** GreenstoneSQLPlugout process mode = \"", $self->{'process_mode'}, "\"\n";
|
|---|
| 122 |
|
|---|
| 123 | if(!$self->connect_to_db()) {
|
|---|
| 124 | # This is fatal for the plugout, let's terminate here
|
|---|
| 125 | # PrintError would already have displayed the warning message on connection fail
|
|---|
| 126 | die("Could not connect to db. Can't proceed.\n");
|
|---|
| 127 | }
|
|---|
| 128 |
|
|---|
| 129 | my $db_name = $self->{'site_name'} || "localsite"; # one database per GS3 site
|
|---|
| 130 | my $build_mode = $self->{'build_mode'} || "removeold";
|
|---|
| 131 | if(!$self->load_db_and_tables($db_name, $build_mode)) {
|
|---|
| 132 |
|
|---|
| 133 | # This is fatal for the plugout, let's terminate here
|
|---|
| 134 | # PrintError would already have displayed the warning message on connection fail
|
|---|
| 135 | die("Could not use db or prepare its tables. Can't proceed.\n");
|
|---|
| 136 | }
|
|---|
| 137 |
|
|---|
| 138 | # prepare the shared/common HANDLES to SQL insert statements that contain placeholders
|
|---|
| 139 | # and which we will reuse repeatedly when actually executing the insert statements
|
|---|
| 140 | my $proc_mode = $self->{'process_mode'};
|
|---|
| 141 | if($proc_mode eq "all" || $proc_mode eq "meta_only" ) {
|
|---|
| 142 | $self->{'metadata_prepared_insert_statement_handle'} = $self->prepare_insert_metadata_row_stmthandle();
|
|---|
| 143 | }
|
|---|
| 144 | if($proc_mode eq "all" || $proc_mode eq "text_only" ) {
|
|---|
| 145 | $self->{'fulltxt_prepared_insert_statement_handle'} = $self->prepare_insert_fulltxt_row_stmthandle();
|
|---|
| 146 | }
|
|---|
| 147 |
|
|---|
| 148 | print STDERR "#### Meta stmt: " . $self->{'metadata_prepared_insert_statement_handle'}->{'Statement'} . "\n";
|
|---|
| 149 | print STDERR "#### Full stmt: " . $self->{'fulltxt_prepared_insert_statement_handle'}->{'Statement'} . "\n";
|
|---|
| 150 |
|
|---|
| 151 | # if setting up to work with sql db failed, we'd have terminated and wouldn't come up to here:
|
|---|
| 152 | # won't bother preparing GreenstoneXMLPlugout by calling superclass' begin()
|
|---|
| 153 | # finally, can call begin on super - important as doc.xml is opened as a group etc
|
|---|
| 154 |
|
|---|
| 155 | $self->SUPER::begin(@_);
|
|---|
| 156 | }
|
|---|
| 157 |
|
|---|
| 158 | # disconnect from database here, see inexport.pm
|
|---|
| 159 | sub end
|
|---|
| 160 | {
|
|---|
| 161 | my $self = shift(@_);
|
|---|
| 162 |
|
|---|
| 163 | # do the superclass stuff first, as any sql db failures should not prevent superclass cleanup
|
|---|
| 164 | $self->SUPER::end(@_);
|
|---|
| 165 |
|
|---|
| 166 | $self->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
|
|---|
| 167 | }
|
|---|
| 168 |
|
|---|
| 169 |
|
|---|
| 170 | # TODO: check arc-inf.db for whether each entry is to be deleted/indexed/reindexed/been indexed
|
|---|
| 171 | sub saveas {
|
|---|
| 172 | my $self = shift (@_);
|
|---|
| 173 | my ($doc_obj, $doc_dir) = @_;
|
|---|
| 174 |
|
|---|
| 175 | print STDERR "\n\n@@@ In saveas\n\n";
|
|---|
| 176 |
|
|---|
| 177 | my $proc_mode = $self->{'process_mode'};
|
|---|
| 178 |
|
|---|
| 179 | # 1. pre save out and saving debug handle
|
|---|
| 180 |
|
|---|
| 181 | # must call superclass (pre/post) saveas methods, as they handle assoc_files too
|
|---|
| 182 | my ($docxml_outhandler, $output_file) = $self->SUPER::pre_saveas(@_);
|
|---|
| 183 |
|
|---|
| 184 | $self->{'debug_outhandle'} = $docxml_outhandler if ($self->{'debug'}); # STDOUT if debug
|
|---|
| 185 |
|
|---|
| 186 | # TODO: also set debugging in begin()? Then stmts creating db and tables also sent to debug out and not executed
|
|---|
| 187 |
|
|---|
| 188 | # TODO: remove unused old_unused_saveas from GreenstoneXMLPlugout
|
|---|
| 189 |
|
|---|
| 190 |
|
|---|
| 191 | # 2. overriding saving behaviour to do what the superclass does PLUS saving to sql db
|
|---|
| 192 |
|
|---|
| 193 | #NOTE: if proc_mode == all, then "breadcrumbs" go into both meta and txt elements of doc.xml:
|
|---|
| 194 | # statements pointing viewer to the sql db for contents
|
|---|
| 195 |
|
|---|
| 196 | # write the INVERSE into doc.xml as to what is written to the db
|
|---|
| 197 | my $docxml_output_options = { 'output' => docprint::OUTPUT_NONE };
|
|---|
| 198 | if($proc_mode eq "meta_only" ) { # since only meta to go into MySQL db, text will go into docxml
|
|---|
| 199 | $docxml_output_options->{'output'} = docprint::OUTPUT_TEXT_ONLY;
|
|---|
| 200 | } elsif($proc_mode eq "text_only" ) { # since only full text to go into MySQL db, meta will go into docxml
|
|---|
| 201 | $docxml_output_options->{'output'} = docprint::OUTPUT_META_ONLY;
|
|---|
| 202 | }
|
|---|
| 203 |
|
|---|
| 204 | # now we've prepared to write out whatever is meant to go into docxml
|
|---|
| 205 | # and can do actual the steps superclass GreenstoneXMLPlugout carries out to write out docxml
|
|---|
| 206 | # So: write out the doc xml file for the current document
|
|---|
| 207 | my $section_text = &docprint::get_section_xml($doc_obj, $docxml_output_options);
|
|---|
| 208 | print $docxml_outhandler $section_text;
|
|---|
| 209 |
|
|---|
| 210 |
|
|---|
| 211 | # We also write out whatever needs to go into the MySQL database
|
|---|
| 212 | $self->write_meta_and_text($doc_obj);
|
|---|
| 213 |
|
|---|
| 214 |
|
|---|
| 215 | # 3. post save out
|
|---|
| 216 | #$self->SUPER::post_saveas(@_);
|
|---|
| 217 | $self->SUPER::post_saveas($doc_obj, $doc_dir, $docxml_outhandler, $output_file);
|
|---|
| 218 |
|
|---|
| 219 |
|
|---|
| 220 | # database connection is closed in end() method
|
|---|
| 221 | # so we don't open and close over and over for each doc during a single build
|
|---|
| 222 | }
|
|---|
| 223 |
|
|---|
| 224 |
|
|---|
| 225 | # write meta and/or text PER DOC out to DB
|
|---|
| 226 | sub write_meta_and_text {
|
|---|
| 227 | my $self = shift (@_);
|
|---|
| 228 | my ($doc_obj) = @_;
|
|---|
| 229 | my $root_section = $doc_obj->get_top_section();
|
|---|
| 230 | my $doc_oid = $doc_obj->get_OID(); # we're processing a single doc at a time, so single OID
|
|---|
| 231 |
|
|---|
| 232 | # load the prepared INSERT statement handles for both tables (can be undef for any table depending on whether meta_only or txt_only are set)
|
|---|
| 233 | my $metadata_table_sth = $self->{'metadata_prepared_insert_statement_handle'};
|
|---|
| 234 | my $fulltxt_table_sth = $self->{'fulltxt_prepared_insert_statement_handle'};
|
|---|
| 235 |
|
|---|
| 236 | $self->recursive_write_meta_and_text($doc_obj, $doc_oid, $root_section, $metadata_table_sth, $fulltxt_table_sth);
|
|---|
| 237 | }
|
|---|
| 238 |
|
|---|
| 239 | # Perl: Reading or Writing to Another Program
|
|---|
| 240 | # https://nnc3.com/mags/Perl3/cookbook/ch16_05.htm
|
|---|
| 241 | sub recursive_write_meta_and_text {
|
|---|
| 242 | my $self = shift (@_);
|
|---|
| 243 | my ($doc_obj, $doc_oid, $section, $metadata_table_sth, $fulltxt_table_sth) = @_;
|
|---|
| 244 |
|
|---|
| 245 | # If section=ROOT, write "root" as section name into table
|
|---|
| 246 | # doc->get_top_section() is the name of the doc root section, which is ""
|
|---|
| 247 | my $section_name = ($section eq "") ? "root" : $section;
|
|---|
| 248 |
|
|---|
| 249 | my $section_ptr = $doc_obj->_lookup_section ($section);
|
|---|
| 250 | return "" unless defined $section_ptr;
|
|---|
| 251 |
|
|---|
| 252 | my $debug_out = $self->{'debug_outhandle'};
|
|---|
| 253 | print STDERR "#### Meta stmt: " . $metadata_table_sth->{'Statement'} . "\n";
|
|---|
| 254 | print STDERR "#### Full stmt: " . $fulltxt_table_sth->{'Statement'} . "\n";
|
|---|
| 255 |
|
|---|
| 256 | #my $proc_mode = $self->{'process_mode'};
|
|---|
| 257 | #if($proc_mode eq "all" || $proc_mode eq "meta_only" ) {
|
|---|
| 258 | if($metadata_table_sth) { # meta insert statement handle will be undef if not writing meta
|
|---|
| 259 |
|
|---|
| 260 | foreach my $data (@{$section_ptr->{'metadata'}}) {
|
|---|
| 261 | my $meta_name = $data->[0];
|
|---|
| 262 | my $escaped_meta_value = &docprint::escape_text($data->[1]);
|
|---|
| 263 |
|
|---|
| 264 | # Write out the current section's meta to collection db's METADATA table
|
|---|
| 265 |
|
|---|
| 266 | # for each set of values to write to meta table, execute the prepared statement, filling in the values
|
|---|
| 267 |
|
|---|
| 268 | if($self->{'debug'}) {
|
|---|
| 269 | # just print the statement we were going to execute
|
|---|
| 270 |
|
|---|
| 271 | print $debug_out $metadata_table_sth->{'Statement'} . "($doc_oid, $section_name, $meta_name, $escaped_meta_value)\n";
|
|---|
| 272 | }
|
|---|
| 273 | else {
|
|---|
| 274 |
|
|---|
| 275 | $metadata_table_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");
|
|---|
| 276 | # Execution failure will print out info anyway: since db connection sets PrintError
|
|---|
| 277 | }
|
|---|
| 278 | }
|
|---|
| 279 | }
|
|---|
| 280 |
|
|---|
| 281 | #if($proc_mode eq "all" || $proc_mode eq "text_only" ) {
|
|---|
| 282 | if($fulltxt_table_sth) { # fulltxt insert statement handle will be undef if not writing fulltxt
|
|---|
| 283 |
|
|---|
| 284 | if($self->{'debug'}) {
|
|---|
| 285 | # just print the statement we were going to execute, minus the fulltxt value
|
|---|
| 286 | my $txt_repr = $section_ptr->{'text'} ? "<TXT>" : "NULL";
|
|---|
| 287 | print $debug_out $fulltxt_table_sth->{'Statement'} . "($doc_oid, $section_name, $txt_repr)\n";
|
|---|
| 288 | } else {
|
|---|
| 289 | my $section_text = &docprint::escape_text($section_ptr->{'text'});
|
|---|
| 290 |
|
|---|
| 291 | # fulltxt column can be SQL NULL. undef value gets written out as NULL:
|
|---|
| 292 | # https://stackoverflow.com/questions/12708633/which-one-represents-null-undef-or-empty-string
|
|---|
| 293 |
|
|---|
| 294 | # Write out the current section's text to collection db's FULLTeXT table
|
|---|
| 295 | $fulltxt_table_sth->execute($doc_oid, $section_name, $section_text) || warn ("Unable to write fulltxt row to db for row:\n\tOID $doc_oid, section $section_name");
|
|---|
| 296 | # Execution failure will print out info anyway: since db connection sets PrintError
|
|---|
| 297 | }
|
|---|
| 298 | }
|
|---|
| 299 |
|
|---|
| 300 | # output all subsections: RECURSIVE CALL
|
|---|
| 301 | foreach my $subsection (@{$section_ptr->{'subsection_order'}}) {
|
|---|
| 302 | &recursive_write_meta_and_text($doc_obj, $doc_oid, "$section.$subsection", $metadata_table_sth, $fulltxt_table_sth);
|
|---|
| 303 | }
|
|---|
| 304 | }
|
|---|
| 305 |
|
|---|
| 306 | #################################
|
|---|
| 307 |
|
|---|
| 308 | # Database access related functions
|
|---|
| 309 | # http://g2pc1.bu.edu/~qzpeng/manual/MySQL%20Commands.htm
|
|---|
| 310 | # https://www.guru99.com/insert-into.html
|
|---|
| 311 |
|
|---|
| 312 | # 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)?
|
|---|
| 313 | # 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?
|
|---|
| 314 | # https://stackoverflow.com/questions/3280006/duplicating-a-mysql-table-indexes-and-data
|
|---|
| 315 | # BUT what if the table is HUGE? (Think of a collection with millions of docs.) Huge overhead in copying?
|
|---|
| 316 | # 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.
|
|---|
| 317 | # Unless they do a full rebuild, which will recreate the table from scratch?
|
|---|
| 318 | # SOLUTION-> rollback transaction on error, see https://www.effectiveperlprogramming.com/2010/07/set-custom-dbi-error-handlers/
|
|---|
| 319 | # But then should set AutoCommit to off on connection, and remember to commit every time
|
|---|
| 320 |
|
|---|
| 321 | #################
|
|---|
| 322 | # Database functions that use the perl DBI module (with the DBD driver module for mysql)
|
|---|
| 323 | #################
|
|---|
| 324 |
|
|---|
| 325 | # THE NEW DB FUNCTIONS
|
|---|
| 326 | # NOTE: FULLTEXT is a reserved keyword in (My)SQL. So we can't name a table or any of its columns "fulltext".
|
|---|
| 327 | # https://dev.mysql.com/doc/refman/5.5/en/keywords.html
|
|---|
| 328 |
|
|---|
| 329 | # TODO: Consider AutoCommit status (and Autocommit off allowing commit or rollback for GS coll build cancel) later
|
|---|
| 330 |
|
|---|
| 331 | sub connect_to_db {
|
|---|
| 332 | my $self= shift (@_);
|
|---|
| 333 |
|
|---|
| 334 | my $db_driver = $self->{'db_driver'};
|
|---|
| 335 | my $db_user = $self->{'db_client_user'} || "root";
|
|---|
| 336 | my $db_pwd = $self->{'db_client_pwd'};
|
|---|
| 337 | my $db_host = $self->{'db_host'} || "127.0.0.1";
|
|---|
| 338 | my $db_enc = $self->{'db_encoding'} || "utf8";
|
|---|
| 339 |
|
|---|
| 340 | #my $db_name = $self->{'site_name'};
|
|---|
| 341 |
|
|---|
| 342 | # try connecting to the mysql db, if that fails it will die
|
|---|
| 343 | # so don't bother preparing GreenstoneXMLPlugout by calling superclass' begin()
|
|---|
| 344 |
|
|---|
| 345 | # localhost doesn't work for us, but 127.0.0.1 works
|
|---|
| 346 | # https://metacpan.org/pod/DBD::mysql
|
|---|
| 347 | # "The hostname, if not specified or specified as '' or 'localhost', will default to a MySQL server
|
|---|
| 348 | # running on the local machine using the default for the UNIX socket. To connect to a MySQL server
|
|---|
| 349 | # on the local machine via TCP, you must specify the loopback IP address (127.0.0.1) as the host."
|
|---|
| 350 | #my $connect_str = "dbi:$db_driver:database=$db_name;host=$db_host";
|
|---|
| 351 | my $connect_str = "dbi:$db_driver:host=$db_host"; # don't provide db, so we can check the db is there
|
|---|
| 352 | my $dbh = DBI->connect("$connect_str", $db_user, $db_pwd,
|
|---|
| 353 | {
|
|---|
| 354 | ShowErrorStatement => 1, # more informative as DBI will append failed SQL stmt to error message
|
|---|
| 355 | PrintError => 1, # on by default, but being explicit
|
|---|
| 356 | RaiseError => 0, # off by default, but being explicit
|
|---|
| 357 | AutoCommit => 1 # on by default, but being explicit
|
|---|
| 358 | });
|
|---|
| 359 |
|
|---|
| 360 | if(!$dbh) {
|
|---|
| 361 | # NOTE, despite handle dbh being undefined, error code will be in DBI->err
|
|---|
| 362 | return 0;
|
|---|
| 363 | }
|
|---|
| 364 |
|
|---|
| 365 | # set encoding https://metacpan.org/pod/DBD::mysql
|
|---|
| 366 | # https://dev.mysql.com/doc/refman/5.7/en/charset.html
|
|---|
| 367 | # https://dev.mysql.com/doc/refman/5.7/en/charset-conversion.html
|
|---|
| 368 | # Setting the encoding at db server level.
|
|---|
| 369 | # Not sure if this command is mysql specific:
|
|---|
| 370 | my $stmt = "set NAMES '" . $db_enc . "'";
|
|---|
| 371 | $dbh->do($stmt) || warn("Unable to set charset encoding at db server level to: " . $db_enc . "\n");
|
|---|
| 372 |
|
|---|
| 373 | # if we're here, then connection succeeded, store handle
|
|---|
| 374 | $self->{'db_handle'} = $dbh;
|
|---|
| 375 | return 1;
|
|---|
| 376 | }
|
|---|
| 377 |
|
|---|
| 378 | sub load_db_and_tables {
|
|---|
| 379 | my $self= shift (@_);
|
|---|
| 380 | my ($db_name, $build_mode) = @_;
|
|---|
| 381 | my $dbh = $self->{'db_handle'};
|
|---|
| 382 |
|
|---|
| 383 | # perl DBI switch database: https://www.perlmonks.org/?node_id=995434
|
|---|
| 384 | # do() returns undef on error.
|
|---|
| 385 | # connection succeeded, try to load our database. If that didn't work, attempt to create db
|
|---|
| 386 | my $success = $dbh->do("use $db_name");
|
|---|
| 387 |
|
|---|
| 388 | if(!$success && $dbh->err == 1049) { # "Unknown database" error has code 1049 (mysql only?) meaning db doesn't exist yet
|
|---|
| 389 | # attempt to create the db and its tables
|
|---|
| 390 | $self->create_db($db_name) || return 0;
|
|---|
| 391 |
|
|---|
| 392 | print STDERR "@@@ CREATED DATABASE $db_name\n";
|
|---|
| 393 |
|
|---|
| 394 | # once more attempt to use db, now that it exists
|
|---|
| 395 | $dbh->do("use $db_name") || return 0;
|
|---|
| 396 | #$dbh->do("use localsite") or die "Error (code" . $dbh->err ."): " . $dbh->errstr . "\n";
|
|---|
| 397 |
|
|---|
| 398 | # attempt to create tables in current db
|
|---|
| 399 | $self->create_metadata_table() || return 0;
|
|---|
| 400 | $self->create_fulltext_table() || return 0;
|
|---|
| 401 |
|
|---|
| 402 | $success = 1;
|
|---|
| 403 | }
|
|---|
| 404 | elsif($success) { # database existed and loaded successfully, but
|
|---|
| 405 | # before proceeding check that the current collection's tables exist
|
|---|
| 406 |
|
|---|
| 407 | print STDERR "@@@ DATABASE $db_name EXISTED\n";
|
|---|
| 408 |
|
|---|
| 409 |
|
|---|
| 410 | if($build_mode eq "removeold") {
|
|---|
| 411 | $self->delete_collection_tables();
|
|---|
| 412 | }
|
|---|
| 413 |
|
|---|
| 414 | # use existing tables if any
|
|---|
| 415 | # attempt to create tables in current db
|
|---|
| 416 | if($build_mode eq "removeold" || !$self->table_exists($self->get_metadata_table_name())) {
|
|---|
| 417 | $self->create_metadata_table() || return 0;
|
|---|
| 418 | } else {
|
|---|
| 419 | print STDERR "@@@ Meta table exists\n";
|
|---|
| 420 | }
|
|---|
| 421 | if($build_mode eq "removeold" || !$self->table_exists($self->get_fulltext_table_name())) {
|
|---|
| 422 | $self->create_fulltext_table() || return 0;
|
|---|
| 423 | } else {
|
|---|
| 424 | print STDERR "@@@ Fulltxt table exists\n";
|
|---|
| 425 | }
|
|---|
| 426 |
|
|---|
| 427 | }
|
|---|
| 428 |
|
|---|
| 429 | return $success; # could still return 0, if database failed to load with an error code != 1049
|
|---|
| 430 | }
|
|---|
| 431 |
|
|---|
| 432 | # disconnect from db - https://metacpan.org/pod/DBI#disconnect
|
|---|
| 433 | # TODO: make sure to have committed or rolled back before disconnect
|
|---|
| 434 | # and that you've call finish() on statement handles if any fetch remnants remain
|
|---|
| 435 | sub disconnect_from_db {
|
|---|
| 436 | my $self= shift (@_);
|
|---|
| 437 | my $dbh = $self->{'db_handle'};
|
|---|
| 438 |
|
|---|
| 439 | # make sure any active stmt handles are finished
|
|---|
| 440 | # 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."
|
|---|
| 441 |
|
|---|
| 442 | #$meta_sth = $self->{'metadata_prepared_insert_statement_handle'};
|
|---|
| 443 | #$txt_sth = $self->{'fulltxt_prepared_insert_statement_handle'};
|
|---|
| 444 | #$meta_sth->finish() if($meta_sth);
|
|---|
| 445 | #$txt_sth->finish() if($txt_sth);
|
|---|
| 446 |
|
|---|
| 447 | 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?
|
|---|
| 448 | return $rc;
|
|---|
| 449 | }
|
|---|
| 450 |
|
|---|
| 451 | sub create_db {
|
|---|
| 452 | my $self= shift (@_);
|
|---|
| 453 | my $db_name = $self->{'site_name'};
|
|---|
| 454 | my $dbh = $self->{'db_handle'};
|
|---|
| 455 |
|
|---|
| 456 | # https://stackoverflow.com/questions/5025768/how-can-i-create-a-mysql-database-from-a-perl-script
|
|---|
| 457 | return $dbh->do("create database $db_name"); # do() will return undef on fail, https://metacpan.org/pod/DBI#do
|
|---|
| 458 | }
|
|---|
| 459 |
|
|---|
| 460 |
|
|---|
| 461 | sub create_metadata_table {
|
|---|
| 462 | my $self= shift (@_);
|
|---|
| 463 | my $dbh = $self->{'db_handle'};
|
|---|
| 464 |
|
|---|
| 465 | my $table_name = $self->get_metadata_table_name();
|
|---|
| 466 |
|
|---|
| 467 | # If using an auto incremented primary key:
|
|---|
| 468 | 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));";
|
|---|
| 469 | return $dbh->do($stmt);
|
|---|
| 470 | }
|
|---|
| 471 |
|
|---|
| 472 | # TODO: Investigate: https://dev.mysql.com/doc/search/?d=10&p=1&q=FULLTEXT
|
|---|
| 473 | # 12.9.1 Natural Language Full-Text Searches
|
|---|
| 474 | # to see whether we have to index the 'fulltxt' column of the 'fulltext' tables
|
|---|
| 475 | # or let user edit this file, or add it as another option
|
|---|
| 476 | sub create_fulltext_table {
|
|---|
| 477 | my $self= shift (@_);
|
|---|
| 478 | my $dbh = $self->{'db_handle'};
|
|---|
| 479 |
|
|---|
| 480 | my $table_name = $self->get_fulltext_table_name();
|
|---|
| 481 |
|
|---|
| 482 | # If using an auto incremented primary key:
|
|---|
| 483 | 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));";
|
|---|
| 484 | return $dbh->do($stmt);
|
|---|
| 485 |
|
|---|
| 486 | }
|
|---|
| 487 |
|
|---|
| 488 |
|
|---|
| 489 | # USEFUL: https://metacpan.org/pod/DBI
|
|---|
| 490 | # "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."
|
|---|
| 491 |
|
|---|
| 492 |
|
|---|
| 493 | # https://www.guru99.com/insert-into.html
|
|---|
| 494 | # and https://dev.mysql.com/doc/refman/8.0/en/example-auto-increment.html
|
|---|
| 495 | # for inserting multiple rows at once
|
|---|
| 496 | # https://www.perlmonks.org/bare/?node_id=316183
|
|---|
| 497 | # https://metacpan.org/pod/DBI#do
|
|---|
| 498 | # 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
|
|---|
| 499 | # https://docstore.mik.ua/orelly/linux/dbi/ch05_05.htm
|
|---|
| 500 |
|
|---|
| 501 | # https://metacpan.org/pod/DBI#performance
|
|---|
| 502 | # '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.'
|
|---|
| 503 | sub prepare_insert_metadata_row_stmthandle {
|
|---|
| 504 | my $self = shift (@_);
|
|---|
| 505 | #my ($did, $sid, $metaname, $metavalue) = @_;
|
|---|
| 506 | my $dbh = $self->{'db_handle'};
|
|---|
| 507 |
|
|---|
| 508 | my $tablename = $self->get_metadata_table_name();
|
|---|
| 509 |
|
|---|
| 510 | #my $stmt = "INSERT INTO $tablename (did, sid, metaname, metavalue) VALUES ('$did', '$sid', '$metaname', '$metavalue');"; # ?, ?, ?, ?
|
|---|
| 511 |
|
|---|
| 512 | # using qq{} since we want $tablename placeholder to be filled in
|
|---|
| 513 | # returns Statement Handle object!
|
|---|
| 514 | my $sth = $dbh->prepare(qq{INSERT INTO $tablename (did, sid, metaname, metavalue) VALUES (?, ?, ?, ?)}) || warn("Could not prepare insert statement for metadata table\n");
|
|---|
| 515 |
|
|---|
| 516 | print STDERR "@@@@ Prepared meta insert statement: ".$sth->{'Statement'}."\n";
|
|---|
| 517 |
|
|---|
| 518 | return $sth;
|
|---|
| 519 | }
|
|---|
| 520 |
|
|---|
| 521 | sub prepare_insert_fulltxt_row_stmthandle {
|
|---|
| 522 | my $self = shift (@_);
|
|---|
| 523 | #my ($did, $sid, $fulltext) = @_;
|
|---|
| 524 | my $dbh = $self->{'db_handle'};
|
|---|
| 525 |
|
|---|
| 526 | my $tablename = $self->get_fulltext_table_name();
|
|---|
| 527 |
|
|---|
| 528 | #my $stmt = "INSERT INTO $tablename (did, sid, fulltxt) VALUES ('$did', '$sid', '$fulltext');"; ?, ?, ?
|
|---|
| 529 |
|
|---|
| 530 | # using qq{} since we want $tablename placeholder to be filled in
|
|---|
| 531 | # returns Statement Handle object!
|
|---|
| 532 | my $sth = $dbh->prepare(qq{INSERT INTO $tablename (did, sid, fulltxt) VALUES (?, ?, ?)}) || warn("Could not prepare insert statement for fulltxt table\n");
|
|---|
| 533 |
|
|---|
| 534 | print STDERR "@@@@ Prepared fulltext insert statement: ".$sth->{'Statement'}."\n";
|
|---|
| 535 |
|
|---|
| 536 | return $sth;
|
|---|
| 537 | }
|
|---|
| 538 |
|
|---|
| 539 | # "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"
|
|---|
| 540 | #MySQL 8.0 Reference Manual :: 13.1.22 DROP DATABASE Syntax
|
|---|
| 541 | # https://dev.mysql.com/doc/en/drop-database.html
|
|---|
| 542 | sub delete_collection_tables {
|
|---|
| 543 | my $self= shift (@_);
|
|---|
| 544 | my $dbh = $self->{'db_handle'};
|
|---|
| 545 |
|
|---|
| 546 | print STDERR "### Build mode is removeold, so deleting tables for current collection\n";
|
|---|
| 547 |
|
|---|
| 548 | # drop table <tablename>
|
|---|
| 549 | my $table = $self->get_metadata_table_name();
|
|---|
| 550 | $dbh->do("drop table $table") || warn("@@@ Couldn't delete $table");
|
|---|
| 551 | $table = $self->get_fulltext_table_name();
|
|---|
| 552 | $dbh->do("drop table $table") || warn("@@@ Couldn't delete $table");
|
|---|
| 553 | }
|
|---|
| 554 |
|
|---|
| 555 | # Don't call this: it will delete the meta and full text tables for ALL collections in $db_name (localsite by default)!
|
|---|
| 556 | # this is just for debugging
|
|---|
| 557 | sub _delete_database {
|
|---|
| 558 | my $self= shift (@_);
|
|---|
| 559 | my ($db_name) = @_;
|
|---|
| 560 | my $dbh = $self->{'db_handle'};
|
|---|
| 561 |
|
|---|
| 562 | # "drop database dbname"
|
|---|
| 563 | $dbh->do("drop database $db_name") || return 0;
|
|---|
| 564 |
|
|---|
| 565 | return 1;
|
|---|
| 566 | }
|
|---|
| 567 |
|
|---|
| 568 | # More basic helper methods
|
|---|
| 569 | sub get_metadata_table_name {
|
|---|
| 570 | my $self= shift (@_);
|
|---|
| 571 | my $table_name = $self->{'collection_name'} . "_metadata";
|
|---|
| 572 | return $table_name;
|
|---|
| 573 | }
|
|---|
| 574 |
|
|---|
| 575 | # FULLTEXT is a reserved keyword in (My)SQL. https://dev.mysql.com/doc/refman/5.5/en/keywords.html
|
|---|
| 576 | # So we can't name a table or any of its columns "fulltext". We use "fulltxt" instead.
|
|---|
| 577 | sub get_fulltext_table_name {
|
|---|
| 578 | my $self= shift (@_);
|
|---|
| 579 | my $table_name = $self->{'collection_name'} . "_fulltxt";
|
|---|
| 580 | return $table_name;
|
|---|
| 581 | }
|
|---|
| 582 |
|
|---|
| 583 | # I can get my version of table_exists to work, but it's not so ideal
|
|---|
| 584 | # Interesting that MySQL has non-standard command to CREATE TABLE IF NOT EXISTS and DROP TABLE IF EXISTS,
|
|---|
| 585 | # see https://www.perlmonks.org/bare/?node=DBI%20Recipes
|
|---|
| 586 | # The page further has a table_exists function that could work with proper comparison
|
|---|
| 587 | # Couldn't get the first solution at https://www.perlmonks.org/bare/?node_id=500050 to work though
|
|---|
| 588 | sub table_exists {
|
|---|
| 589 | my $self = shift (@_);
|
|---|
| 590 | my $dbh = $self->{'db_handle'};
|
|---|
| 591 | my ($table_name) = @_;
|
|---|
| 592 |
|
|---|
| 593 | my @table_list = $dbh->tables;
|
|---|
| 594 | #my $tables_str = @table_list[0];
|
|---|
| 595 | foreach my $table (@table_list) {
|
|---|
| 596 | return 1 if ($table =~ m/$table_name/);
|
|---|
| 597 | }
|
|---|
| 598 | return 0;
|
|---|
| 599 | }
|
|---|
| 600 |
|
|---|
| 601 | 1;
|
|---|
