loncom/interface/lonmysql.pm - view

File: [LON-CAPA] / loncom / interface / lonmysql.pm
Revision 1.26: download - view: text, annotated - select for diffs
Wed Feb 9 21:21:08 2005 UTC (19 years, 3 months ago) by matthew
Branches: MAIN
CVS tags: HEAD

lonmysql.pm: Added &fix_table_name, which takes care of some of
MySQLs stupidity by prepending a '_' to table names which would
be interpreted as numbers.
Modified lontrackstudent.pm to use lonmysql and call fix_table_name

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