Annotation of loncom/interface/lonmysql.pm, revision 1.8

1.1       matthew     1: # The LearningOnline Network with CAPA
                      2: # MySQL utility functions
                      3: #
1.8     ! matthew     4: # $Id: lonmysql.pm,v 1.7 2002/08/21 21:29:51 matthew Exp $
1.1       matthew     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:             columns => {
                     75:                 id => {
                     76:                     type => 'INT',
                     77:                     restrictions => 'NOT NULL',
                     78:                     primary_key => 'yes',
                     79:                     auto_inc    => 'yes'
                     80:                     }
                     81:                 verbage => { type => 'TEXT' },
                     82:             },
1.3       matthew    83:             column_order => [qw/id verbage idx_verbage/],
                     84:             fulltext => [qw/verbage/],
                     85:         });
1.1       matthew    86: 
                     87: The above command will create a table with two columns, 'id' and 'verbage'.
                     88: 
                     89: 'id' will be an integer which is autoincremented and non-null.
                     90: 
                     91: 'verbage' will be of type 'TEXT', which (conceivably) allows any length
                     92: text string to be stored.  Depending on your intentions for this database,
                     93: setting restrictions => 'NOT NULL' may help you avoid storing empty data.
                     94: 
1.3       matthew    95: the fulltext element sets up the 'verbage' column for 'FULLTEXT' searching.
1.1       matthew    96: 
                     97: 
                     98: 
                     99: =item Storing rows
                    100: 
                    101: Storing a row in a table requires calling &store_row($table_id,$data)
                    102: 
                    103: $data is either a hash reference or an array reference.  If it is an array
                    104: reference, the data is passed as is (after being escaped) to the 
                    105: "INSERT INTO <table> VALUES( ... )" SQL command.  If $data is a hash reference,
                    106: the data will be placed into an array in the proper column order for the table
                    107: and then passed to the database.
                    108: 
                    109: An example of inserting into the table created above is:
                    110: 
                    111: &store_row($table_id,[undef,'I am not a crackpot!']);
                    112: 
                    113: or equivalently,
                    114: 
                    115: &store_row($table_id,{ verbage => 'I am not a crackpot!'});
                    116: 
                    117: Since the above table was created with the first column ('id') as 
                    118: autoincrement, providing a value is unnecessary even though the column was
                    119: marked as 'NOT NULL'.
                    120: 
                    121: 
                    122: 
                    123: =item Retrieving rows
                    124: 
                    125: Retrieving rows requires calling get_rows:
                    126: 
                    127: @row = &Apache::lonmysql::get_rows($table_id,$condition)
                    128: 
                    129: This results in the query "SELECT * FROM <table> HAVING $condition".
                    130: 
                    131: @row = &Apache::lonmysql::get_rows($table_id,'id>20'); 
                    132: 
                    133: returns all rows with column 'id' greater than 20.
                    134: 
                    135: =back
                    136: 
                    137: =cut
                    138: 
                    139: ######################################################################
                    140: ######################################################################
                    141: =pod
                    142: 
                    143: =head1 Package Variables
                    144: 
                    145: =over 4
                    146: 
                    147: =cut
                    148: 
                    149: ##################################################
                    150: ##################################################
                    151: 
                    152: =pod
                    153: 
                    154: =item %Tables
                    155: 
                    156: Holds information regarding the currently open connections.  Each key
                    157: in the %Tables hash will be a unique table key.  The value associated 
                    158: with a key is a hash reference.  Most values are initialized when the 
                    159: table is created.
                    160: 
                    161: The following entries are allowed in the hash reference:
                    162: 
                    163: =over 4
                    164: 
1.3       matthew   165: =item Name
                    166: 
                    167: Table name.
                    168: 
                    169: =item Type            
                    170: 
                    171: The type of table, typically MyISAM.
                    172: 
                    173: =item Row_format
                    174: 
                    175: Describes how rows should be stored in the table.  DYNAMIC or STATIC.
                    176: 
                    177: =item Create_time
                    178: 
                    179: The date of the tables creation.
                    180: 
                    181: =item Update_time
                    182: 
                    183: The date of the last modification of the table.
                    184: 
                    185: =item Check_time
                    186: 
                    187: Usually NULL. 
                    188: 
                    189: =item Avg_row_length
                    190: 
                    191: The average length of the rows.
                    192: 
                    193: =item Data_length
                    194: 
                    195: The length of the data stored in the table (bytes)
                    196: 
                    197: =item Max_data_length
                    198: 
                    199: The maximum possible size of the table (bytes).
