Changeset 32520 for main


Ignore:
Timestamp:
2018-10-18T19:36:33+13:00 (6 years ago)
Author:
ak19
Message:

Committing first cut of MySQLPlugout that uses DBI (DB interface) for driver DBD::mysql. Haven't tested this other than that plugoutinfo.pl works. The defunct non-DBI versions of the database methods are still in here in this commit, with some syntax corrections.

File:
1 edited

Legend:

Unmodified
Added
Removed

  • main/trunk/greenstone2/perllib/plugouts/MySQLPlugout.pm

    r32518 r32520  
    3232use util;
    3333use FileUtils;
    34 use BasePlugout;
     34#use BasePlugout;
     35use GreenstoneXMLPlugout;
    3536use docprint;
    3637
    … …  
    4344}
    4445
     46
     47# TODO: deal with -removeold and everything? Or type out instructions for user
     48
    4549# TODO Q: what is "group" in GreenstoneXMLPlugout?
     50# TODO Q: site_name only exists for GS3. What about GS2?
    4651
    4752my $process_mode_list =
    … …  
    8792}
    8893
     94# connect here and ensure all tables and databases exist
     95sub begin {
     96
     97    my $self= shift (@_);
     98
     99    ########### TODO: these should be set from cmdline/GLI options to plugout #########
     100    $self->{'db_driver'} = "mysql";
     101    $self->{'site_name'} = "localsite";   
     102    $self->{'client_user'} = "root";
     103    $self->{'client_pwd'} = "6reenstone3";
     104    #$self->{'db_host'} = "127.0.0.1";
     105    #$self->{'db_encoding'} = "utf8";
     106   
     107    ############ LOAD NECESSARY OPTIONS ###########
     108    print STDERR "########## COLLECTION: ". $ENV{'GSDLCOLLECTION'}."\n";
     109    $self->{'collection_name'} = $ENV{'GSDLCOLLECTION'};
     110   
     111    if(!$self->connect_to_db()) {
     112    # This is fatal for the plugout, let's terminate here
     113    # PrintError would already have displayed the warning message on connection fail   
     114    die("Could not connect to db. Can't proceed.\n");
     115    }
     116    if(!$self->load_db_and_tables()) {
     117    # This is fatal for the plugout, let's terminate here
     118    # PrintError would already have displayed the warning message on connection fail   
     119    die("Could not use db or prepare its tables. Can't proceed.\n");
     120    }
     121
     122    # prepare the shared/common HANDLES to SQL insert statements that contain placeholders
     123    # and which we will reuse repeatedly when executing the actual insert statements
     124    my $proc_mode = $self->{'process_mode'};
     125    if($proc_mode eq "all" || $proc_mode eq "meta_only" ) {
     126    $self->{'metadata_prepared_insert_statement_handle'} = $self->prepare_insert_metadata_row_stmthandle();
     127    }
     128    if($proc_mode eq "all" || $proc_mode eq "text_only" ) {
     129    $self->{'fulltxt_prepared_insert_statement_handle'} = $self->prepare_insert_fulltxt_row_stmthandle();
     130    }
     131   
     132    # finally, call begin on super
     133    $self->GreenstoneXMLPlugout::begin(@_);   
     134}
     135
     136# disconnect from database here, see inexport.pm
     137sub end
     138{
     139    my $self = shift(@_);
     140
     141    # do the superclass stuff
     142    $self->GreenstoneXMLPlugout::end(@_);
     143    $self->disconnect_from_db() || warn("Unable to disconnect from database " . $self->{'site_name'} . "\n");
     144    #my $success = $self->GreenstoneXMLPlugout::end(@_);
     145    #$success = $self->disconnect_from_db() && $success;   
     146    #return $success;
     147}
     148   
    89149# TODO: check arc-inf.db for whether each entry is to be deleted/indexed/reindexed/been indexed
    90150sub saveas {
    … …  
    92152    my ($doc_obj, $doc_dir) = @_;
    93153
    94     # pre
     154    # pre save out
    95155    my ($docxml_outhandler, $output_file) = $self->GreenstoneXMLPlugout::pre_saveas(@_);
    96 
    97    
    98     print STDERR "########## COLLECTION: ". $ENV{'GSDLCOLLECTION'}."\n";
    99     $self->{'collection_name'} = $ENV{'GSDLCOLLECTION'};
    100     # set up DB and table or connect to DB and access the table here?
    101    
     156   
     157
     158    # saving customisation
     159    $self->{'debug_outhandle'} = $docxml_outhandler if ($self->{'debug'}); # STDOUT if debug
     160
     161    # write the INVERSE into doc.xml as to what is written to the db
    102162    my $proc_mode = $self->{'process_mode'};
    103163    my $docxml_output_options = { 'output' => docprint::OUTPUT_NONE };
    … …  
    117177    $self->write_meta_and_text($doc_obj);
    118178
    119     # post
     179   
     180    # post save out
    120181    $self->GreenstoneXMLPlugout::post_saveas(@_);
    121182
    … …  
    125186
    126187
    127 # write meta and/or text out to DB
     188# write meta and/or text PER DOC out to DB
    128189sub write_meta_and_text {
    129190    my $self = shift (@_);
    130191    my ($doc_obj) = @_;
    131192    my $root_section = $doc_obj->get_top_section();
    132 
    133     # Do we don't want to open and close a connection per doc?
     193    my $doc_oid = $doc_obj->get_OID(); # we're processing a single doc at a time, so single OID
     194
     195    ##binmode($db_handle,":utf8"); ## WRONG FOR DB, NEED TO CREATE IN UTF8 MODE
     196   
     197    # TODO if $self->debug is on
     198   
     199    # Do we want to open and close a connection per doc?
    134200    # Would we not rather want to open and close per collection rebuild?
    135201   
    136202    #$self->create_db_connection();
    137    
    138     $self->recursive_write_meta_and_text($doc_obj, $root_section);
     203
     204    # 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)
     205    my $metadata_table_sth = $self->{'metadata_prepared_insert_statement_handle'};
     206    my $fulltxt_table_sth = $self->{'fulltxt_prepared_insert_statement_handle'};
     207   
     208    $self->recursive_write_meta_and_text($doc_obj, $root_section, $metadata_table_sth, $fulltxt_table_sth);
    139209
    140210    #$self->close_db_connection();
    … …  
    143213# https://nnc3.com/mags/Perl3/cookbook/ch16_05.htm
    144214sub recursive_write_meta_and_text {
    145     my ($doc_obj, $section) = @_;
    146    
    147     # TODO
    148     my $db_outhandler = undef;
    149     binmode($db_outhandler,":utf8");
    150     # TODO if $self->debug is on
     215    my $self = shift (@_);
     216    my ($doc_obj, $doc_oid, $section, $metadata_table_sth, $fulltxt_table_sth) = @_;   
     217
     218    # If section=ROOT, write "root" as section name into table
     219    # doc->get_top_section() is the name of the doc root section, which is ""
     220    my $section_name = ($section eq "") ? "root" : $section;
    151221   
    152222    my $section_ptr = $doc_obj->_lookup_section ($section);
    153223    return "" unless defined $section_ptr;
    154224
    155     my $proc_mode = $self->{'process_mode'};
    156 
    157     if($proc_mode eq "all" || $proc_mode eq "meta_only" ) {
     225    my $debug_out = $self->{'debug_outhandle'};
     226   
     227    #my $proc_mode = $self->{'process_mode'};
     228    #if($proc_mode eq "all" || $proc_mode eq "meta_only" ) {
     229    if($metadata_table_sth) { # meta insert statement handle will be undef if not writing meta
     230   
    158231    foreach my $data (@{$section_ptr->{'metadata'}}) {
    159         my $escaped_value = &escape_text($data->[1]);
    160         my $metaval = $data->[0];
    161         # TODO: write out current section's text to collection db's META table
     232        my $meta_name = $data->[0];
     233        my $escaped_meta_value = &escape_text($data->[1]);
     234
     235        # Write out the current section's meta to collection db's METADATA table       
     236       
     237        # for each set of values to write to meta table, execute the prepared statement, filling in the values
     238
     239        if($self->{'debug'}) {
     240        # just print the statement we were going to execute
     241
     242        print $debug_out $metadata_table_sth->Statement . "($doc_oid, $section_name, $meta_name, $escaped_meta_value)\n";
     243        }
     244        else {
     245       
     246        $metadata_table_sth->execute($doc_oid, $section_name, $meta_name, $escaped_meta_value);
     247        #|| warn ("Unable to write metadata row to db:\n\tOID $doc_oid, section $section_name,\n\tmeta name: $meta_name, val: $escaped_meta_value");
     248        # Execution failure will print out info anyway: since db connection sets PrintError
     249        }
    162250    }
    163251    }
    164     if($proc_mode eq "all" || $proc_mode eq "text_only" ) {
    165     my $section_text = &escape_text($section_ptr->{'text'});
    166     # TODO: write out current section's text to collection db's TEXT table
    167    
     252   
     253    #if($proc_mode eq "all" || $proc_mode eq "text_only" ) {
     254    if($fulltxt_table_sth) { # fulltxt insert statement handle will be undef if not writing fulltxt
     255
     256    if($self->{'debug'}) {
     257        # just print the statement we were going to execute, minus the fulltxt value
     258        my $txt_repr = $section_ptr->{'text'} ? "<TXT>" : "NULL";
     259        print $debug_out $fulltxt_table_sth->Statement . "($doc_oid, $section_name, $txt_repr)\n";
     260    } else {
     261        my $section_text = &escape_text($section_ptr->{'text'});
     262       
     263        # fulltxt column can be SQL NULL. undef value gets written out as NULL:
     264        # https://stackoverflow.com/questions/12708633/which-one-represents-null-undef-or-empty-string
     265       
     266        # Write out the current section's text to collection db's FULLTeXT table
     267        $fulltxt_table_sth->execute($doc_oid, $section_name, $section_text);
     268        #|| warn ("Unable to write fulltxt row to db for row:\n\tOID $doc_oid, section $section_name");
     269        # Execution failure will print out info anyway: since db connection sets PrintError
     270    }
    168271    }
    169272   
    170273    # output all subsections: RECURSIVE CALL
    171274    foreach my $subsection (@{$section_ptr->{'subsection_order'}}) {
    172     &recursive_write_meta_and_text($doc_obj, "$section.$subsection");
     275    &recursive_write_meta_and_text($doc_obj, $doc_oid, "$section.$subsection", $metadata_table_sth, $fulltxt_table_sth);
    173276    }
    174277}
    … …  
    185288# BUT what if the table is HUGE? (Think of a collection with millions of docs.) Huge overhead in copying?
    186289# 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.
    187 # Unless they do a full rebuild, which will recreate the tab;e from scratch?
    188  
     290# Unless they do a full rebuild, which will recreate the table from scratch?
     291# SOLUTION-> rollback transaction on error, see https://www.effectiveperlprogramming.com/2010/07/set-custom-dbi-error-handlers/
    189292
    190293# I'm using perl's open2 like in Z3950Download, as opposed to open3 like in WgetDownload
    … …  
    216319    my ($self,$expected) = @_;
    217320
     321    my $out = $self->{'MYSQL_OUT'};
    218322    my $opening_line = <$out>;
    219323    if ($opening_line =~ m/$expected/i) {
    … …  
    227331
    228332    my $found_expected = 0;
     333    my $out = $self->{'MYSQL_OUT'};
    229334    while (my $line = <$out>) {
    230335    print STDERR "$line\n";
    … …  
    251356   
    252357   
    253     my $launch_cmd = "\"./$mysql_client\" -u $clientuser -p";
     358    my $launch_cmd = "\"./$mysql_client\" -u $client_user -p";
    254359    my $childpid = open2(*MYSQL_OUT, *MYSQL_IN, $launch_cmd)
    255360    or (print STDERR "Done\n" and die "can't open2 pipe to mysql client: $!");
    … …  
    277382    return $self->load_db();
    278383    }   
    279    
    280     return $conn_open; # 1 if client already quit after pwd fail, 0 if load_db failed (needs to be quit), 1 if load_db succeeded (mysql client still running)
     384
     385    # return $conn_open;
     386    return $conn_success; # 1 if client already quit after pwd fail, 0 if load_db failed (needs to be quit), 1 if load_db succeeded (mysql client still running)
    281387}
    282388
    … …  
    339445   
    340446    if($self->response_line_contains("Access denied")) {
    341     print STDERR "Password not recognised. Got: $opening_line\n";
     447    print STDERR "Password not recognised. Got: Access denied.\n";
    342448    return 0;
    343449    }
    … …  
    356462   
    357463    my $db_found = 0;
     464    my $out = $self->{'MYSQL_OUT'};
    358465    while (my $line = <$out>) {
    359466    print STDERR "$line\n";
    … …  
    374481
    375482    # attempt to load the newly created db
    376     if($self->_load_db()) {
     483    if($self->_load_db()) { # recursive call!
    377484        return 1;
    378485    }
     486   
     487   
    379488    #my $opening_line = <$out>;
    380489    #if ($opening_line !~ m/Query OK/) {
    … …  
    437546    my $self = shift (@_);
    438547    my ($did, $sid, $metaname, $metavalue) = @_;
    439     my $tablename = $self->{'colname'}_"metadata";
     548    my $tablename = $self->{'colname'}."_metadata";
    440549
    441550    my $cmd = "INSERT INTO $tablename (did, sid, metaname, metavalue) VALUES\n";
    442     $cmd = "('$did', '$sid', '$metaname', '$metavalue');\n";
     551    $cmd .= "('$did', '$sid', '$metaname', '$metavalue');\n";
    443552    return $cmd;
    444553}
    … …  
    447556    my $self = shift (@_);
    448557    my ($did, $sid, $fulltext) = @_;
    449     my $tablename = $self->{'colname'}_"fulltxt";
     558    my $tablename = $self->{'colname'}."_fulltxt";
    450559
    451560    my $cmd = "INSERT INTO $tablename (did, sid, fulltxt) VALUES\n";
    452     $cmd = "('$did', '$sid', '$fulltext');\n";
     561    $cmd .= "('$did', '$sid', '$fulltext');\n";
    453562    return $cmd;
    454563}
    … …  
    461570sub X_open_connection()
    462571{
     572    my $self = shift (@_);
    463573    # connect with pwd
    464574    my $conn_success = $self->send_pwd();
    … …  
    470580    return $self->load_db();
    471581    } else {
    472     return $conn_sucess;
     582    return $conn_success;
    473583    }
    474584}
    475585
    476586#################
     587# Database functions that use the perl DBI module (with the DBD driver module for mysql)
     588#################
     589
     590# THE NEW DB FUNCTIONS
     591# NOTE: FULLTEXT is a reserved keyword in (My)SQL. So we can't name a table or any of its columns "fulltext".
     592# https://dev.mysql.com/doc/refman/5.5/en/keywords.html
     593
     594# TODO: Consider AutoCommit status (and Autocommit off allowing commit or rollback for GS coll build cancel) later
     595
     596sub connect_to_db {
     597    my $self= shift (@_);
     598   
     599    my $db_driver = $self->{'db_driver'};
     600    my $db_user = $self->{'client_user'} || "root";
     601    my $db_pwd = $self->{'client_pwd'};
     602    my $db_host = $self->{'db_host'} || "127.0.0.1";
     603    my $db_enc = $self->{'db_encoding'} || "utf8";
     604   
     605    #my $db_name = $self->{'site_name'};
     606   
     607    # try connecting to the mysql db, if that fails it will die
     608    # so don't bother preparing GreenstoneXMLPlugout by calling superclass' begin()
     609
     610    # localhost doesn't work for us, but 127.0.0.1 works
     611    # https://metacpan.org/pod/DBD::mysql
     612    # "The hostname, if not specified or specified as '' or 'localhost', will default to a MySQL server
     613    # running on the local machine using the default for the UNIX socket. To connect to a MySQL server
     614    # on the local machine via TCP, you must specify the loopback IP address (127.0.0.1) as the host."
     615    #my $connect_str = "dbi:$db_driver:database=$db_name;host=$db_host";
     616    my $connect_str = "dbi:$db_driver:host=$db_host"; # don't provide db, so we can check the db is there
     617    my $dbh = DBI->connect("$connect_str", $db_user, $db_pwd,
     618               {
     619                   ShowErrorStatement => 1, # more informative as DBI will append failed SQL stmt to error message
     620                   PrintError => 1, # on by default, but being explicit
     621                   RaiseError => 0, # off by default, but being explicit
     622                   AutoCommit => 1, # on by default, but being explicit
     623               });
     624
     625    if(!$dbh) {
     626    # NOTE, despite handle dbh being undefined, error code will be in DBI->err
     627    return 0;   
     628    }
     629
     630    # set encoding https://metacpan.org/pod/DBD::mysql
     631    # https://dev.mysql.com/doc/refman/5.7/en/charset.html
     632    # https://dev.mysql.com/doc/refman/5.7/en/charset-conversion.html
     633    # Setting the encoding at db server level.
     634    # Not sure if this command is mysql specific:
     635    my $stmt = "set NAMES '" . $db_enc . "'";
     636    $dbh->do($stmt) || warn("Unable to set charset encoding at db server level to: " . $db_enc . "\n");
     637   
     638    # if we're here, then connection succeeded, store handle
     639    $self->{'db_handle'} = $dbh;
     640    return 1;
     641}
     642
     643sub load_db_and_tables {
     644    my $self= shift (@_);
     645    my $db_name = $self->{'site_name'}; # one database per GS3 site
     646    my $dbh = $self->{'db_handle'};
     647   
     648    # perl DBI switch database: https://www.perlmonks.org/?node_id=995434
     649    # do() returns undef on error.
     650    # connection succeeded, try to load our database. If that didn't work, attempt to create db
     651    my $success = $dbh->do("use $db_name");
     652   
     653    if(!$success && $dbh->err == 1049) { # "Unknown database" error has code 1049 (mysql only?) meaning db doesn't exist yet
     654    # attempt to create the db and its tables
     655    $self->create_db($db_name) || return 0;
     656
     657    # once more attempt to use db, now that it exists
     658    $dbh->do("use $db_name") || return 0;
     659    #$dbh->do("use localsite") or die "Error (code" . $dbh->err ."): " . $dbh->errstr . "\n";
     660
     661    # attempt to create tables in current db
     662    $self->create_metadata_table() || return 0;
     663    $self->create_fulltext_table() || return 0;
     664
     665    $success = 1;
     666    }
     667    elsif($success) { # database existed and loaded successfully, but
     668    # before proceeding check that the current collection's tables exist
     669   
     670    # attempt to create tables in current db
     671    if(!$self->table_exists($self->{'collection_name'} . "metadata")) {
     672        $self->create_metadata_table() || return 0;
     673    }
     674    if(!$self->table_exists($self->{'collection_name'} .  "fulltxt")) {
     675        $self->create_fulltext_table() || return 0;
     676    }
     677    }
     678   
     679    return $success; # could still return 0, if database failed to load with an error code != 1049
     680}
     681
     682# disconnect from db - https://metacpan.org/pod/DBI#disconnect
     683# TODO: make sure to have committed or rolled back before disconnect
     684# and that you've call finish() on statement handles if any fetch remnants remain
     685sub disconnect_from_db {
     686    my $self= shift (@_);   
     687    my $dbh = $self->{'db_handle'};
     688
     689    # make sure any active stmt handles are finished
     690    # 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."
     691   
     692    #$meta_sth = $self->{'metadata_prepared_insert_statement_handle'};
     693    #$txt_sth = $self->{'fulltxt_prepared_insert_statement_handle'};
     694    #$meta_sth->finish() if($meta_sth);
     695    #$txt_sth->finish() if($txt_sth);
     696   
     697    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?
     698    return $rc;
     699}
     700
     701sub create_db {
     702    my $self= shift (@_);
     703    my $db_name = $self->{'site_name'};
     704    my $dbh = $self->{'db_handle'};
     705   
     706    # https://stackoverflow.com/questions/5025768/how-can-i-create-a-mysql-database-from-a-perl-script
     707    return $dbh->do("create database $db_name"); # do() will return undef on fail, https://metacpan.org/pod/DBI#do
     708}
     709
     710sub create_metadata_table {
     711    my $self= shift (@_);
     712    my $dbh = $self->{'db_handle'};
     713   
     714    my $table_name = $self->{'collection_name'} . "metadata";
     715
     716    # If using an auto incremented primary key:
     717    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));";
     718    return $dbh->do($stmt);
     719}
     720
     721# TODO: Investigate: https://dev.mysql.com/doc/search/?d=10&p=1&q=FULLTEXT
     722# 12.9.1 Natural Language Full-Text Searches
     723# to see whether we have to index the 'fulltxt' column of the 'fulltext' tables
     724# or let user edit this file, or add it as another option
     725sub create_fulltext_table {
     726    my $self= shift (@_);
     727    my $dbh = $self->{'db_handle'};
     728   
     729    my $table_name = $self->{'collection_name'} . "fulltxt";
     730
     731    # If using an auto incremented primary key:
     732    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));";
     733    return $dbh->do($stmt);
     734
     735}
     736
     737
     738# USEFUL: https://metacpan.org/pod/DBI
     739# "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."
     740
     741
     742# https://www.guru99.com/insert-into.html
     743# and https://dev.mysql.com/doc/refman/8.0/en/example-auto-increment.html
     744#     for inserting multiple rows at once
     745# https://www.perlmonks.org/bare/?node_id=316183
     746# https://metacpan.org/pod/DBI#do
     747# 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
     748# https://docstore.mik.ua/orelly/linux/dbi/ch05_05.htm
     749
     750# https://metacpan.org/pod/DBI#performance
     751# '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.'
     752sub prepare_insert_metadata_row_stmthandle {
     753    my $self = shift (@_);   
     754    my ($did, $sid, $metaname, $metavalue) = @_;
     755    my $dbh = $self->{'db_handle'};
     756   
     757    my $tablename = $self->{'colname'}."_metadata";
     758
     759    #my $stmt = "INSERT INTO $tablename (did, sid, metaname, metavalue) VALUES ('$did', '$sid', '$metaname', '$metavalue');"; # ?, ?, ?, ?
     760
     761    # using qq{} since we want $tablename placeholder to be filled in
     762    # returns Statement Handle object!
     763    my $sth = $dbh->prepare(qq{INSERT INTO $tablename (did, sid, metaname, metavalue) VALUES (?, ?, ?, ?)"}) || warn("Could not prepare insert statement for metadata table\n");
     764   
     765    return $sth;
     766}
     767
     768sub prepare_insert_fulltxt_row_stmthandle {
     769    my $self = shift (@_);
     770    my ($did, $sid, $fulltext) = @_;
     771    my $dbh = $self->{'db_handle'};
     772   
     773    my $tablename = $self->{'colname'}."_fulltxt";
     774
     775    #my $stmt = "INSERT INTO $tablename (did, sid, fulltxt) VALUES ('$did', '$sid', '$fulltext');"; ?, ?, ?
     776
     777    # using qq{} since we want $tablename placeholder to be filled in
     778    # returns Statement Handle object!
     779    my $sth = $dbh->prepare(qq{INSERT INTO $tablename (did, sid, fulltxt) VALUES (?, ?, ?)"}) || warn("Could not prepare insert statement for fulltxt table\n");
     780   
     781    return $sth;
     782}
     783
     784# I can get my version of table_exists to work, but it's not so ideal
     785# Interesting that MySQL has non-standard command to CREATE TABLE IF NOT EXISTS and DROP TABLE IF EXISTS,
     786# see https://www.perlmonks.org/bare/?node=DBI%20Recipes
     787#    The page further has a table_exists function that could work with proper comparison
     788# Couldn't get the first solution at https://www.perlmonks.org/bare/?node_id=500050 to work though
     789sub table_exists {
     790    my ($dbh,$table_name) = @_;
     791
     792    my @table_list = $dbh->tables;
     793    #my $tables_str = @table_list[0];
     794    foreach my $table (@table_list) {
     795    return 1 if ($table =~ m/$table_name/);
     796    }
     797    return 0;
     798}
    477799
    4788001;
Note: See TracChangeset for help on using the changeset viewer.