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