1.1       matthew   200: 
1.3       matthew   201: =item Index_length
1.1       matthew   202: 
1.3       matthew   203: The length of the index for the table (bytes)
1.1       matthew   204: 
1.3       matthew   205: =item Data_free
1.1       matthew   206: 
1.3       matthew   207: I have no idea what this is.
1.1       matthew   208: 
1.3       matthew   209: =item Comment 
1.1       matthew   210: 
1.3       matthew   211: The comment associated with the table.
                    212: 
                    213: =item Rows
                    214: 
                    215: The number of rows in the table.
                    216: 
                    217: =item Auto_increment
                    218: 
                    219: The value of the next auto_increment field.
                    220: 
                    221: =item Create_options
                    222: 
                    223: I have no idea.
                    224: 
                    225: =item Col_order
                    226: 
                    227: an array reference which holds the order of columns in the table.
                    228: 
                    229: =item row_insert_sth 
1.1       matthew   230: 
                    231: The statement handler for row inserts.
                    232: 
                    233: =back
                    234: 
1.3       matthew   235: Col_order and row_insert_sth are kept internally by lonmysql and are not
                    236: part of the usual MySQL table information.
                    237: 
1.1       matthew   238: =cut
                    239: 
                    240: ##################################################
                    241: ##################################################
                    242: my %Tables;
                    243: 
                    244: ##################################################
                    245: ##################################################
                    246: =pod
                    247: 
                    248: =item $errorstring
                    249: 
                    250: Holds the last error.
                    251: 
                    252: =cut
                    253: ##################################################
                    254: ##################################################
                    255: my $errorstring;
                    256: 
                    257: ##################################################
                    258: ##################################################
                    259: =pod
                    260: 
                    261: =item $debugstring
                    262: 
                    263: Describes current events within the package.
                    264: 
                    265: =cut
                    266: ##################################################
                    267: ##################################################
                    268: my $debugstring;
                    269: 
                    270: ##################################################
                    271: ##################################################
                    272: 
                    273: =pod
                    274: 
                    275: =item $dbh
                    276: 
                    277: The database handler; The actual connection to MySQL via the perl DBI.
                    278: 
                    279: =cut
                    280: 
                    281: ##################################################
                    282: ##################################################
                    283: my $dbh;
                    284: 
                    285: ##################################################
                    286: ##################################################
                    287: 
                    288: # End of global variable declarations
                    289: 
                    290: =pod
                    291: 
                    292: =back
                    293: 
                    294: =cut
                    295: 
                    296: ######################################################################
                    297: ######################################################################
                    298: 
                    299: =pod
                    300: 
                    301: =head1 Internals
                    302: 
                    303: =over 4
                    304: 
                    305: =cut
                    306: 
                    307: ######################################################################
                    308: ######################################################################
                    309: 
                    310: =pod
                    311: 
                    312: =item &connect_to_db()
                    313: 
                    314: Inputs: none.  
                    315: 
                    316: Returns: undef on error, 1 on success.
                    317: 
                    318: Checks to make sure the database has been connected to.  If not, the
                    319: connection is established.  
                    320: 
                    321: =cut
                    322: 
                    323: ###############################
                    324: sub connect_to_db { 
                    325:     return 1 if ($dbh);
                    326:     if (! ($dbh = DBI->connect("DBI:mysql:loncapa","www",
                    327:                                $Apache::lonnet::perlvar{'lonSqlAccess'},
                    328:                                { RaiseError=>0,PrintError=>0}))) {
                    329:         $debugstring = "Unable to connect to loncapa database.";    
1.7       matthew   330:         if (! defined($dbh)) {
                    331:             $debugstring = "Unable to connect to loncapa database.";
                    332:             $errorstring = "dbh was undefined.";
                    333:         } elsif ($dbh->err) {
1.1       matthew   334:             $errorstring = "Connection error: ".$dbh->errstr;
                    335:         }
                    336:         return undef;
                    337:     }
                    338:     $debugstring = "Successfully connected to loncapa database.";    
                    339:     return 1;
                    340: }
                    341: 
                    342: ###############################
                    343: 
                    344: =pod
                    345: 
                    346: =item &disconnect_from_db()
                    347: 
                    348: Inputs: none.
                    349: 
                    350: Returns: Always returns 1.
                    351: 
                    352: Severs the connection to the mysql database.
                    353: 
                    354: =cut
                    355: 
                    356: ###############################
                    357: sub disconnect_from_db { 
                    358:     foreach (keys(%Tables)) {
                    359:         # Supposedly, having statement handlers running around after the
                    360:         # database connection has been lost will cause trouble.  So we 
                    361:         # kill them off just to be sure.
                    362:         if (exists($Tables{$_}->{'row_insert_sth'})) {
                    363:             delete($Tables{$_}->{'row_insert_sth'});
                    364:         }
                    365:     }
                    366:     $dbh->disconnect if ($dbh);
                    367:     $debugstring = "Disconnected from database.";
                    368:     $dbh = undef;
                    369:     return 1;
                    370: }
                    371: 
                    372: ###############################
                    373: 
                    374: =pod
                    375: 
