loncom/interface/lonmysql.pm - view

File: [LON-CAPA] / loncom / interface / lonmysql.pm
Revision 1.9: download - view: text, annotated - select for diffs
Thu Mar 13 19:08:52 2003 UTC (21 years, 3 months ago) by matthew
Branches: MAIN
CVS tags: HEAD

lonmysql:
   Added &replace_row, which is analogus to &store_row but it does a
'REPLACE' instead of 'STORE'.
   Changed somewhat the table definition.  PRIMARY KEY, KEY, INDEX,
UNIQUE [INDEX], and FULLTEXT [INDEX] are now able to be specified.
Previously only FULLTEXT was allowed.

lonsearchcat.pm:
   Updated to use new mechanism for specifying FULLTEXT indexing.

1: # The LearningOnline Network with CAPA 2: # MySQL utility functions 3: # 4: # $Id: lonmysql.pm,v 1.9 2003/03/13 19:08:52 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: 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/], 86: }); 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: 96: the fulltext element sets up the 'verbage' column for 'FULLTEXT' searching. 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: 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). 201: 202: =item Index_length 203: 204: The length of the index for the table (bytes) 205: 206: =item Data_free 207: 208: I have no idea what this is. 209: 210: =item Comment 211: 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 231: 232: The statement handler for row inserts. 233: 234: =item row_replace_sth 235: 236: The statement handler for row inserts. 237: 238: =back 239: 240: Col_order and row_insert_sth are kept internally by lonmysql and are not 241: part of the usual MySQL table information. 242: 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."; 335: if (! defined($dbh)) { 336: $debugstring = "Unable to connect to loncapa database."; 337: $errorstring = "dbh was undefined."; 338: } elsif ($dbh->err) { 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: } 370: if (exists($Tables{$_}->{'row_replace_sth'})) { 371: delete($Tables{$_}->{'row_replace_sth'}); 372: } 373: } 374: $dbh->disconnect if ($dbh); 375: $debugstring = "Disconnected from database."; 376: $dbh = undef; 377: return 1; 378: } 379: 380: ############################### 381: 382: =pod 383: 384: =item &number_of_rows() 385: 386: Input: table identifier 387: 388: Returns: the number of rows in the given table, undef on error. 389: 390: =cut 391: 392: ############################### 393: sub number_of_rows { 394: my ($table_id) = @_; 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'}; 398: } 399: 400: ############################### 401: 402: =pod 403: 404: =item &get_error() 405: 406: Inputs: none. 407: 408: Returns: The last error reported. 409: 410: =cut 411: 412: ############################### 413: sub get_error { 414: return $errorstring; 415: } 416: 417: ############################### 418: 419: =pod 420: 421: =item &get_debug() 422: 423: Inputs: none. 424: 425: Returns: A string describing the internal state of the lonmysql package. 426: 427: =cut 428: 429: ############################### 430: sub get_debug { 431: return $debugstring; 432: } 433: 434: ############################### 435: 436: =pod 437: 438: =item &update_table_info() 439: 440: Inputs: table id 441: 442: Returns: undef on error, 1 on success. 443: 444: &update_table_info updates the %Tables hash with current information about 445: the given table. 446: 447: The default MySQL table status fields are: 448: 449: Name Type Row_format 450: Max_data_length Index_length Data_free 451: Create_time Update_time Check_time 452: Avg_row_length Data_length Comment 453: Rows Auto_increment Create_options 454: 455: Additionally, "Col_order" is updated as well. 456: 457: =cut 458: 459: ############################### 460: sub update_table_info { 461: my ($table_id) = @_; 462: return undef if (! defined(&connect_to_db())); 463: my $table_status = &check_table($table_id); 464: return undef if (! defined($table_status)); 465: if (! $table_status) { 466: $errorstring = "table $table_id does not exist."; 467: return undef; 468: } 469: my $tablename = &translate_id($table_id); 470: # 471: # Get MySQLs table status information. 472: # 473: my @tabledesc = qw/ 474: Name Type Row_format Rows Avg_row_length Data_length 475: Max_data_length Index_length Data_free Auto_increment 476: Create_time Update_time Check_time Create_options Comment /; 477: my $db_command = "SHOW TABLE STATUS FROM loncapa LIKE '$tablename'"; 478: my $sth = $dbh->prepare($db_command); 479: $sth->execute(); 480: if ($sth->err) { 481: $errorstring = "$dbh ATTEMPTED:\n".$db_command."\nRESULTING ERROR:\n". 482: $sth->errstr; 483: &disconnect_from_db(); 484: return undef; 485: } 486: # 487: my @info=$sth->fetchrow_array; 488: for (my $i=0;$i<= $#info ; $i++) { 489: $Tables{$tablename}->{$tabledesc[$i]}= $info[$i]; 490: } 491: # 492: # Determine the column order 493: # 494: $db_command = "DESCRIBE $tablename"; 495: $sth = $dbh->prepare($db_command); 496: $sth->execute(); 497: if ($sth->err) { 498: $errorstring = "$dbh ATTEMPTED:\n".$db_command."\nRESULTING ERROR:\n". 499: $sth->errstr; 500: &disconnect_from_db(); 501: return undef; 502: } 503: my $aref=$sth->fetchall_arrayref; 504: $Tables{$tablename}->{'Col_order'}=[]; # Clear values. 505: # The values we want are the 'Field' entries, the first column. 506: for (my $i=0;$i< @$aref ; $i++) { 507: push @{$Tables{$tablename}->{'Col_order'}},$aref->[$i]->[0]; 508: } 509: # 510: $debugstring = "Retrieved table info for $tablename"; 511: return 1; 512: } 513: 514: ############################### 515: 516: =pod 517: 518: =item &create_table() 519: 520: Inputs: 521: table description 522: 523: Input formats: 524: 525: table description = { 526: permanent => 'yes' or 'no', 527: columns => [ 528: { name => 'colA', 529: type => mysql type, 530: restrictions => 'NOT NULL' or empty, 531: primary_key => 'yes' or empty, 532: auto_inc => 'yes' or empty, 533: }, 534: { name => 'colB', 535: ... 536: }, 537: { name => 'colC', 538: ... 539: }, 540: ], 541: 'PRIMARY KEY' => (index_col_name,...), 542: KEY => { name => 'idx_name', 543: columns => (col1,col2,..),}, 544: INDEX => { name => 'idx_name', 545: columns => (col1,col2,..),}, 546: UNIQUE => { index => 'yes', 547: name => 'idx_name', 548: columns => (col1,col2,..),}, 549: FULLTEXT => { index => 'yes', 550: name => 'idx_name', 551: columns => (col1,col2,..),}, 552: 553: } 554: 555: Returns: 556: undef on error, table id on success. 557: 558: =cut 559: 560: ############################### 561: sub create_table { 562: return undef if (!defined(&connect_to_db($dbh))); 563: my ($table_des)=@_; 564: # 565: # Build request to create table 566: ################################## 567: my @Columns; 568: my $col_des; 569: my $table_id; 570: if (exists($table_des->{'id'})) { 571: $table_id = $table_des->{'id'}; 572: } else { 573: $table_id = &get_new_table_id(); 574: } 575: my $tablename = &translate_id($table_id); 576: my $request = "CREATE TABLE IF NOT EXISTS ".$tablename." "; 577: foreach my $coldata (@{$table_des->{'columns'}}) { 578: my $column = $coldata->{'name'}; 579: next if (! defined($column)); 580: $col_des = ''; 581: if (lc($coldata->{'type'}) =~ /(enum|set)/) { # 'enum' or 'set' 582: $col_des.=$column." ".$coldata->{'type'}."('". 583: join("', '",@{$coldata->{'values'}})."')"; 584: } else { 585: $col_des.=$column." ".$coldata->{'type'}; 586: if (exists($coldata->{'size'})) { 587: $col_des.="(".$coldata->{'size'}.")"; 588: } 589: } 590: # Modifiers 591: if (exists($coldata->{'restrictions'})){ 592: $col_des.=" ".$coldata->{'restrictions'}; 593: } 594: if (exists($coldata->{'default'})) { 595: $col_des.=" DEFAULT '".$coldata->{'default'}."'"; 596: } 597: $col_des.=' AUTO_INCREMENT' if (exists($coldata->{'auto_inc'}) && 598: ($coldata->{'auto_inc'} eq 'yes')); 599: $col_des.=' PRIMARY KEY' if (exists($coldata->{'primary_key'}) && 600: ($coldata->{'primary_key'} eq 'yes')); 601: } continue { 602: # skip blank items. 603: push (@Columns,$col_des) if ($col_des ne ''); 604: } 605: if (exists($table_des->{'PRIMARY KEY'})) { 606: push (@Columns,'PRIMARY KEY ('.join(',',@{$table_des->{'PRIMARY KEY'}}) 607: .')'); 608: } 609: foreach ('KEY','INDEX') { 610: if (exists($table_des->{$_})) { 611: my $text = $_.' '; 612: if (exists($table_des->{$_}->{'name'})) { 613: $text .=$table_des->{$_}->{'name'}; 614: } 615: $text .= ' ('.join(',',@{$table_des->{$_}->{'columns'}}).')'; 616: push (@Columns,$text); 617: } 618: } 619: foreach ('UNIQUE','FULLTEXT') { 620: if (exists($table_des->{$_})) { 621: my $text = $_.' '; 622: if (exists($table_des->{$_}->{'index'}) && 623: $table_des->{$_}->{'index'} eq 'yes') { 624: $text .= 'INDEX '; 625: } 626: if (exists($table_des->{$_}->{'name'})) { 627: $text .=$table_des->{$_}->{'name'}; 628: } 629: $text .= ' ('.join(',',@{$table_des->{$_}->{'columns'}}).')'; 630: push (@Columns,$text); 631: } 632: } 633: $request .= "(".join(", ",@Columns).") "; 634: unless($table_des->{'permanent'} eq 'yes') { 635: $request.="COMMENT = 'temporary' "; 636: } 637: $request .= "TYPE=MYISAM"; 638: # 639: # Execute the request to create the table 640: ############################################# 641: my $count = $dbh->do($request); 642: if (! defined($count)) { 643: $errorstring = "$dbh ATTEMPTED:\n".$request."\nRESULTING ERROR:\n"; 644: return undef; 645: } 646: # 647: # Set up the internal bookkeeping 648: ############################################# 649: delete($Tables{$tablename}) if (exists($Tables{$tablename})); 650: return undef if (! defined(&update_table_info($table_id))); 651: $debugstring = "Created table $tablename at time ".time. 652: " with request\n$request"; 653: return $table_id; 654: } 655: 656: ############################### 657: 658: =pod 659: 660: =item &get_new_table_id() 661: 662: Used internally to prevent table name collisions. 663: 664: =cut 665: 666: ############################### 667: sub get_new_table_id { 668: my $newid = 0; 669: my @tables = &tables_in_db(); 670: foreach (@tables) { 671: if (/^$ENV{'user.name'}_$ENV{'user.domain'}_(\d+)$/) { 672: $newid = $1 if ($1 > $newid); 673: } 674: } 675: return ++$newid; 676: } 677: 678: ############################### 679: 680: =pod 681: 682: =item &get_rows() 683: 684: Inputs: $table_id,$condition 685: 686: Returns: undef on error, an array ref to (array of) results on success. 687: 688: Internally, this function does a 'SELECT * FROM table WHERE $condition'. 689: $condition = 'id>0' will result in all rows where column 'id' has a value 690: greater than 0 being returned. 691: 692: =cut 693: 694: ############################### 695: sub get_rows { 696: my ($table_id,$condition) = @_; 697: return undef if (! defined(&connect_to_db())); 698: my $table_status = &check_table($table_id); 699: return undef if (! defined($table_status)); 700: if (! $table_status) { 701: $errorstring = "table $table_id does not exist."; 702: return undef; 703: } 704: my $tablename = &translate_id($table_id); 705: my $request; 706: if (defined($condition) && $condition ne '') { 707: $request = 'SELECT * FROM '.$tablename.' WHERE '.$condition; 708: } else { 709: $request = 'SELECT * FROM '.$tablename; 710: $condition = 'no condition'; 711: } 712: my $sth=$dbh->prepare($request); 713: $sth->execute(); 714: if ($sth->err) { 715: $errorstring = "$dbh ATTEMPTED:\n".$request."\nRESULTING ERROR:\n". 716: $sth->errstr; 717: $debugstring = "Failed to get rows matching $condition"; 718: return undef; 719: } 720: $debugstring = "Got rows matching $condition"; 721: my @Results = @{$sth->fetchall_arrayref}; 722: return @Results; 723: } 724: 725: ############################### 726: 727: =pod 728: 729: =item &store_row() 730: 731: Inputs: table id, row data 732: 733: returns undef on error, 1 on success. 734: 735: =cut 736: 737: ############################### 738: sub store_row { 739: my ($table_id,$rowdata) = @_; 740: # 741: return undef if (! defined(&connect_to_db())); 742: my $table_status = &check_table($table_id); 743: return undef if (! defined($table_status)); 744: if (! $table_status) { 745: $errorstring = "table $table_id does not exist."; 746: return undef; 747: } 748: # 749: my $tablename = &translate_id($table_id); 750: # 751: my $sth; 752: if (exists($Tables{$tablename}->{'row_insert_sth'})) { 753: $sth = $Tables{$tablename}->{'row_insert_sth'}; 754: } else { 755: # Build the insert statement handler 756: return undef if (! defined(&update_table_info($table_id))); 757: my $insert_request = 'INSERT INTO '.$tablename.' VALUES('; 758: foreach (@{$Tables{$tablename}->{'Col_order'}}) { 759: $insert_request.="?,"; 760: } 761: chop $insert_request; 762: $insert_request.=")"; 763: $sth=$dbh->prepare($insert_request); 764: $Tables{$tablename}->{'row_insert_sth'}=$sth; 765: } 766: my @Parameters; 767: if (ref($rowdata) eq 'ARRAY') { 768: @Parameters = @$rowdata; 769: } elsif (ref($rowdata) eq 'HASH') { 770: foreach (@{$Tables{$tablename}->{'Col_order'}}) { 771: push(@Parameters,$rowdata->{$_}); 772: } 773: } 774: $sth->execute(@Parameters); 775: if ($sth->err) { 776: $errorstring = "$dbh ATTEMPTED insert @Parameters RESULTING ERROR:\n". 777: $sth->errstr; 778: return undef; 779: } 780: $debugstring = "Stored row."; 781: return 1; 782: } 783: 784: ############################### 785: 786: =pod 787: 788: =item &replace_row() 789: 790: Inputs: table id, row data 791: 792: returns undef on error, 1 on success. 793: 794: Acts like &store_row() but uses the 'REPLACE' command instead of 'INSERT'. 795: 796: =cut 797: 798: ############################### 799: sub replace_row { 800: my ($table_id,$rowdata) = @_; 801: # 802: return undef if (! defined(&connect_to_db())); 803: my $table_status = &check_table($table_id); 804: return undef if (! defined($table_status)); 805: if (! $table_status) { 806: $errorstring = "table $table_id does not exist."; 807: return undef; 808: } 809: # 810: my $tablename = &translate_id($table_id); 811: # 812: my $sth; 813: if (exists($Tables{$tablename}->{'row_replace_sth'})) { 814: $sth = $Tables{$tablename}->{'row_replace_sth'}; 815: } else { 816: # Build the insert statement handler 817: return undef if (! defined(&update_table_info($table_id))); 818: my $replace_request = 'REPLACE INTO '.$tablename.' VALUES('; 819: foreach (@{$Tables{$tablename}->{'Col_order'}}) { 820: $replace_request.="?,"; 821: } 822: chop $replace_request; 823: $replace_request.=")"; 824: $sth=$dbh->prepare($replace_request); 825: $Tables{$tablename}->{'row_replace_sth'}=$sth; 826: } 827: my @Parameters; 828: if (ref($rowdata) eq 'ARRAY') { 829: @Parameters = @$rowdata; 830: } elsif (ref($rowdata) eq 'HASH') { 831: foreach (@{$Tables{$tablename}->{'Col_order'}}) { 832: push(@Parameters,$rowdata->{$_}); 833: } 834: } 835: $sth->execute(@Parameters); 836: if ($sth->err) { 837: $errorstring = "$dbh ATTEMPTED replace @Parameters RESULTING ERROR:\n". 838: $sth->errstr; 839: return undef; 840: } 841: $debugstring = "Stored row."; 842: return 1; 843: } 844: 845: ########################################### 846: 847: =pod 848: 849: =item &tables_in_db() 850: 851: Returns a list containing the names of all the tables in the database. 852: Returns undef on error. 853: 854: =cut 855: 856: ########################################### 857: sub tables_in_db { 858: return undef if (!defined(&connect_to_db())); 859: my $sth=$dbh->prepare('SHOW TABLES'); 860: $sth->execute(); 861: if ($sth->err) { 862: $errorstring = "$dbh ATTEMPTED:\n".'SHOW TABLES'. 863: "\nRESULTING ERROR:\n".$sth->errstr; 864: return undef; 865: } 866: my $aref = $sth->fetchall_arrayref; 867: my @table_list=(); 868: foreach (@$aref) { 869: push @table_list,$_->[0]; 870: } 871: $debugstring = "Got list of tables in DB: @table_list"; 872: return @table_list; 873: } 874: 875: ########################################### 876: 877: =pod 878: 879: =item &translate_id() 880: 881: Used internally to translate a numeric table id into a MySQL table name. 882: If the input $id contains non-numeric characters it is assumed to have 883: already been translated. 884: 885: Checks are NOT performed to see if the table actually exists. 886: 887: =cut 888: 889: ########################################### 890: sub translate_id { 891: my $id = shift; 892: # id should be a digit. If it is not a digit we assume the given id 893: # is complete and does not need to be translated. 894: return $id if ($id =~ /\D/); 895: return $ENV{'user.name'}.'_'.$ENV{'user.domain'}.'_'.$id; 896: } 897: 898: ########################################### 899: 900: =pod 901: 902: =item &check_table() 903: 904: Input: table id 905: 906: Checks to see if the requested table exists. Returns 0 (no), 1 (yes), or 907: undef (error). 908: 909: =cut 910: 911: ########################################### 912: sub check_table { 913: my $table_id = shift; 914: return undef if (!defined(&connect_to_db())); 915: # 916: $table_id = &translate_id($table_id); 917: my @Table_list = &tables_in_db(); 918: my $result = 0; 919: foreach (@Table_list) { 920: if ($_ eq $table_id) { 921: $result = 1; 922: last; 923: } 924: } 925: # If it does not exist, make sure we do not have it listed in %Tables 926: delete($Tables{$table_id}) if ((! $result) && exists($Tables{$table_id})); 927: $debugstring = "check_table returned $result for $table_id"; 928: return $result; 929: } 930: 931: ########################################### 932: 933: =pod 934: 935: =item &remove_from_table() 936: 937: Input: $table_id, $column, $value 938: 939: Returns: the number of rows deleted. undef on error. 940: 941: Executes a "delete from $tableid where $column like binary '$value'". 942: 943: =cut 944: 945: ########################################### 946: sub remove_from_table { 947: my ($table_id,$column,$value) = @_; 948: return undef if (!defined(&connect_to_db())); 949: # 950: $table_id = &translate_id($table_id); 951: my $command = 'DELETE FROM '.$table_id.' WHERE '.$dbh->quote($column). 952: " LIKE BINARY ".$dbh->quote($value); 953: my $sth = $dbh->prepare($command); 954: $sth->execute(); 955: if ($sth->err) { 956: $errorstring = "ERROR on execution of ".$command."\n".$sth->errstr; 957: return undef; 958: } 959: my $rows = $sth->rows; 960: return $rows; 961: } 962: 963: 964: 1; 965: 966: __END__; 967: 968: =pod 969: 970: =back 971: 972: =cut