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

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

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