1.2       matthew   376: =item &number_of_rows()
1.1       matthew   377: 
1.2       matthew   378: Input: table identifier
                    379: 
1.3       matthew   380: Returns: the number of rows in the given table, undef on error.
1.1       matthew   381: 
                    382: =cut
                    383: 
                    384: ###############################
1.2       matthew   385: sub number_of_rows { 
                    386:     my ($table_id) = @_;
1.3       matthew   387:     return undef if (! defined(&connect_to_db()));
                    388:     return undef if (! defined(&update_table_info($table_id)));
                    389:     return $Tables{&translate_id($table_id)}->{'Rows'};
1.1       matthew   390: }
                    391: 
                    392: ###############################
                    393: 
                    394: =pod
                    395: 
                    396: =item &get_error()
                    397: 
                    398: Inputs: none.
                    399: 
                    400: Returns: The last error reported.
                    401: 
                    402: =cut
                    403: 
                    404: ###############################
                    405: sub get_error {
                    406:     return $errorstring;
                    407: }
                    408: 
                    409: ###############################
                    410: 
                    411: =pod
                    412: 
                    413: =item &get_debug()
                    414: 
                    415: Inputs: none.
                    416: 
                    417: Returns: A string describing the internal state of the lonmysql package.
                    418: 
                    419: =cut
                    420: 
                    421: ###############################
                    422: sub get_debug {
                    423:     return $debugstring;
                    424: }
                    425: 
                    426: ###############################
                    427: 
                    428: =pod
                    429: 
1.8     ! matthew   430: =item &update_table_info()
1.1       matthew   431: 
                    432: Inputs: table id
                    433: 
1.3       matthew   434: Returns: undef on error, 1 on success.
1.1       matthew   435: 
1.3       matthew   436: &update_table_info updates the %Tables hash with current information about
                    437: the given table.  
                    438: 
                    439: The default MySQL table status fields are:
1.1       matthew   440: 
                    441:    Name             Type            Row_format
                    442:    Max_data_length  Index_length    Data_free
                    443:    Create_time      Update_time     Check_time
                    444:    Avg_row_length   Data_length     Comment 
                    445:    Rows             Auto_increment  Create_options
                    446: 
1.3       matthew   447: Additionally, "Col_order" is updated as well.
                    448: 
1.1       matthew   449: =cut
                    450: 
                    451: ###############################
