root/main/trunk/greenstone2/perllib/plugouts/MySQLPlugout.pm @ 32524

Revision 32524, 24.7 KB (checked in by ak19, 12 months ago)

Creating db, creating tables and populating both coll_metadata and coll_fulltxt tables works. Added functions for deleting and recreating tables on currently hardcoded removeold build_mode param, also tested. Still lots of TODO instructions that I need to complete. But will first move on to build stage to read back in. Still to test is whether the doc.xml files got created with the breadcrumbs values pointing the user to view the database for values. Not yet tested is also meta_only and fulltext_only modes.

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