Return to lonmysql.pm CVS log

Up to [LON-CAPA] / loncom / interface

Update to drop_table to make it clear out the internal bookkeeping for
the tables it drops.

    1: # The LearningOnline Network with CAPA
    2: # MySQL utility functions
    3: #
    4: # $Id: lonmysql.pm,v 1.15 2003/06/02 17:01:05 matthew Exp $
    5: #
    6: # Copyright Michigan State University Board of Trustees
    7: #
    8: # This file is part of the LearningOnline Network with CAPA (LON-CAPA).
    9: #
   10: # LON-CAPA 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: # LON-CAPA 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 LON-CAPA; if not, write to the Free Software
   22: # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
   23: #
   24: # /home/httpd/html/adm/gpl.txt
   25: #
   26: # http://www.lon-capa.org/
   27: #
   28: ######################################################################
   29: 
   30: package Apache::lonmysql;
   31: 
   32: use strict;
   33: use DBI;
   34: use Apache::lonnet();
   35: 
   36: ######################################################################
   37: ######################################################################
   38: 
   39: =pod 
   40: 
   41: =head1 Name
   42: 
   43: lonmysql - LONCAPA MySQL utility functions
   44: 
   45: =head1 Synopsis
   46: 
   47: lonmysql contains utility functions to make accessing the mysql loncapa
   48: database easier.  
   49: 
   50: =head1 Description
   51: 
   52: lonmysql does its best to encapsulate all the database/table functions
   53: and provide a common interface.  The goal, however, is not to provide 
   54: a complete reimplementation of the DBI interface.  Instead we try to 
   55: make using mysql as painless as possible.
   56: 
   57: Each table has a numeric ID that is a parameter to most lonmysql functions.
   58: The table id is returned by &create_table.  
   59: If you lose the table id, it is lost forever.
   60: The table names in MySQL correspond to 
   61: $ENV{'user.name'}.'_'.$ENV{'user.domain'}.'_'.$table_id.  If the table id 
   62: is non-numeric, it is assumed to be the full name of a table.  If you pass
   63: the table id in a form, you MUST ensure that what you send to lonmysql is
   64: numeric, otherwise you are opening up all the tables in the MySQL database.
   65: 
   66: =over 4
   67: 
   68: =item Creating a table
   69: 
   70: To create a table, you need a description of its structure.  See the entry
   71: for &create_table for a description of what is needed.
   72: 
   73:  $table_id = &create_table({ 
   74:      id      => 'tableid',      # usually you will use the returned id
   75:      columns => (
   76:                  { name => 'id',
   77:                    type => 'INT',
   78:                    restrictions => 'NOT NULL',
   79:                    primary_key => 'yes',
   80:                    auto_inc    => 'yes'
   81:                    },
   82:                  { name => 'verbage',
   83:                    type => 'TEXT' },
   84:                  ),
   85:                        fulltext => [qw/verbage/],
   86:         });
   87: 
   88: The above command will create a table with two columns, 'id' and 'verbage'.
   89: 
   90: 'id' will be an integer which is autoincremented and non-null.
   91: 
   92: 'verbage' will be of type 'TEXT', which (conceivably) allows any length
   93: text string to be stored.  Depending on your intentions for this database,
   94: setting restrictions => 'NOT NULL' may help you avoid storing empty data.
   95: 
   96: the fulltext element sets up the 'verbage' column for 'FULLTEXT' searching.
   97: 
   98: 
   99: 
  100: =item Storing rows
  101: 
  102: Storing a row in a table requires calling &store_row($table_id,$data)
  103: 
  104: $data is either a hash reference or an array reference.  If it is an array
  105: reference, the data is passed as is (after being escaped) to the 
  106: "INSERT INTO <table> VALUES( ... )" SQL command.  If $data is a hash reference,
  107: the data will be placed into an array in the proper column order for the table
  108: and then passed to the database.
  109: 
  110: An example of inserting into the table created above is:
  111: 
  112: &store_row($table_id,[undef,'I am not a crackpot!']);
  113: 
  114: or equivalently,
  115: 
  116: &store_row($table_id,{ verbage => 'I am not a crackpot!'});
  117: 
  118: Since the above table was created with the first column ('id') as 
  119: autoincrement, providing a value is unnecessary even though the column was
  120: marked as 'NOT NULL'.
  121: 
  122: 
  123: 
  124: =item Retrieving rows
  125: 
  126: Retrieving rows requires calling get_rows:
  127: 
  128: @row = &Apache::lonmysql::get_rows($table_id,$condition)
  129: 
  130: This results in the query "SELECT * FROM <table> HAVING $condition".
  131: 
  132: @row = &Apache::lonmysql::get_rows($table_id,'id>20'); 
  133: 
  134: returns all rows with column 'id' greater than 20.
  135: 
  136: =back
  137: 
  138: =cut
  139: 
  140: ######################################################################
  141: ######################################################################
  142: =pod
  143: 
  144: =head1 Package Variables
  145: 
  146: =over 4
  147: 
  148: =cut
  149: 
  150: ##################################################
  151: ##################################################
  152: 
  153: =pod
  154: 
  155: =item %Tables
  156: 
  157: Holds information regarding the currently open connections.  Each key
  158: in the %Tables hash will be a unique table key.  The value associated 
  159: with a key is a hash reference.  Most values are initialized when the 
  160: table is created.
  161: 
  162: The following entries are allowed in the hash reference:
  163: 
  164: =over 4
  165: 
  166: =item Name
  167: 
  168: Table name.
  169: 
  170: =item Type            
  171: 
  172: The type of table, typically MyISAM.
  173: 
  174: =item Row_format
  175: 
  176: Describes how rows should be stored in the table.  DYNAMIC or STATIC.
  177: 
  178: =item Create_time
  179: 
  180: The date of the tables creation.
  181: 
  182: =item Update_time
  183: 
  184: The date of the last modification of the table.
  185: 
  186: =item Check_time
  187: 
  188: Usually NULL. 
  189: 
  190: =item Avg_row_length
  191: 
  192: The average length of the rows.
  193: 
  194: =item Data_length
  195: 
  196: The length of the data stored in the table (bytes)
  197: 
  198: =item Max_data_length
  199: 
  200: The maximum possible size of the table (bytes).
  201: 
  202: =item Index_length
  203: 
  204: The length of the index for the table (bytes)
  205: 
  206: =item Data_free
  207: 
  208: I have no idea what this is.
  209: 
  210: =item Comment 
  211: 
  212: The comment associated with the table.
  213: 
  214: =item Rows
  215: 
  216: The number of rows in the table.
  217: 
  218: =item Auto_increment
  219: 
  220: The value of the next auto_increment field.
  221: 
  222: =item Create_options
  223: 
  224: I have no idea.
  225: 
  226: =item Col_order
  227: 
  228: an array reference which holds the order of columns in the table.
  229: 
  230: =item row_insert_sth 
  231: 
  232: The statement handler for row inserts.
  233: 
  234: =item row_replace_sth 
  235: 
  236: The statement handler for row inserts.
  237: 
  238: =back
  239: 
  240: Col_order and row_insert_sth are kept internally by lonmysql and are not
  241: part of the usual MySQL table information.
  242: 
  243: =cut
  244: 
  245: ##################################################
  246: ##################################################
  247: my %Tables;
  248: 
  249: ##################################################
  250: ##################################################
  251: =pod
  252: 
  253: =item $errorstring
  254: 
  255: Holds the last error.
  256: 
  257: =cut
  258: ##################################################
  259: ##################################################
  260: my $errorstring;
  261: 
  262: ##################################################
  263: ##################################################
  264: =pod
  265: 
  266: =item $debugstring
  267: 
  268: Describes current events within the package.
  269: 
  270: =cut
  271: ##################################################
  272: ##################################################
  273: my $debugstring;
  274: 
  275: ##################################################
  276: ##################################################
  277: 
  278: =pod
  279: 
  280: =item $dbh
  281: 
  282: The database handler; The actual connection to MySQL via the perl DBI.
  283: 
  284: =cut
  285: 
  286: ##################################################
  287: ##################################################
  288: my $dbh;
  289: 
  290: ##################################################
  291: ##################################################
  292: 
  293: # End of global variable declarations
  294: 
  295: =pod
  296: 
  297: =back
  298: 
  299: =cut
  300: 
  301: ######################################################################
  302: ######################################################################
  303: 
  304: =pod
  305: 
  306: =head1 Internals
  307: 
  308: =over 4
  309: 
  310: =cut
  311: 
  312: ######################################################################
  313: ######################################################################
  314: 
  315: =pod
  316: 
  317: =item &connect_to_db()
  318: 
  319: Inputs: none.  
  320: 
  321: Returns: undef on error, 1 on success.
  322: 
  323: Checks to make sure the database has been connected to.  If not, the
  324: connection is established.  
  325: 
  326: =cut
  327: 
  328: ###############################
  329: sub connect_to_db { 
  330:     return 1 if ($dbh);
  331:     if (! ($dbh = DBI->connect("DBI:mysql:loncapa","www",
  332:                                $Apache::lonnet::perlvar{'lonSqlAccess'},
  333:                                { RaiseError=>0,PrintError=>0}))) {
  334:         $debugstring = "Unable to connect to loncapa database.";    
  335:         if (! defined($dbh)) {
  336:             $debugstring = "Unable to connect to loncapa database.";
  337:             $errorstring = "dbh was undefined.";
  338:         } elsif ($dbh->err) {
  339:             $errorstring = "Connection error: ".$dbh->errstr;
  340:         }
  341:         return undef;
  342:     }
  343:     $debugstring = "Successfully connected to loncapa database.";    
  344:     return 1;
  345: }
  346: 
  347: ###############################
  348: 
  349: =pod
  350: 
  351: =item &verify_sql_connection()
  352: 
  353: Inputs: none.
  354: 
  355: Returns: 0 (failure) or 1 (success)
  356: 
  357: Checks to make sure the database can be connected to.  It does not
  358: initialize anything in the lonmysql package.
  359: 
  360: =cut
  361: 
  362: ###############################
  363: sub verify_sql_connection {
  364:     my $connection;
  365:     if (! ($connection = DBI->connect("DBI:mysql:loncapa","www",
  366:                                       $Apache::lonnet::perlvar{'lonSqlAccess'},
  367:                                       { RaiseError=>0,PrintError=>0}))) {
  368:         return 0;
  369:     }
  370:     undef($connection);
  371:     return 1;
  372: }
  373: 
  374: ###############################
  375: 
  376: =pod
  377: 
  378: =item &disconnect_from_db()
  379: 
  380: Inputs: none.
  381: 
  382: Returns: Always returns 1.
  383: 
  384: Severs the connection to the mysql database.
  385: 
  386: =cut
  387: 
  388: ###############################
  389: sub disconnect_from_db { 
  390:     foreach (keys(%Tables)) {
  391:         # Supposedly, having statement handlers running around after the
  392:         # database connection has been lost will cause trouble.  So we 
  393:         # kill them off just to be sure.
  394:         if (exists($Tables{$_}->{'row_insert_sth'})) {
  395:             delete($Tables{$_}->{'row_insert_sth'});
  396:         }
  397:         if (exists($Tables{$_}->{'row_replace_sth'})) {
  398:             delete($Tables{$_}->{'row_replace_sth'});
  399:         }
  400:     }
  401:     $dbh->disconnect if ($dbh);
  402:     $debugstring = "Disconnected from database.";
  403:     $dbh = undef;
  404:     return 1;
  405: }
  406: 
  407: ###############################
  408: 
  409: =pod
  410: 
  411: =item &number_of_rows()
  412: 
  413: Input: table identifier
  414: 
  415: Returns: the number of rows in the given table, undef on error.
  416: 
  417: =cut
  418: 
  419: ###############################
  420: sub number_of_rows { 
  421:     my ($table_id) = @_;
  422:     return undef if (! defined(&connect_to_db()));
  423:     return undef if (! defined(&update_table_info($table_id)));
  424:     return $Tables{&translate_id($table_id)}->{'Rows'};
  425: }
  426: ###############################
  427: 
  428: =pod
  429: 
  430: =item &get_dbh()
  431: 
  432: Input: nothing
  433: 
  434: Returns: the database handler, or undef on error.
  435: 
  436: This routine allows the programmer to gain access to the database handler.
  437: Be careful.
  438: 
  439: =cut
  440: 
  441: ###############################
  442: sub get_dbh { 
  443:     return undef if (! defined(&connect_to_db()));
  444:     return $dbh;
  445: }
  446: 
  447: ###############################
  448: 
  449: =pod
  450: 
  451: =item &get_error()
  452: 
  453: Inputs: none.
  454: 
  455: Returns: The last error reported.
  456: 
  457: =cut
  458: 
  459: ###############################
  460: sub get_error {
  461:     return $errorstring;
  462: }
  463: 
  464: ###############################
  465: 
  466: =pod
  467: 
  468: =item &get_debug()
  469: 
  470: Inputs: none.
  471: 
  472: Returns: A string describing the internal state of the lonmysql package.
  473: 
  474: =cut
  475: 
  476: ###############################
  477: sub get_debug {
  478:     return $debugstring;
  479: }
  480: 
  481: ###############################
  482: 
  483: =pod
  484: 
  485: =item &update_table_info()
  486: 
  487: Inputs: table id
  488: 
  489: Returns: undef on error, 1 on success.
  490: 
  491: &update_table_info updates the %Tables hash with current information about
  492: the given table.  
  493: 
  494: The default MySQL table status fields are:
  495: 
  496:    Name             Type            Row_format
  497:    Max_data_length  Index_length    Data_free
  498:    Create_time      Update_time     Check_time
  499:    Avg_row_length   Data_length     Comment 
  500:    Rows             Auto_increment  Create_options
  501: 
  502: Additionally, "Col_order" is updated as well.
  503: 
  504: =cut
  505: 
  506: ###############################
  507: sub update_table_info { 
  508:     my ($table_id) = @_;
  509:     return undef if (! defined(&connect_to_db()));
  510:     my $table_status = &check_table($table_id);
  511:     return undef if (! defined($table_status));
  512:     if (! $table_status) {
  513:         $errorstring = "table $table_id does not exist.";
  514:         return undef;
  515:     }
  516:     my $tablename = &translate_id($table_id);
  517:     #
  518:     # Get MySQLs table status information.
  519:     #
  520:     my @tabledesc = qw/
  521:         Name Type Row_format Rows Avg_row_length Data_length
  522:             Max_data_length Index_length Data_free Auto_increment 
  523:                 Create_time Update_time Check_time Create_options Comment /;
  524:     my $db_command = "SHOW TABLE STATUS FROM loncapa LIKE '$tablename'";
  525:     my $sth = $dbh->prepare($db_command);
  526:     $sth->execute();
  527:     if ($sth->err) {
  528:         $errorstring = "$dbh ATTEMPTED:\n".$db_command."\nRESULTING ERROR:\n".
  529:             $sth->errstr;
  530:         &disconnect_from_db();
  531:         return undef;
  532:     }
  533:     #
  534:     my @info=$sth->fetchrow_array;
  535:     for (my $i=0;$i<= $#info ; $i++) {
  536:         $Tables{$tablename}->{$tabledesc[$i]}= $info[$i];
  537:     }
  538:     #
  539:     # Determine the column order
  540:     #
  541:     $db_command = "DESCRIBE $tablename";
  542:     $sth = $dbh->prepare($db_command);
  543:     $sth->execute();
  544:     if ($sth->err) {
  545:         $errorstring = "$dbh ATTEMPTED:\n".$db_command."\nRESULTING ERROR:\n".
  546:             $sth->errstr;
  547:         &disconnect_from_db();
  548:         return undef;
  549:     }
  550:     my $aref=$sth->fetchall_arrayref;
  551:     $Tables{$tablename}->{'Col_order'}=[]; # Clear values.
  552:     # The values we want are the 'Field' entries, the first column.
  553:     for (my $i=0;$i< @$aref ; $i++) {
  554:         push @{$Tables{$tablename}->{'Col_order'}},$aref->[$i]->[0];
  555:     }
  556:     #
  557:     $debugstring = "Retrieved table info for $tablename";
  558:     return 1;
  559: }
  560: 
  561: ###############################
  562: 
  563: =pod
  564: 
  565: =item &create_table()
  566: 
  567: Inputs: 
  568:     table description
  569: 
  570: Input formats:
  571: 
  572:     table description = {
  573:         permanent  => 'yes' or 'no',
  574:         columns => [
  575:                     { name         => 'colA',
  576:                       type         => mysql type,
  577:                       restrictions => 'NOT NULL' or empty,
  578:                       primary_key  => 'yes' or empty,
  579:                       auto_inc     => 'yes' or empty,
  580:                   },
  581:                     { name => 'colB',
  582:                       ...
  583:                   },
  584:                     { name => 'colC',
  585:                       ...
  586:                   },
  587:         ],
  588:         'PRIMARY KEY' => (index_col_name,...),
  589:          KEY => [{ name => 'idx_name', 
  590:                   columns => (col1,col2,..),},],
  591:          INDEX => [{ name => 'idx_name', 
  592:                     columns => (col1,col2,..),},],
  593:          UNIQUE => [{ index => 'yes',
  594:                      name => 'idx_name',
  595:                      columns => (col1,col2,..),},],
  596:          FULLTEXT => [{ index => 'yes',
  597:                        name => 'idx_name',
  598:                        columns => (col1,col2,..),},],
  599: 
  600:     }
  601: 
  602: Returns:
  603:     undef on error, table id on success.
  604: 
  605: =cut
  606: 
  607: ###############################
  608: sub create_table {
  609:     return undef if (!defined(&connect_to_db($dbh)));
  610:     my ($table_des)=@_;
  611:     #
  612:     # Build request to create table
  613:     ##################################
  614:     my @Columns;
  615:     my $col_des;
  616:     my $table_id;
  617:     if (exists($table_des->{'id'})) {
  618:         $table_id = $table_des->{'id'};
  619:     } else {
  620:         $table_id = &get_new_table_id();
  621:     }
  622:     my $tablename = &translate_id($table_id);
  623:     my $request = "CREATE TABLE IF NOT EXISTS ".$tablename." ";
  624:     foreach my $coldata (@{$table_des->{'columns'}}) {
  625:         my $column = $coldata->{'name'};
  626:         next if (! defined($column));
  627:         $col_des = '';
  628:         if (lc($coldata->{'type'}) =~ /(enum|set)/) { # 'enum' or 'set'
  629:             $col_des.=$column." ".$coldata->{'type'}."('".
  630:                 join("', '",@{$coldata->{'values'}})."')";
  631:         } else {
  632:             $col_des.=$column." ".$coldata->{'type'};
  633:             if (exists($coldata->{'size'})) {
  634:                 $col_des.="(".$coldata->{'size'}.")";
  635:             }
  636:         }
  637:         # Modifiers
  638:         if (exists($coldata->{'restrictions'})){
  639:             $col_des.=" ".$coldata->{'restrictions'};
  640:         }
  641:         if (exists($coldata->{'default'})) {
  642:             $col_des.=" DEFAULT '".$coldata->{'default'}."'";
  643:         }
  644:         $col_des.=' AUTO_INCREMENT' if (exists($coldata->{'auto_inc'}) &&
  645:                                         ($coldata->{'auto_inc'} eq 'yes'));
  646:         $col_des.=' PRIMARY KEY'    if (exists($coldata->{'primary_key'}) &&
  647:                                         ($coldata->{'primary_key'} eq 'yes'));
  648:     } continue {
  649:         # skip blank items.
  650:         push (@Columns,$col_des) if ($col_des ne '');
  651:     }
  652:     if (exists($table_des->{'PRIMARY KEY'})) {
  653:         push (@Columns,'PRIMARY KEY ('.join(',',@{$table_des->{'PRIMARY KEY'}})
  654:               .')');
  655:     }
  656:     #
  657:     foreach my $indextype ('KEY','INDEX') {
  658:         next if (!exists($table_des->{$indextype}));
  659:         foreach my $indexdescription (@{$table_des->{$indextype}}) {
  660:             my $text = $indextype.' ';
  661:             if (exists($indexdescription->{'name'})) {
  662:                 $text .=$indexdescription->{'name'};
  663:             }
  664:             $text .= ' ('.join(',',@{$indexdescription->{'columns'}}).')';
  665:             push (@Columns,$text);
  666:         }
  667:     }
  668:     #
  669:     foreach my $indextype ('UNIQUE','FULLTEXT') {
  670:         next if (! exists($table_des->{$indextype}));
  671:         foreach my $indexdescription (@{$table_des->{$indextype}}) {
  672:             my $text = $indextype.' ';
  673:             if (exists($indexdescription->{'index'}) &&
  674:                 $indexdescription->{'index'} eq 'yes') {
  675:                 $text .= 'INDEX ';
  676:             }
  677:             if (exists($indexdescription->{'name'})) {
  678:                 $text .=$indexdescription->{'name'};
  679:             }
  680:             $text .= ' ('.join(',',@{$indexdescription->{'columns'}}).')';
  681:             push (@Columns,$text);
  682:         }
  683:     }
  684:     #
  685:     $request .= "(".join(", ",@Columns).") ";
  686:     unless($table_des->{'permanent'} eq 'yes') {
  687:         $request.="COMMENT = 'temporary' ";
  688:     } 
  689:     $request .= "TYPE=MYISAM";
  690:     #
  691:     # Execute the request to create the table
  692:     #############################################
  693:     my $count = $dbh->do($request);
  694:     if (! defined($count)) {
  695:         $errorstring = "$dbh ATTEMPTED:\n".$request."\nRESULTING ERROR:\n";
  696:         return undef;
  697:     }
  698:     #
  699:     # Set up the internal bookkeeping
  700:     #############################################
  701:     delete($Tables{$tablename}) if (exists($Tables{$tablename}));
  702:     return undef if (! defined(&update_table_info($table_id)));
  703:     $debugstring = "Created table $tablename at time ".time.
  704:         " with request\n$request";
  705:     return $table_id;
  706: }
  707: 
  708: ###############################
  709: 
  710: =pod
  711: 
  712: =item &get_new_table_id()
  713: 
  714: Used internally to prevent table name collisions.
  715: 
  716: =cut
  717: 
  718: ###############################
  719: sub get_new_table_id {
  720:     my $newid = 0;
  721:     my @tables = &tables_in_db();
  722:     foreach (@tables) {
  723:         if (/^$ENV{'user.name'}_$ENV{'user.domain'}_(\d+)$/) {
  724:             $newid = $1 if ($1 > $newid);
  725:         }
  726:     }
  727:     return ++$newid;
  728: }
  729: 
  730: ###############################
  731: 
  732: =pod
  733: 
  734: =item &get_rows()
  735: 
  736: Inputs: $table_id,$condition
  737: 
  738: Returns: undef on error, an array ref to (array of) results on success.
  739: 
  740: Internally, this function does a 'SELECT * FROM table WHERE $condition'.
  741: $condition = 'id>0' will result in all rows where column 'id' has a value
  742: greater than 0 being returned.
  743: 
  744: =cut
  745: 
  746: ###############################
  747: sub get_rows {
  748:     my ($table_id,$condition) = @_;
  749:     return undef if (! defined(&connect_to_db()));
  750:     my $table_status = &check_table($table_id);
  751:     return undef if (! defined($table_status));
  752:     if (! $table_status) {
  753:         $errorstring = "table $table_id does not exist.";
  754:         return undef;
  755:     }
  756:     my $tablename = &translate_id($table_id);
  757:     my $request;
  758:     if (defined($condition) && $condition ne '') {
  759:         $request = 'SELECT * FROM '.$tablename.' WHERE '.$condition;
  760:     } else {
  761:         $request = 'SELECT * FROM '.$tablename;
  762:         $condition = 'no condition';
  763:     }
  764:     my $sth=$dbh->prepare($request);
  765:     $sth->execute();
  766:     if ($sth->err) {
  767:         $errorstring = "$dbh ATTEMPTED:\n".$request."\nRESULTING ERROR:\n".
  768:             $sth->errstr;
  769:         $debugstring = "Failed to get rows matching $condition";
  770:         return undef;
  771:     }
  772:     $debugstring = "Got rows matching $condition";
  773:     my @Results = @{$sth->fetchall_arrayref};
  774:     return @Results;
  775: }
  776: 
  777: ###############################
  778: 
  779: =pod
  780: 
  781: =item &store_row()
  782: 
  783: Inputs: table id, row data
  784: 
  785: returns undef on error, 1 on success.
  786: 
  787: =cut
  788: 
  789: ###############################
  790: sub store_row {
  791:     my ($table_id,$rowdata) = @_;
  792:     # 
  793:     return undef if (! defined(&connect_to_db()));
  794:     my $table_status = &check_table($table_id);
  795:     return undef if (! defined($table_status));
  796:     if (! $table_status) {
  797:         $errorstring = "table $table_id does not exist.";
  798:         return undef;
  799:     }
  800:     #
  801:     my $tablename = &translate_id($table_id);
  802:     #
  803:     my $sth;
  804:     if (exists($Tables{$tablename}->{'row_insert_sth'})) {
  805:         $sth = $Tables{$tablename}->{'row_insert_sth'};
  806:     } else {
  807:         # Build the insert statement handler
  808:         return undef if (! defined(&update_table_info($table_id)));
  809:         my $insert_request = 'INSERT INTO '.$tablename.' VALUES(';
  810:         foreach (@{$Tables{$tablename}->{'Col_order'}}) {
  811:             $insert_request.="?,";
  812:         }
  813:         chop $insert_request;
  814:         $insert_request.=")";
  815:         $sth=$dbh->prepare($insert_request);
  816:         $Tables{$tablename}->{'row_insert_sth'}=$sth;
  817:     }
  818:     my @Parameters; 
  819:     if (ref($rowdata) eq 'ARRAY') {
  820:         @Parameters = @$rowdata;
  821:     } elsif (ref($rowdata) eq 'HASH') {
  822:         foreach (@{$Tables{$tablename}->{'Col_order'}}) {
  823:             push(@Parameters,$rowdata->{$_});
  824:         }
  825:     } 
  826:     $sth->execute(@Parameters);
  827:     if ($sth->err) {
  828:         $errorstring = "$dbh ATTEMPTED insert @Parameters RESULTING ERROR:\n".
  829:             $sth->errstr;
  830:         return undef;
  831:     }
  832:     $debugstring = "Stored row.";    
  833:     return 1;
  834: }
  835: 
  836: ###############################
  837: 
  838: =pod
  839: 
  840: =item &replace_row()
  841: 
  842: Inputs: table id, row data
  843: 
  844: returns undef on error, 1 on success.
  845: 
  846: Acts like &store_row() but uses the 'REPLACE' command instead of 'INSERT'.
  847: 
  848: =cut
  849: 
  850: ###############################
  851: sub replace_row {
  852:     my ($table_id,$rowdata) = @_;
  853:     # 
  854:     return undef if (! defined(&connect_to_db()));
  855:     my $table_status = &check_table($table_id);
  856:     return undef if (! defined($table_status));
  857:     if (! $table_status) {
  858:         $errorstring = "table $table_id does not exist.";
  859:         return undef;
  860:     }
  861:     #
  862:     my $tablename = &translate_id($table_id);
  863:     #
  864:     my $sth;
  865:     if (exists($Tables{$tablename}->{'row_replace_sth'})) {
  866:         $sth = $Tables{$tablename}->{'row_replace_sth'};
  867:     } else {
  868:         # Build the insert statement handler
  869:         return undef if (! defined(&update_table_info($table_id)));
  870:         my $replace_request = 'REPLACE INTO '.$tablename.' VALUES(';
  871:         foreach (@{$Tables{$tablename}->{'Col_order'}}) {
  872:             $replace_request.="?,";
  873:         }
  874:         chop $replace_request;
  875:         $replace_request.=")";
  876:         $sth=$dbh->prepare($replace_request);
  877:         $Tables{$tablename}->{'row_replace_sth'}=$sth;
  878:     }
  879:     my @Parameters; 
  880:     if (ref($rowdata) eq 'ARRAY') {
  881:         @Parameters = @$rowdata;
  882:     } elsif (ref($rowdata) eq 'HASH') {
  883:         foreach (@{$Tables{$tablename}->{'Col_order'}}) {
  884:             push(@Parameters,$rowdata->{$_});
  885:         }
  886:     } 
  887:     $sth->execute(@Parameters);
  888:     if ($sth->err) {
  889:         $errorstring = "$dbh ATTEMPTED replace @Parameters RESULTING ERROR:\n".
  890:             $sth->errstr;
  891:         return undef;
  892:     }
  893:     $debugstring = "Stored row.";    
  894:     return 1;
  895: }
  896: 
  897: ###########################################
  898: 
  899: =pod
  900: 
  901: =item &tables_in_db()
  902: 
  903: Returns a list containing the names of all the tables in the database.
  904: Returns undef on error.
  905: 
  906: =cut
  907: 
  908: ###########################################
  909: sub tables_in_db {
  910:     return undef if (!defined(&connect_to_db()));
  911:     my $sth=$dbh->prepare('SHOW TABLES');
  912:     $sth->execute();
  913:     if ($sth->err) {
  914:         $errorstring = "$dbh ATTEMPTED:\n".'SHOW TABLES'.
  915:             "\nRESULTING ERROR:\n".$sth->errstr;
  916:         return undef;
  917:     }
  918:     my $aref = $sth->fetchall_arrayref;
  919:     my @table_list=();
  920:     foreach (@$aref) {
  921:         push @table_list,$_->[0];
  922:     }
  923:     $debugstring = "Got list of tables in DB: @table_list";
  924:     return @table_list;
  925: }
  926: 
  927: ###########################################
  928: 
  929: =pod
  930: 
  931: =item &translate_id()
  932: 
  933: Used internally to translate a numeric table id into a MySQL table name.
  934: If the input $id contains non-numeric characters it is assumed to have 
  935: already been translated.
  936: 
  937: Checks are NOT performed to see if the table actually exists.
  938: 
  939: =cut
  940: 
  941: ###########################################
  942: sub translate_id {
  943:     my $id = shift;
  944:     # id should be a digit.  If it is not a digit we assume the given id
  945:     # is complete and does not need to be translated.
  946:     return $id if ($id =~ /\D/);  
  947:     return $ENV{'user.name'}.'_'.$ENV{'user.domain'}.'_'.$id;
  948: }
  949: 
  950: ###########################################
  951: 
  952: =pod
  953: 
  954: =item &check_table()
  955: 
  956: Input: table id
  957: 
  958: Checks to see if the requested table exists.  Returns 0 (no), 1 (yes), or 
  959: undef (error).
  960: 
  961: =cut
  962: 
  963: ###########################################
  964: sub check_table {
  965:     my $table_id = shift;
  966:     return undef if (!defined(&connect_to_db()));
  967:     #
  968:     $table_id = &translate_id($table_id);
  969:     my @Table_list = &tables_in_db();
  970:     my $result = 0;
  971:     foreach (@Table_list) {
  972:         if ($_ eq $table_id) {
  973:             $result = 1;
  974:             last;
  975:         }
  976:     }
  977:     # If it does not exist, make sure we do not have it listed in %Tables
  978:     delete($Tables{$table_id}) if ((! $result) && exists($Tables{$table_id}));
  979:     $debugstring = "check_table returned $result for $table_id";
  980:     return $result;
  981: }
  982: 
  983: ###########################################
  984: 
  985: =pod
  986: 
  987: =item &remove_from_table()
  988: 
  989: Input: $table_id, $column, $value
  990: 
  991: Returns: the number of rows deleted.  undef on error.
  992: 
  993: Executes a "delete from $tableid where $column like binary '$value'".
  994: 
  995: =cut
  996: 
  997: ###########################################
  998: sub remove_from_table {
  999:     my ($table_id,$column,$value) = @_;
 1000:     return undef if (!defined(&connect_to_db()));
 1001:     #
 1002:     $table_id = &translate_id($table_id);
 1003:     my $command = 'DELETE FROM '.$table_id.' WHERE '.$dbh->quote($column).
 1004:         " LIKE BINARY ".$dbh->quote($value);
 1005:     my $sth = $dbh->prepare($command); 
 1006:     $sth->execute();
 1007:     if ($sth->err) {
 1008:         $errorstring = "ERROR on execution of ".$command."\n".$sth->errstr;
 1009:         return undef;
 1010:     }
 1011:     $debugstring = $command;
 1012:     my $rows = $sth->rows;
 1013:     return $rows;
 1014: }
 1015: 
 1016: ###########################################
 1017: 
 1018: =pod
 1019: 
 1020: =item drop_table($table_id)
 1021: 
 1022: Issues a 'drop table if exists' command
 1023: 
 1024: =cut
 1025: 
 1026: ###########################################
 1027: 
 1028: sub drop_table {
 1029:     my ($table_id) = @_;
 1030:     return undef if (!defined(&connect_to_db()));
 1031:     #
 1032:     $table_id = &translate_id($table_id);
 1033:     my $command = 'DROP TABLE IF EXISTS '.$table_id;
 1034:     my $sth = $dbh->prepare($command); 
 1035:     $sth->execute();
 1036:     if ($sth->err) {
 1037:         $errorstring = "ERROR on execution of ".$command."\n".$sth->errstr;
 1038:         return undef;
 1039:     }
 1040:     $debugstring = $command;
 1041:     delete($Tables{$table_id}); # remove any knowledge of the table
 1042:     return 1; # if we got here there was no error, so return a 'true' value
 1043: }
 1044: 
 1045: 1;
 1046: 
 1047: __END__;
 1048: 
 1049: =pod
 1050: 
 1051: =back
 1052: 
 1053: =cut