1.3       matthew   452: sub update_table_info { 
1.1       matthew   453:     my ($table_id) = @_;
1.3       matthew   454:     return undef if (! defined(&connect_to_db()));
                    455:     my $table_status = &check_table($table_id);
                    456:     return undef if (! defined($table_status));
                    457:     if (! $table_status) {
                    458:         $errorstring = "table $table_id does not exist.";
                    459:         return undef;
                    460:     }
1.1       matthew   461:     my $tablename = &translate_id($table_id);
1.3       matthew   462:     #
                    463:     # Get MySQLs table status information.
                    464:     #
1.1       matthew   465:     my @tabledesc = qw/
                    466:         Name Type Row_format Rows Avg_row_length Data_length
                    467:             Max_data_length Index_length Data_free Auto_increment 
                    468:                 Create_time Update_time Check_time Create_options Comment /;
                    469:     my $db_command = "SHOW TABLE STATUS FROM loncapa LIKE '$tablename'";
                    470:     my $sth = $dbh->prepare($db_command);
                    471:     $sth->execute();
                    472:     if ($sth->err) {
                    473:         $errorstring = "$dbh ATTEMPTED:\n".$db_command."\nRESULTING ERROR:\n".
                    474:             $sth->errstr;
1.3       matthew   475:         &disconnect_from_db();
1.1       matthew   476:         return undef;
                    477:     }
                    478:     #
                    479:     my @info=$sth->fetchrow_array;
                    480:     for (my $i=0;$i<= $#info ; $i++) {
1.3       matthew   481:         $Tables{$tablename}->{$tabledesc[$i]}= $info[$i];
                    482:     }
                    483:     #
                    484:     # Determine the column order
                    485:     #
                    486:     $db_command = "DESCRIBE $tablename";
1.5       matthew   487:     $sth = $dbh->prepare($db_command);
1.3       matthew   488:     $sth->execute();
                    489:     if ($sth->err) {
                    490:         $errorstring = "$dbh ATTEMPTED:\n".$db_command."\nRESULTING ERROR:\n".
                    491:             $sth->errstr;
                    492:         &disconnect_from_db();
                    493:         return undef;
                    494:     }
                    495:     my $aref=$sth->fetchall_arrayref;
                    496:     $Tables{$tablename}->{'Col_order'}=[]; # Clear values.
                    497:     # The values we want are the 'Field' entries, the first column.
                    498:     for (my $i=0;$i< @$aref ; $i++) {
                    499:         push @{$Tables{$tablename}->{'Col_order'}},$aref->[$i]->[0];
1.1       matthew   500:     }
                    501:     #
                    502:     $debugstring = "Retrieved table info for $tablename";
1.3       matthew   503:     return 1;
1.1       matthew   504: }
                    505: 
                    506: ###############################
                    507: 
                    508: =pod
                    509: 
