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