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

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

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