1.8     ! matthew   510: =item &create_table()
1.1       matthew   511: 
                    512: Inputs: 
                    513:     table description
                    514: 
                    515: Input formats:
                    516: 
                    517:     table description = {
                    518:         permanent  => 'yes' or 'no',
1.8     ! matthew   519:         columns => [
        !           520:                     { name         => 'colA',
        !           521:                       type         => mysql type,
        !           522:                       restrictions => 'NOT NULL' or empty,
        !           523:                       primary_key  => 'yes' or empty,
        !           524:                       auto_inc     => 'yes' or empty,
        !           525:                   },
        !           526:                     { name => 'colB',
        !           527:                       ...
        !           528:                   },
        !           529:                     { name => 'colC',
        !           530:                       ...
        !           531:                   },
        !           532:         ],
1.1       matthew   533:     }
                    534: 
                    535: Returns:
                    536:     undef on error, table id on success.
                    537: 
                    538: =cut
                    539: 
                    540: ###############################
                    541: sub create_table {
1.3       matthew   542:     return undef if (!defined(&connect_to_db($dbh)));
1.1       matthew   543:     my ($table_des)=@_;
                    544:     #
                    545:     # Build request to create table
                    546:     ##################################
                    547:     my @Columns;
                    548:     my $col_des;
1.3       matthew   549:     my $table_id = &get_new_table_id();
                    550:     my $tablename = &translate_id($table_id);
1.1       matthew   551:     my $request = "CREATE TABLE IF NOT EXISTS ".$tablename." ";
1.8     ! matthew   552:     foreach my $coldata (@{$table_des->{'columns'}}) {
        !           553:         my $column = $coldata->{'name'};
        !           554:         next if (! defined($column));
1.1       matthew   555:         $col_des = '';
1.3       matthew   556:         if (lc($coldata->{'type'}) =~ /(enum|set)/) { # 'enum' or 'set'
1.1       matthew   557:             $col_des.=$column." ".$coldata->{'type'}."('".
                    558:                 join("', '",@{$coldata->{'values'}})."')";
                    559:         } else {
                    560:             $col_des.=$column." ".$coldata->{'type'};
                    561:             if (exists($coldata->{'size'})) {
                    562:                 $col_des.="(".$coldata->{'size'}.")";
                    563:             }
                    564:         }
                    565:         # Modifiers
                    566:         if (exists($coldata->{'restrictions'})){
                    567:             $col_des.=" ".$coldata->{'restrictions'};
                    568:         }
                    569:         if (exists($coldata->{'default'})) {
                    570:             $col_des.=" DEFAULT '".$coldata->{'default'}."'";
                    571:         }
1.3       matthew   572:         $col_des.=' AUTO_INCREMENT' if (exists($coldata->{'auto_inc'}) &&
                    573:                                         ($coldata->{'auto_inc'} eq 'yes'));
                    574:         $col_des.=' PRIMARY KEY'    if (exists($coldata->{'primary_key'}) &&
                    575:                                         ($coldata->{'primary_key'} eq 'yes'));
1.1       matthew   576:     } continue {
                    577:         # skip blank items.
                    578:         push (@Columns,$col_des) if ($col_des ne '');
                    579:     }
1.4       matthew   580:     if (exists($table_des->{'fulltext'}) && (@{$table_des->{'fulltext'}})) {
1.3       matthew   581:         push (@Columns,'FULLTEXT ('.join(',',@{$table_des->{'fulltext'}}).')');
                    582:     }
1.1       matthew   583:     $request .= "(".join(", ",@Columns).") ";
                    584:     unless($table_des->{'permanent'} eq 'yes') {
                    585:         $request.="COMMENT = 'temporary' ";
                    586:     } 
                    587:     $request .= "TYPE=MYISAM";
                    588:     #
                    589:     # Execute the request to create the table
                    590:     #############################################
                    591:     my $count = $dbh->do($request);
                    592:     if (! defined($count)) {
1.3       matthew   593:         $errorstring = "$dbh ATTEMPTED:\n".$request."\nRESULTING ERROR:\n";
1.1       matthew   594:         return undef;
                    595:     }
                    596:     #
                    597:     # Set up the internal bookkeeping
                    598:     #############################################
                    599:     delete($Tables{$tablename}) if (exists($Tables{$tablename}));
1.3       matthew   600:     return undef if (! defined(&update_table_info($table_id)));
                    601:     $debugstring = "Created table $tablename at time ".time.
1.1       matthew   602:         " with request\n$request";
1.3       matthew   603:     return $table_id;
1.1       matthew   604: }
                    605: 
                    606: ###############################
                    607: 
                    608: =pod
                    609: 
1.8     ! matthew   610: =item &get_new_table_id()
1.1       matthew   611: 
                    612: Used internally to prevent table name collisions.
                    613: 
                    614: =cut
                    615: 
                    616: ###############################
                    617: sub get_new_table_id {
                    618:     my $newid = 0;
                    619:     my @tables = &tables_in_db();
                    620:     foreach (@tables) {
                    621:         if (/^$ENV{'user.name'}_$ENV{'user.domain'}_(\d+)$/) {
                    622:             $newid = $1 if ($1 > $newid);
                    623:         }
                    624:     }
                    625:     return ++$newid;
                    626: }
                    627: 
                    628: ###############################
                    629: 
                    630: =pod
                    631: 
1.8     ! matthew   632: =item &get_rows()
1.1       matthew   633: 
                    634: Inputs: $table_id,$condition
                    635: 
                    636: Returns: undef on error, an array ref to (array of) results on success.
                    637: 
