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

1.1       matthew     1: # The LearningOnline Network with CAPA
                      2: # MySQL utility functions
                      3: #
1.2     ! matthew     4: # $Id: lonmysql.pm,v 1.1 2002/07/26 16:22:24 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({ 
                     74:             columns => {
                     75:                 id => {
                     76:                     type => 'INT',
                     77:                     restrictions => 'NOT NULL',
                     78:                     primary_key => 'yes',
                     79:                     auto_inc    => 'yes'
                     80:                     }
                     81:                 verbage => { type => 'TEXT' },
                     82:                 idx_verbage => { type => 'FULLTEXT',
                     83:                                  target => 'verbage'
                     84:                                  }
                     85:             },
                     86:             column_order => [qw/id verbage idx_verbage/]
                     87:             });
                     88: 
                     89: The above command will create a table with two columns, 'id' and 'verbage'.
                     90: 
                     91: 'id' will be an integer which is autoincremented and non-null.
                     92: 
                     93: 'verbage' will be of type 'TEXT', which (conceivably) allows any length
                     94: text string to be stored.  Depending on your intentions for this database,
                     95: setting restrictions => 'NOT NULL' may help you avoid storing empty data.
                     96: 
                     97: 'idx_verbage' sets up the 'verbage' column for 'FULLTEXT' searching.
                     98: 
                     99: 
                    100: 
                    101: =item Storing rows
                    102: 
                    103: Storing a row in a table requires calling &store_row($table_id,$data)
                    104: 
                    105: $data is either a hash reference or an array reference.  If it is an array
                    106: reference, the data is passed as is (after being escaped) to the 
                    107: "INSERT INTO <table> VALUES( ... )" SQL command.  If $data is a hash reference,
                    108: the data will be placed into an array in the proper column order for the table
                    109: and then passed to the database.
                    110: 
                    111: An example of inserting into the table created above is:
                    112: 
                    113: &store_row($table_id,[undef,'I am not a crackpot!']);
                    114: 
                    115: or equivalently,
                    116: 
                    117: &store_row($table_id,{ verbage => 'I am not a crackpot!'});
                    118: 
                    119: Since the above table was created with the first column ('id') as 
                    120: autoincrement, providing a value is unnecessary even though the column was
                    121: marked as 'NOT NULL'.
                    122: 
                    123: In the future an array of arrays or hashes may be supported, but currently
                    124: the system only performs one insert at a time.  Given the nature of this 
                    125: interface, transactions (locking of the table) are not supported.
                    126: 
                    127: 
                    128: 
                    129: =item Retrieving rows
                    130: 
                    131: Retrieving rows requires calling get_rows:
                    132: 
                    133: @row = &Apache::lonmysql::get_rows($table_id,$condition)
                    134: 
                    135: This results in the query "SELECT * FROM <table> HAVING $condition".
                    136: 
                    137: @row = &Apache::lonmysql::get_rows($table_id,'id>20'); 
                    138: 
                    139: returns all rows with column 'id' greater than 20.
                    140: 
                    141: =back
                    142: 
                    143: =cut
                    144: 
                    145: ######################################################################
                    146: ######################################################################
                    147: =pod
                    148: 
                    149: =head1 Package Variables
                    150: 
                    151: =over 4
                    152: 
                    153: =cut
                    154: 
                    155: ##################################################
                    156: ##################################################
                    157: 
                    158: =pod
                    159: 
                    160: =item %Tables
                    161: 
                    162: Holds information regarding the currently open connections.  Each key
                    163: in the %Tables hash will be a unique table key.  The value associated 
                    164: with a key is a hash reference.  Most values are initialized when the 
                    165: table is created.
                    166: 
                    167: The following entries are allowed in the hash reference:
                    168: 
                    169: =over 4
                    170: 
                    171: =item columns 
                    172: 
                    173: The columns information required by &create_table.
                    174: 
                    175: =item column_order
                    176: 
                    177: Reference to an array containing the order of columns in the table.
                    178: 
                    179: =item table_info
                    180: 
                    181: Set to the results of &get_table_info.
                    182: 
                    183: =item row_insert_sth
                    184: 
                    185: The statement handler for row inserts.
                    186: 
                    187: =back
                    188: 
                    189: =cut
                    190: 
                    191: ##################################################
                    192: ##################################################
                    193: my %Tables;
                    194: 
                    195: ##################################################
                    196: ##################################################
                    197: =pod
                    198: 
                    199: =item $errorstring
                    200: 
                    201: Holds the last error.
                    202: 
                    203: =cut
                    204: ##################################################
                    205: ##################################################
                    206: my $errorstring;
                    207: 
                    208: ##################################################
                    209: ##################################################
                    210: =pod
                    211: 
                    212: =item $debugstring
                    213: 
                    214: Describes current events within the package.
                    215: 
                    216: =cut
                    217: ##################################################
                    218: ##################################################
                    219: my $debugstring;
                    220: 
                    221: ##################################################
                    222: ##################################################
                    223: 
                    224: =pod
                    225: 
                    226: =item $dbh
                    227: 
                    228: The database handler; The actual connection to MySQL via the perl DBI.
                    229: 
                    230: =cut
                    231: 
                    232: ##################################################
                    233: ##################################################
                    234: my $dbh;
                    235: 
                    236: ##################################################
                    237: ##################################################
                    238: 
                    239: # End of global variable declarations
                    240: 
                    241: =pod
                    242: 
                    243: =back
                    244: 
                    245: =cut
                    246: 
                    247: ######################################################################
                    248: ######################################################################
                    249: 
                    250: =pod
                    251: 
                    252: =head1 Internals
                    253: 
                    254: =over 4
                    255: 
                    256: =cut
                    257: 
                    258: ######################################################################
                    259: ######################################################################
                    260: 
                    261: =pod
                    262: 
                    263: =item &connect_to_db()
                    264: 
                    265: Inputs: none.  
                    266: 
                    267: Returns: undef on error, 1 on success.
                    268: 
                    269: Checks to make sure the database has been connected to.  If not, the
                    270: connection is established.  
                    271: 
                    272: =cut
                    273: 
                    274: ###############################
                    275: sub connect_to_db { 
                    276:     return 1 if ($dbh);
                    277:     if (! ($dbh = DBI->connect("DBI:mysql:loncapa","www",
                    278:                                $Apache::lonnet::perlvar{'lonSqlAccess'},
                    279:                                { RaiseError=>0,PrintError=>0}))) {
                    280:         $debugstring = "Unable to connect to loncapa database.";    
                    281:         if ($dbh->err) {
                    282:             $errorstring = "Connection error: ".$dbh->errstr;
                    283:         }
                    284:         return undef;
                    285:     }
                    286:     # The code below will let us switch to a different database.
                    287:     # my $db_command = "USE $db;";
                    288:     # my $sth = $dbh->prepare($db_command);
                    289:     # $sth->execute();
                    290:     # if ($sth->err) {
                    291:     #     # Unable to use the database.  Interesting...
                    292:     #     $dbh->disconnect;
                    293:     #     return undef;
                    294:     # }
                    295:     $debugstring = "Successfully connected to loncapa database.";    
                    296:     return 1;
                    297: }
                    298: 
                    299: ###############################
                    300: 
                    301: =pod
                    302: 
                    303: =item &disconnect_from_db()
                    304: 
                    305: Inputs: none.
                    306: 
                    307: Returns: Always returns 1.
                    308: 
                    309: Severs the connection to the mysql database.
                    310: 
                    311: =cut
                    312: 
                    313: ###############################
                    314: sub disconnect_from_db { 
                    315:     foreach (keys(%Tables)) {
                    316:         # Supposedly, having statement handlers running around after the
                    317:         # database connection has been lost will cause trouble.  So we 
                    318:         # kill them off just to be sure.
                    319:         if (exists($Tables{$_}->{'row_insert_sth'})) {
                    320:             delete($Tables{$_}->{'row_insert_sth'});
                    321:         }
                    322:     }
                    323:     $dbh->disconnect if ($dbh);
                    324:     $debugstring = "Disconnected from database.";
                    325:     $dbh = undef;
                    326:     return 1;
                    327: }
                    328: 
                    329: ###############################
                    330: 
                    331: =pod
                    332: 
