File:  [LON-CAPA] / loncom / interface / lonmysql.pm
Revision 1.7: download - view: text, annotated - select for diffs
Wed Aug 21 21:29:51 2002 UTC (21 years, 9 months ago) by matthew
Branches: MAIN
CVS tags: version_0_6_2, version_0_6, HEAD
Deal cleanly with $dbh not being defined at all.  I have no idea how this
happens, but appearantly it does.

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

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