root/main/trunk/greenstone2/perllib/plugouts/GreenstoneSQLPlugout.pm @ 32527

Revision 32527, 24.9 KB (checked in by ak19, 9 months ago)

Renaming new MySQLPlugout to GreenstoneSQLPlugout to indicate that it deals with the internal Greenstone doc format and to match with the in-progress GreenstoneSQLPlugin. In contrast, the extant DatabasePlugin?, like most other plugins, appears to work with external document formats. In its case, database records.

Line 
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
28package GreenstoneSQLPlugout;
29
30use strict;
31no strict 'refs';
32no strict 'subs';
33
34use util;
35use FileUtils;
36use GreenstoneXMLPlugout;
37use docprint;
38
39use DBI; # the central package for this plugout
40
41use IPC::Open2;
42use 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
51sub 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
61my $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
69my $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
78my $options = { 'name'     => "GreenstoneSQLPlugout",
79        'desc'     => "{GreenstoneSQLPlugout.desc}",
80        'abstract' => "no",
81        'inherits' => "yes",
82        'args'     => $arguments };
83
84sub 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
104sub 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
159sub 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
171sub 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
226sub 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
241sub 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
331sub 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
378sub 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
435sub 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
451sub 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
461sub 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
476sub 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.'
503sub 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
521sub 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
542sub 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
557sub _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
569sub 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.
577sub 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
588sub 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
6011;
Note: See TracBrowser for help on using the browser.