1.2     ! matthew   333: =item &number_of_rows()
1.1       matthew   334: 
1.2     ! matthew   335: Input: table identifier
        !           336: 
        !           337: Returns: the number of rows in the given table.
1.1       matthew   338: 
                    339: =cut
                    340: 
                    341: ###############################
1.2     ! matthew   342: sub number_of_rows { 
        !           343:     my ($table_id) = @_;
        !           344:     # Update the table information
        !           345:     my %Table_Info = %{&get_table_info($table_id)};
        !           346:     # return the number of rows.
        !           347:     if (defined(%Table_Info)) {
        !           348:         return $Table_Info{'Rows'};
        !           349:     }
        !           350:     return undef;
1.1       matthew   351: }
                    352: 
                    353: ###############################
                    354: 
                    355: =pod
                    356: 
                    357: =item &get_error()
                    358: 
                    359: Inputs: none.
                    360: 
                    361: Returns: The last error reported.
                    362: 
                    363: =cut
                    364: 
                    365: ###############################
                    366: sub get_error {
                    367:     return $errorstring;
                    368: }
                    369: 
                    370: ###############################
                    371: 
                    372: =pod
                    373: 
                    374: =item &get_debug()
                    375: 
                    376: Inputs: none.
                    377: 
                    378: Returns: A string describing the internal state of the lonmysql package.
                    379: 
                    380: =cut
                    381: 
                    382: ###############################
                    383: sub get_debug {
                    384:     return $debugstring;
                    385: }
                    386: 
                    387: ###############################
                    388: 
                    389: =pod
                    390: 
                    391: =item &get_table_info($table_id)
                    392: 
                    393: Inputs: table id
                    394: 
                    395: Returns: undef or a pointer to a hash of data about a table.
                    396: 
                    397: &get_table_info returns all of the information it can about a table in the
                    398: form of a hash.  Currently the fields in the hash are:
                    399: 
                    400:    Name             Type            Row_format
                    401:    Max_data_length  Index_length    Data_free
                    402:    Create_time      Update_time     Check_time
                    403:    Avg_row_length   Data_length     Comment 
                    404:    Rows             Auto_increment  Create_options
                    405: 
                    406: =cut
                    407: 
                    408: ###############################
                    409: sub get_table_info { 
                    410:     my ($table_id) = @_;
                    411:     my $tablename = &translate_id($table_id);
                    412:     return undef if (! &check_table($table_id));
                    413:     my %tableinfo;
                    414:     my @tabledesc = qw/
                    415:         Name Type Row_format Rows Avg_row_length Data_length
                    416:             Max_data_length Index_length Data_free Auto_increment 
                    417:                 Create_time Update_time Check_time Create_options Comment /;
                    418:     my $db_command = "SHOW TABLE STATUS FROM loncapa LIKE '$tablename'";
                    419:     my $sth = $dbh->prepare($db_command);
                    420:     $sth->execute();
                    421:     if ($sth->err) {
                    422:         # Unable to use the database.  Interesting...
                    423:         $errorstring = "$dbh ATTEMPTED:\n".$db_command."\nRESULTING ERROR:\n".
                    424:             $sth->errstr;
                    425:         $dbh->disconnect;
                    426:         return undef;
                    427:     }
                    428:     #
                    429:     my @info=$sth->fetchrow_array;
                    430:     for (my $i=0;$i<= $#info ; $i++) {
                    431:         $tableinfo{$tabledesc[$i]}= $info[$i];
                    432:     }
                    433:     #
                    434:     $debugstring = "Retrieved table info for $tablename";
                    435:     return \%tableinfo;
                    436: }
                    437: 
                    438: ###############################
                    439: 
                    440: =pod
                    441: 
                    442: =item &create_table
                    443: 
                    444: Inputs: 
                    445:     table description
                    446: 
                    447: Input formats:
                    448: 
                    449:     table description = {
                    450:         permanent  => 'yes' or 'no',
                    451:         columns => {
                    452:             colA => {
                    453:                 type         => mysql type,
                    454:                 restrictions => 'NOT NULL' or empty,
                    455:                 primary_key  => 'yes' or empty,
                    456:                 auto_inc     => 'yes' or empty,
                    457:                 target       => 'colB' (only if type eq 'FULLTEXT'),
                    458:             }
                    459:             colB  => { .. }
                    460:             colZ  => { .. }
                    461:         },
                    462:         column_order => [ colA, colB, ..., colZ],
                    463:     }
                    464: 
                    465: Returns:
                    466:     undef on error, table id on success.
                    467: 
                    468: =cut
                    469: 
                    470: ###############################
                    471: sub create_table {
                    472:     return undef if (!&connect_to_db($dbh));
                    473:     my ($table_des)=@_;
                    474:     #
                    475:     # Build request to create table
                    476:     ##################################
                    477:     my @Columns;
                    478:     my $col_des;
                    479:     my $tableid = &get_new_table_id();
                    480:     my $tablename = &translate_id($tableid);
                    481:     my $request = "CREATE TABLE IF NOT EXISTS ".$tablename." ";
                    482:     foreach my $column (@{$table_des->{'column_order'}}) {
                    483:         $col_des = '';
                    484:         my $coldata = $table_des->{'columns'}->{$column};
                    485:         if (lc($coldata->{'type'}) eq 'fulltext') {
                    486:             $col_des.='FULLTEXT '.$column." (".$coldata->{'target'}.")";
                    487:             next; # Skip to the continue block and store the column data
                    488:         } elsif (lc($coldata->{'type'}) =~ /(enum|set)/) { # 'enum' or 'set'
                    489:             $col_des.=$column." ".$coldata->{'type'}."('".
                    490:                 join("', '",@{$coldata->{'values'}})."')";
                    491:         } else {
                    492:             $col_des.=$column." ".$coldata->{'type'};
                    493:             if (exists($coldata->{'size'})) {
                    494:                 $col_des.="(".$coldata->{'size'}.")";
                    495:             }
                    496:         }
                    497:         # Modifiers
                    498:         if (exists($coldata->{'restrictions'})){
                    499:             $col_des.=" ".$coldata->{'restrictions'};
                    500:         }
                    501:         if (exists($coldata->{'default'})) {
                    502:             $col_des.=" DEFAULT '".$coldata->{'default'}."'";
                    503:         }
                    504:         $col_des.=' AUTO_INCREMENT' if (exists($coldata->{'auto_inc'}));
                    505:         $col_des.=' PRIMARY KEY'    if (exists($coldata->{'primary_key'}));
                    506:     } continue {
                    507:         # skip blank items.
                    508:         push (@Columns,$col_des) if ($col_des ne '');
                    509:     }
                    510:     $request .= "(".join(", ",@Columns).") ";
                    511:     unless($table_des->{'permanent'} eq 'yes') {
                    512:         $request.="COMMENT = 'temporary' ";
                    513:     } 
                    514:     $request .= "TYPE=MYISAM";
                    515:     #
                    516:     # Execute the request to create the table
                    517:     #############################################
                    518:     my $count = $dbh->do($request);
                    519:     if (! defined($count)) {
                    520:         $errorstring = "$dbh ATTEMPTED:\n".$request."\nRESULTING ERROR:\n".
                    521:         return undef;
                    522:     }
                    523:     #
                    524:     # Set up the internal bookkeeping
                    525:     #############################################
                    526:     delete($Tables{$tablename}) if (exists($Tables{$tablename}));
                    527:     my @column_order_copy = @{$table_des->{'column_order'}};
                    528:     $Tables{$tablename} = { 
                    529:         columns      => $table_des->{'columns'},
                    530:         column_order => $table_des->{'column_order'},
                    531:         table_info   => &get_table_info($tableid),
                    532:     };
                    533:     $debugstring = "$dbh Created table $tablename at time ".time.
                    534:         " with request\n$request";
                    535:     return $tableid;
                    536: }
                    537: 
                    538: ###############################
                    539: 
                    540: =pod
                    541: 
                    542: =item &get_new_table_id
                    543: 
                    544: Used internally to prevent table name collisions.
                    545: 
                    546: =cut
                    547: 
                    548: ###############################
                    549: sub get_new_table_id {
                    550:     my $newid = 0;
                    551:     my $name_regex = '^'.$ENV{'user.name'}.'_'.$ENV{'user.domain'}."_(\d+)\$";
                    552:     my @tables = &tables_in_db();
                    553:     foreach (@tables) {
                    554:         if (/^$ENV{'user.name'}_$ENV{'user.domain'}_(\d+)$/) {
                    555:             $newid = $1 if ($1 > $newid);
                    556:         }
                    557:     }
                    558:     return ++$newid;
                    559: }
                    560: 
                    561: ###############################
                    562: 
                    563: =pod
                    564: 
                    565: =item &execute_db_command
                    566: 
                    567: Currently unimplemented
                    568: 
                    569: =cut
                    570: 
                    571: ###############################
                    572: sub execute_db_command {
                    573:     my ($tablename,$command) = @_;
                    574:     return 1;
                    575: }
                    576: 
                    577: ###############################
                    578: 
                    579: =pod
                    580: 
                    581: =item &get_rows
                    582: 
                    583: Inputs: $table_id,$condition
                    584: 
                    585: Returns: undef on error, an array ref to (array of) results on success.
                    586: 
