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

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

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