1.2       matthew   638: Internally, this function does a 'SELECT * FROM table WHERE $condition'.
1.1       matthew   639: $condition = 'id>0' will result in all rows where column 'id' has a value
                    640: greater than 0 being returned.
                    641: 
                    642: =cut
                    643: 
                    644: ###############################
                    645: sub get_rows {
                    646:     my ($table_id,$condition) = @_;
1.3       matthew   647:     return undef if (! defined(&connect_to_db()));
                    648:     my $table_status = &check_table($table_id);
                    649:     return undef if (! defined($table_status));
                    650:     if (! $table_status) {
                    651:         $errorstring = "table $table_id does not exist.";
                    652:         return undef;
                    653:     }
1.1       matthew   654:     my $tablename = &translate_id($table_id);
1.2       matthew   655:     my $request = 'SELECT * FROM '.$tablename.' WHERE '.$condition;
1.1       matthew   656:     my $sth=$dbh->prepare($request);
                    657:     $sth->execute();
                    658:     if ($sth->err) {
                    659:         $errorstring = "$dbh ATTEMPTED:\n".$request."\nRESULTING ERROR:\n".
                    660:             $sth->errstr;
                    661:         $debugstring = "Failed to get rows matching $condition";
                    662:         return undef;
                    663:     }
                    664:     $debugstring = "Got rows matching $condition";
                    665:     my @Results = @{$sth->fetchall_arrayref};
                    666:     return @Results;
                    667: }
                    668: 
                    669: ###############################
                    670: 
                    671: =pod
                    672: 
1.8     ! matthew   673: =item &store_row()
1.1       matthew   674: 
                    675: Inputs: table id, row data
                    676: 
                    677: returns undef on error, 1 on success.
                    678: 
                    679: =cut
                    680: 
                    681: ###############################
                    682: sub store_row {
                    683:     my ($table_id,$rowdata) = @_;
1.3       matthew   684:     # 
                    685:     return undef if (! defined(&connect_to_db()));
                    686:     my $table_status = &check_table($table_id);
                    687:     return undef if (! defined($table_status));
                    688:     if (! $table_status) {
                    689:         $errorstring = "table $table_id does not exist.";
                    690:         return undef;
                    691:     }
                    692:     #
1.1       matthew   693:     my $tablename = &translate_id($table_id);
1.3       matthew   694:     #
1.1       matthew   695:     my $sth;
1.3       matthew   696:     if (exists($Tables{$tablename}->{'row_insert_sth'})) {
                    697:         $sth = $Tables{$tablename}->{'row_insert_sth'};
1.1       matthew   698:     } else {
1.3       matthew   699:         # Build the insert statement handler
                    700:         return undef if (! defined(&update_table_info($table_id)));
1.1       matthew   701:         my $insert_request = 'INSERT INTO '.$tablename.' VALUES(';
1.3       matthew   702:         foreach (@{$Tables{$tablename}->{'Col_order'}}) {
1.1       matthew   703:             $insert_request.="?,";
                    704:         }
                    705:         chop $insert_request;
                    706:         $insert_request.=")";
                    707:         $sth=$dbh->prepare($insert_request);
1.3       matthew   708:         $Tables{$tablename}->{'row_insert_sth'}=$sth;
1.1       matthew   709:     }
                    710:     my @Parameters; 
                    711:     if (ref($rowdata) eq 'ARRAY') {
                    712:         @Parameters = @$rowdata;
                    713:     } elsif (ref($rowdata) eq 'HASH') {
1.3       matthew   714:         foreach (@{$Tables{$tablename}->{'Col_order'}}) {
1.6       matthew   715:             push(@Parameters,$rowdata->{$_});
1.1       matthew   716:         }
                    717:     } 
                    718:     $sth->execute(@Parameters);
                    719:     if ($sth->err) {
                    720:         $errorstring = "$dbh ATTEMPTED insert @Parameters RESULTING ERROR:\n".
                    721:             $sth->errstr;
                    722:         return undef;
                    723:     }
                    724:     $debugstring = "Stored row.";    
                    725:     return 1;
                    726: }
                    727: 
                    728: ###########################################
                    729: 
                    730: =pod
                    731: 