1.2     ! matthew   587: Internally, this function does a 'SELECT * FROM table WHERE $condition'.
1.1       matthew   588: $condition = 'id>0' will result in all rows where column 'id' has a value
                    589: greater than 0 being returned.
                    590: 
                    591: =cut
                    592: 
                    593: ###############################
                    594: sub get_rows {
                    595:     my ($table_id,$condition) = @_;
                    596:     my $tablename = &translate_id($table_id);
1.2     ! matthew   597:     my $request = 'SELECT * FROM '.$tablename.' WHERE '.$condition;
1.1       matthew   598:     my $sth=$dbh->prepare($request);
                    599:     $sth->execute();
                    600:     if ($sth->err) {
                    601:         $errorstring = "$dbh ATTEMPTED:\n".$request."\nRESULTING ERROR:\n".
                    602:             $sth->errstr;
                    603:         $debugstring = "Failed to get rows matching $condition";
                    604:         return undef;
                    605:     }
                    606:     $debugstring = "Got rows matching $condition";
                    607:     my @Results = @{$sth->fetchall_arrayref};
                    608:     foreach my $row (@Results) {
                    609:         for(my $i=0;$i<@$row;$i++) {
                    610:             $row->[$i]=&Apache::lonnet::unescape($row->[$i]);
                    611:         }
                    612:     }
                    613:     return @Results;
                    614: }
                    615: 
                    616: ###############################
                    617: 
                    618: =pod
                    619: 
                    620: =item &store_row
                    621: 
                    622: Inputs: table id, row data
                    623: 
                    624: returns undef on error, 1 on success.
                    625: 
                    626: =cut
                    627: 
                    628: ###############################
                    629: sub store_row {
                    630:     my ($table_id,$rowdata) = @_;
                    631:     my $tablename = &translate_id($table_id);
                    632:     my $table = $Tables{$tablename};
                    633:     my $sth;
                    634:     if (exists($table->{'row_insert_sth'})) {
                    635:         $sth = $table->{'row_insert_sth'};
                    636:     } else {
                    637:         # We need to build a statement handler
                    638:         my $insert_request = 'INSERT INTO '.$tablename.' VALUES(';
                    639:         foreach (@{$table->{'column_order'}}) {
                    640:             # Skip the 'fulltext' columns.
                    641:             next if (lc($table->{'columns'}->{$_}->{'type'}) eq 'fulltext');
                    642:             $insert_request.="?,";
                    643:         }
                    644:         chop $insert_request;
                    645:         $insert_request.=")";
                    646:         $sth=$dbh->prepare($insert_request);
                    647:     }
                    648:     my @Parameters; 
                    649:     if (ref($rowdata) eq 'ARRAY') {
                    650:         @Parameters = @$rowdata;
                    651:     } elsif (ref($rowdata) eq 'HASH') {
                    652:         foreach (@{$table->{'column_order'}}) {
                    653:             # Is this appropriate?  Am I being presumptious? ACK!!!!!
                    654:             next if (lc($table->{'columns'}->{$_}->{'type'}) eq 'fulltext');
                    655:             push(@Parameters,&Apache::lonnet::escape($rowdata->{$_}));
                    656:         }
                    657:     } 
                    658:     $sth->execute(@Parameters);
                    659:     if ($sth->err) {
                    660:         $errorstring = "$dbh ATTEMPTED insert @Parameters RESULTING ERROR:\n".
                    661:             $sth->errstr;
                    662:         return undef;
                    663:     }
                    664:     $debugstring = "Stored row.";    
                    665:     return 1;
                    666: }
                    667: 
                    668: ###########################################
                    669: 
                    670: =pod
                    671: 
                    672: =item tables_in_db
                    673: 
                    674: Returns a list containing the names of all the tables in the database.
                    675: Returns undef on error.
                    676: 
                    677: =cut
                    678: 
                    679: ###########################################
                    680: sub tables_in_db {
                    681:     return undef if (! &connect_to_db()); # bail out if we cannot connect
                    682:     my $sth=$dbh->prepare('SHOW TABLES;');
                    683:     $sth->execute();
                    684:     if ($sth->err) {
                    685:         $errorstring = "$dbh ATTEMPTED:\n".'SHOW TABLES'."\nRESULTING ERROR:\n".
                    686:             $sth->errstr;
                    687:         return undef;
                    688:     }
                    689:     my $aref = $sth->fetchall_arrayref;
                    690:     my @table_list=();
                    691:     foreach (@$aref) {
                    692:         push @table_list,$_->[0];
                    693:     }
                    694:     $debugstring = "Got list of tables in DB: @table_list";
                    695:     return @table_list;
                    696: }
                    697: 
                    698: ###########################################
                    699: 
                    700: =pod
                    701: 
                    702: =item &translate_id
                    703: 
                    704: Used internally to translate a numeric table id into a MySQL table name.
                    705: If the input $id contains non-numeric characters it is assumed to have 
                    706: already been translated.
                    707: 
                    708: Checks are NOT performed to see if the table actually exists.
                    709: 
                    710: =cut
                    711: 
                    712: ###########################################
                    713: sub translate_id {
                    714:     my $id = shift;
                    715:     # id should be a digit.  If it is not a digit we assume the given id
                    716:     # is complete and does not need to be translated.
                    717:     return $id if ($id =~ /\D/);  
                    718:     return $ENV{'user.name'}.'_'.$ENV{'user.domain'}.'_'.$id;
                    719: }
                    720: 
                    721: ###########################################
                    722: 
                    723: =pod
                    724: 
                    725: =item &check_table($id)
                    726: 
                    727: Checks to see if the requested table exists.  Returns 0 (no), 1 (yes), or 
                    728: undef (error).
                    729: 
                    730: =cut
                    731: 
                    732: ###########################################
                    733: sub check_table {
                    734:     my $table_id = shift;
                    735:     $table_id = &translate_id($table_id);
                    736:     return undef if (! &connect_to_db());
                    737:     my @Table_list = &tables_in_db();
                    738:     my $result = 0;
                    739:     foreach (@Table_list) {
                    740:         if (/^$table_id$/) {
                    741:             $result = 1;
                    742:             last;
                    743:         }
                    744:     }
                    745:     # If it does not exist, make sure we do not have it listed in %Tables
                    746:     delete($Tables{$table_id}) if ((! $result) && exists($Tables{$table_id}));
                    747:     $debugstring = "check_table returned $result for $table_id";
                    748:     return $result;
                    749: }
                    750: 
                    751: 1;
                    752: 
                    753: __END__;
                    754: 

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