loncom/interface/lonmysql.pm - view

File: [LON-CAPA] / loncom / interface / lonmysql.pm
Revision 1.20: download - view: text, annotated - select for diffs
Mon Apr 19 21:29:15 2004 UTC (20 years ago) by matthew
Branches: MAIN
CVS tags: version_1_2_X, version_1_2_1, version_1_2_0, version_1_1_99_5, version_1_1_99_4, version_1_1_99_3, version_1_1_99_2, version_1_1_99_1, version_1_1_99_0, HEAD

&create_table: now report the error (with $dbh->errstr()) instead of
acting like we did and there was no error.

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