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

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

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