1.8     ! matthew   732: =item &tables_in_db()
1.1       matthew   733: 
                    734: Returns a list containing the names of all the tables in the database.
                    735: Returns undef on error.
                    736: 
                    737: =cut
                    738: 
                    739: ###########################################
                    740: sub tables_in_db {
1.3       matthew   741:     return undef if (!defined(&connect_to_db()));
1.5       matthew   742:     my $sth=$dbh->prepare('SHOW TABLES');
1.1       matthew   743:     $sth->execute();
                    744:     if ($sth->err) {
1.3       matthew   745:         $errorstring = "$dbh ATTEMPTED:\n".'SHOW TABLES'.
                    746:             "\nRESULTING ERROR:\n".$sth->errstr;
1.1       matthew   747:         return undef;
                    748:     }
                    749:     my $aref = $sth->fetchall_arrayref;
                    750:     my @table_list=();
                    751:     foreach (@$aref) {
                    752:         push @table_list,$_->[0];
                    753:     }
                    754:     $debugstring = "Got list of tables in DB: @table_list";
                    755:     return @table_list;
                    756: }
                    757: 
                    758: ###########################################
                    759: 
                    760: =pod
                    761: 
1.8     ! matthew   762: =item &translate_id()
1.1       matthew   763: 
                    764: Used internally to translate a numeric table id into a MySQL table name.
                    765: If the input $id contains non-numeric characters it is assumed to have 
                    766: already been translated.
                    767: 
                    768: Checks are NOT performed to see if the table actually exists.
                    769: 
                    770: =cut
                    771: 
                    772: ###########################################
                    773: sub translate_id {
                    774:     my $id = shift;
                    775:     # id should be a digit.  If it is not a digit we assume the given id
                    776:     # is complete and does not need to be translated.
                    777:     return $id if ($id =~ /\D/);  
                    778:     return $ENV{'user.name'}.'_'.$ENV{'user.domain'}.'_'.$id;
                    779: }
                    780: 
                    781: ###########################################
                    782: 
                    783: =pod
                    784: 
1.8     ! matthew   785: =item &check_table()
        !           786: 
        !           787: Input: table id
1.1       matthew   788: 
                    789: Checks to see if the requested table exists.  Returns 0 (no), 1 (yes), or 
                    790: undef (error).
                    791: 
                    792: =cut
                    793: 
                    794: ###########################################
                    795: sub check_table {
                    796:     my $table_id = shift;
1.3       matthew   797:     return undef if (!defined(&connect_to_db()));
                    798:     #
1.1       matthew   799:     $table_id = &translate_id($table_id);
                    800:     my @Table_list = &tables_in_db();
                    801:     my $result = 0;
                    802:     foreach (@Table_list) {
                    803:         if (/^$table_id$/) {
                    804:             $result = 1;
                    805:             last;
                    806:         }
                    807:     }
                    808:     # If it does not exist, make sure we do not have it listed in %Tables
                    809:     delete($Tables{$table_id}) if ((! $result) && exists($Tables{$table_id}));
                    810:     $debugstring = "check_table returned $result for $table_id";
                    811:     return $result;
                    812: }
                    813: 
1.5       matthew   814: ###########################################
                    815: 
                    816: =pod
                    817: 
1.8     ! matthew   818: =item &remove_from_table()
        !           819: 
        !           820: Input: $table_id, $column, $value
        !           821: 
        !           822: Returns: the number of rows deleted.  undef on error.
1.5       matthew   823: 
                    824: Executes a "delete from $tableid where $column like binary '$value'".
                    825: 
                    826: =cut
                    827: 
                    828: ###########################################
                    829: sub remove_from_table {
                    830:     my ($table_id,$column,$value) = @_;
                    831:     return undef if (!defined(&connect_to_db()));
                    832:     #
                    833:     $table_id = &translate_id($table_id);
                    834:     my $command = 'DELETE FROM '.$table_id.' WHERE '.$dbh->quote($column).
                    835:         " LIKE BINARY ".$dbh->quote($value);
                    836:     my $sth = $dbh->prepare($command); 
                    837:     $sth->execute();
                    838:     if ($sth->err) {
                    839:         $errorstring = "ERROR on execution of ".$command."\n".$sth->errstr;
                    840:         return undef;
                    841:     }
                    842:     my $rows = $sth->rows;
                    843:     return $rows;
                    844: }
                    845: 
                    846: 
1.1       matthew   847: 1;
                    848: 
                    849: __END__;
1.5       matthew   850: 
                    851: =pod
                    852: 
                    853: =back
                    854: 
                    855: =cut

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>