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

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

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