Annotation of loncom/interface/lonmysql.pm, revision 1.22
1.1 matthew 1: # The LearningOnline Network with CAPA
2: # MySQL utility functions
3: #
1.22 ! matthew 4: # $Id: lonmysql.pm,v 1.21 2004/07/21 21:01:04 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);
35:
1.21 matthew 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 {
1.22 ! matthew 48: $mysqluser = '';
1.21 matthew 49: $mysqlpassword = '';
50: }
51: }
52: }
1.1 matthew 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({
1.9 matthew 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/],
1.3 matthew 104: });
1.1 matthew 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:
1.3 matthew 114: the fulltext element sets up the 'verbage' column for 'FULLTEXT' searching.
1.1 matthew 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:
1.3 matthew 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).
1.1 matthew 219:
1.3 matthew 220: =item Index_length
1.1 matthew 221:
1.3 matthew 222: The length of the index for the table (bytes)
1.1 matthew 223:
1.3 matthew 224: =item Data_free
1.1 matthew 225:
1.3 matthew 226: I have no idea what this is.
1.1 matthew 227:
1.3 matthew 228: =item Comment
1.1 matthew 229:
1.3 matthew 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
1.1 matthew 249:
250: The statement handler for row inserts.
251:
1.9 matthew 252: =item row_replace_sth
253:
254: The statement handler for row inserts.
255:
1.1 matthew 256: =back
257:
1.3 matthew 258: Col_order and row_insert_sth are kept internally by lonmysql and are not
259: part of the usual MySQL table information.
260:
1.1 matthew 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);
1.21 matthew 349: if (! defined($mysqluser) || ! defined($mysqlpassword)) {
350: &set_mysql_user_and_password();
351: }
352: if (! ($dbh = DBI->connect("DBI:mysql:loncapa",$mysqluser,$mysqlpassword,
1.1 matthew 353: { RaiseError=>0,PrintError=>0}))) {
354: $debugstring = "Unable to connect to loncapa database.";
1.7 matthew 355: if (! defined($dbh)) {
356: $debugstring = "Unable to connect to loncapa database.";
357: $errorstring = "dbh was undefined.";
358: } elsif ($dbh->err) {
1.1 matthew 359: $errorstring = "Connection error: ".$dbh->errstr;
360: }
361: return undef;
362: }
363: $debugstring = "Successfully connected to loncapa database.";
1.13 matthew 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 {
1.21 matthew 384: if (! defined($mysqluser) || ! defined($mysqlpassword)) {
385: &set_mysql_user_and_password();
386: }
1.13 matthew 387: my $connection;
1.21 matthew 388: if (! ($connection = DBI->connect("DBI:mysql:loncapa",
389: $mysqluser,$mysqlpassword,
1.13 matthew 390: { RaiseError=>0,PrintError=>0}))) {
391: return 0;
392: }
393: undef($connection);
1.1 matthew 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: }
1.9 matthew 420: if (exists($Tables{$_}->{'row_replace_sth'})) {
421: delete($Tables{$_}->{'row_replace_sth'});
422: }
1.1 matthew 423: }
424: $dbh->disconnect if ($dbh);
425: $debugstring = "Disconnected from database.";
426: $dbh = undef;
427: return 1;
428: }
429:
430: ###############################
431:
432: =pod
433:
1.2 matthew 434: =item &number_of_rows()
1.1 matthew 435:
1.2 matthew 436: Input: table identifier
437:
1.3 matthew 438: Returns: the number of rows in the given table, undef on error.
1.1 matthew 439:
440: =cut
441:
442: ###############################
1.2 matthew 443: sub number_of_rows {
444: my ($table_id) = @_;
1.3 matthew 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'};
1.10 matthew 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;
1.1 matthew 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:
1.8 matthew 508: =item &update_table_info()
1.1 matthew 509:
510: Inputs: table id
511:
1.3 matthew 512: Returns: undef on error, 1 on success.
1.1 matthew 513:
1.3 matthew 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:
1.1 matthew 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:
1.3 matthew 525: Additionally, "Col_order" is updated as well.
526:
1.1 matthew 527: =cut
528:
529: ###############################
1.3 matthew 530: sub update_table_info {
1.1 matthew 531: my ($table_id) = @_;
1.3 matthew 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: }
1.1 matthew 539: my $tablename = &translate_id($table_id);
1.3 matthew 540: #
541: # Get MySQLs table status information.
542: #
1.1 matthew 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;
1.3 matthew 553: &disconnect_from_db();
1.1 matthew 554: return undef;
555: }
556: #
557: my @info=$sth->fetchrow_array;
558: for (my $i=0;$i<= $#info ; $i++) {
1.3 matthew 559: $Tables{$tablename}->{$tabledesc[$i]}= $info[$i];
560: }
561: #
562: # Determine the column order
563: #
564: $db_command = "DESCRIBE $tablename";
1.5 matthew 565: $sth = $dbh->prepare($db_command);
1.3 matthew 566: $sth->execute();
567: if ($sth->err) {
568: $errorstring = "$dbh ATTEMPTED:\n".$db_command."\nRESULTING ERROR:\n".
569: $sth->errstr;
570: &disconnect_from_db();
571: return undef;
572: }
573: my $aref=$sth->fetchall_arrayref;
574: $Tables{$tablename}->{'Col_order'}=[]; # Clear values.
575: # The values we want are the 'Field' entries, the first column.
576: for (my $i=0;$i< @$aref ; $i++) {
577: push @{$Tables{$tablename}->{'Col_order'}},$aref->[$i]->[0];
1.1 matthew 578: }
579: #
580: $debugstring = "Retrieved table info for $tablename";
1.3 matthew 581: return 1;
1.1 matthew 582: }
1.18 www 583: ###############################
584:
585: =pod
586:
587: =item &col_order()
588:
589: Inputs: table id
1.1 matthew 590:
1.18 www 591: Returns: array with column order
592:
593: =cut
594:
595:
596: sub col_order {
597: my $table_id=shift;
598: if (&update_table_info($table_id)) {
599: return @{$Tables{$table_id}->{'Col_order'}};
600: } else {
601: return ();
602: }
603: }
1.21 matthew 604:
1.1 matthew 605: ###############################
606:
607: =pod
608:
1.8 matthew 609: =item &create_table()
1.1 matthew 610:
611: Inputs:
1.21 matthew 612: table description, see &build_table_creation_request
613: Returns:
614: undef on error, table id on success.
615:
616: =cut
617:
618: ###############################
619: sub create_table {
620: return undef if (!defined(&connect_to_db($dbh)));
621: my ($table_des)=@_;
622: my $request = &build_table_creation_request($table_des);
623: #
624: # Execute the request to create the table
625: #############################################
626: my $count = $dbh->do($request);
627: if (! defined($count)) {
628: $errorstring = "$dbh ATTEMPTED:\n".$request."\nRESULTING ERROR:\n".
629: $dbh->errstr();
630: return undef;
631: }
632: #
633: # Set up the internal bookkeeping
634: #############################################
635: my $table_id;
636: if (exists($table_des->{'id'})) {
637: $table_id = $table_des->{'id'};
638: } else {
639: $table_id = &get_new_table_id();
640: }
641: my $tablename = &translate_id($table_id);
642: delete($Tables{$tablename}) if (exists($Tables{$tablename}));
643: return undef if (! defined(&update_table_info($table_id)));
644: $debugstring = "Created table $tablename at time ".time.
645: " with request\n$request";
646: return $table_id;
647: }
1.1 matthew 648:
1.21 matthew 649: ###############################
650:
651: =pod
652:
653: =item build_table_creation_request
654:
655: Input: table description
1.1 matthew 656:
657: table description = {
658: permanent => 'yes' or 'no',
1.8 matthew 659: columns => [
660: { name => 'colA',
661: type => mysql type,
662: restrictions => 'NOT NULL' or empty,
663: primary_key => 'yes' or empty,
664: auto_inc => 'yes' or empty,
665: },
666: { name => 'colB',
667: ...
668: },
669: { name => 'colC',
670: ...
671: },
672: ],
1.9 matthew 673: 'PRIMARY KEY' => (index_col_name,...),
1.11 matthew 674: KEY => [{ name => 'idx_name',
675: columns => (col1,col2,..),},],
676: INDEX => [{ name => 'idx_name',
677: columns => (col1,col2,..),},],
678: UNIQUE => [{ index => 'yes',
1.9 matthew 679: name => 'idx_name',
1.11 matthew 680: columns => (col1,col2,..),},],
681: FULLTEXT => [{ index => 'yes',
1.9 matthew 682: name => 'idx_name',
1.11 matthew 683: columns => (col1,col2,..),},],
1.9 matthew 684:
1.1 matthew 685: }
686:
1.21 matthew 687: Returns: scalar string containing mysql commands to create the table
1.1 matthew 688:
689: =cut
690:
691: ###############################
1.21 matthew 692: sub build_table_creation_request {
1.1 matthew 693: my ($table_des)=@_;
694: #
695: # Build request to create table
696: ##################################
697: my @Columns;
698: my $col_des;
1.9 matthew 699: my $table_id;
700: if (exists($table_des->{'id'})) {
701: $table_id = $table_des->{'id'};
702: } else {
703: $table_id = &get_new_table_id();
704: }
1.3 matthew 705: my $tablename = &translate_id($table_id);
1.1 matthew 706: my $request = "CREATE TABLE IF NOT EXISTS ".$tablename." ";
1.8 matthew 707: foreach my $coldata (@{$table_des->{'columns'}}) {
708: my $column = $coldata->{'name'};
709: next if (! defined($column));
1.1 matthew 710: $col_des = '';
1.3 matthew 711: if (lc($coldata->{'type'}) =~ /(enum|set)/) { # 'enum' or 'set'
1.1 matthew 712: $col_des.=$column." ".$coldata->{'type'}."('".
713: join("', '",@{$coldata->{'values'}})."')";
714: } else {
715: $col_des.=$column." ".$coldata->{'type'};
716: if (exists($coldata->{'size'})) {
717: $col_des.="(".$coldata->{'size'}.")";
718: }
719: }
720: # Modifiers
721: if (exists($coldata->{'restrictions'})){
722: $col_des.=" ".$coldata->{'restrictions'};
723: }
724: if (exists($coldata->{'default'})) {
725: $col_des.=" DEFAULT '".$coldata->{'default'}."'";
726: }
1.3 matthew 727: $col_des.=' AUTO_INCREMENT' if (exists($coldata->{'auto_inc'}) &&
728: ($coldata->{'auto_inc'} eq 'yes'));
729: $col_des.=' PRIMARY KEY' if (exists($coldata->{'primary_key'}) &&
730: ($coldata->{'primary_key'} eq 'yes'));
1.1 matthew 731: } continue {
732: # skip blank items.
733: push (@Columns,$col_des) if ($col_des ne '');
734: }
1.9 matthew 735: if (exists($table_des->{'PRIMARY KEY'})) {
736: push (@Columns,'PRIMARY KEY ('.join(',',@{$table_des->{'PRIMARY KEY'}})
737: .')');
738: }
1.11 matthew 739: #
740: foreach my $indextype ('KEY','INDEX') {
741: next if (!exists($table_des->{$indextype}));
742: foreach my $indexdescription (@{$table_des->{$indextype}}) {
743: my $text = $indextype.' ';
744: if (exists($indexdescription->{'name'})) {
745: $text .=$indexdescription->{'name'};
1.9 matthew 746: }
1.11 matthew 747: $text .= ' ('.join(',',@{$indexdescription->{'columns'}}).')';
1.9 matthew 748: push (@Columns,$text);
749: }
750: }
1.11 matthew 751: #
752: foreach my $indextype ('UNIQUE','FULLTEXT') {
753: next if (! exists($table_des->{$indextype}));
754: foreach my $indexdescription (@{$table_des->{$indextype}}) {
755: my $text = $indextype.' ';
756: if (exists($indexdescription->{'index'}) &&
757: $indexdescription->{'index'} eq 'yes') {
1.9 matthew 758: $text .= 'INDEX ';
759: }
1.11 matthew 760: if (exists($indexdescription->{'name'})) {
761: $text .=$indexdescription->{'name'};
1.9 matthew 762: }
1.11 matthew 763: $text .= ' ('.join(',',@{$indexdescription->{'columns'}}).')';
1.9 matthew 764: push (@Columns,$text);
765: }
1.3 matthew 766: }
1.11 matthew 767: #
1.1 matthew 768: $request .= "(".join(", ",@Columns).") ";
769: unless($table_des->{'permanent'} eq 'yes') {
770: $request.="COMMENT = 'temporary' ";
771: }
772: $request .= "TYPE=MYISAM";
1.21 matthew 773: return $request;
1.1 matthew 774: }
775:
776: ###############################
777:
778: =pod
779:
1.8 matthew 780: =item &get_new_table_id()
1.1 matthew 781:
782: Used internally to prevent table name collisions.
783:
784: =cut
785:
786: ###############################
787: sub get_new_table_id {
788: my $newid = 0;
789: my @tables = &tables_in_db();
790: foreach (@tables) {
791: if (/^$ENV{'user.name'}_$ENV{'user.domain'}_(\d+)$/) {
792: $newid = $1 if ($1 > $newid);
793: }
794: }
795: return ++$newid;
796: }
797:
798: ###############################
799:
800: =pod
801:
1.8 matthew 802: =item &get_rows()
1.1 matthew 803:
804: Inputs: $table_id,$condition
805:
806: Returns: undef on error, an array ref to (array of) results on success.
807:
1.2 matthew 808: Internally, this function does a 'SELECT * FROM table WHERE $condition'.
1.1 matthew 809: $condition = 'id>0' will result in all rows where column 'id' has a value
810: greater than 0 being returned.
811:
812: =cut
813:
814: ###############################
815: sub get_rows {
816: my ($table_id,$condition) = @_;
1.3 matthew 817: return undef if (! defined(&connect_to_db()));
818: my $table_status = &check_table($table_id);
819: return undef if (! defined($table_status));
820: if (! $table_status) {
821: $errorstring = "table $table_id does not exist.";
822: return undef;
823: }
1.1 matthew 824: my $tablename = &translate_id($table_id);
1.9 matthew 825: my $request;
826: if (defined($condition) && $condition ne '') {
827: $request = 'SELECT * FROM '.$tablename.' WHERE '.$condition;
828: } else {
829: $request = 'SELECT * FROM '.$tablename;
830: $condition = 'no condition';
831: }
1.1 matthew 832: my $sth=$dbh->prepare($request);
833: $sth->execute();
834: if ($sth->err) {
835: $errorstring = "$dbh ATTEMPTED:\n".$request."\nRESULTING ERROR:\n".
836: $sth->errstr;
837: $debugstring = "Failed to get rows matching $condition";
838: return undef;
839: }
840: $debugstring = "Got rows matching $condition";
841: my @Results = @{$sth->fetchall_arrayref};
842: return @Results;
843: }
844:
845: ###############################
846:
847: =pod
848:
1.8 matthew 849: =item &store_row()
1.1 matthew 850:
851: Inputs: table id, row data
852:
853: returns undef on error, 1 on success.
854:
855: =cut
856:
857: ###############################
858: sub store_row {
859: my ($table_id,$rowdata) = @_;
1.3 matthew 860: #
861: return undef if (! defined(&connect_to_db()));
862: my $table_status = &check_table($table_id);
863: return undef if (! defined($table_status));
864: if (! $table_status) {
865: $errorstring = "table $table_id does not exist.";
866: return undef;
867: }
868: #
1.1 matthew 869: my $tablename = &translate_id($table_id);
1.3 matthew 870: #
1.1 matthew 871: my $sth;
1.3 matthew 872: if (exists($Tables{$tablename}->{'row_insert_sth'})) {
873: $sth = $Tables{$tablename}->{'row_insert_sth'};
1.1 matthew 874: } else {
1.3 matthew 875: # Build the insert statement handler
876: return undef if (! defined(&update_table_info($table_id)));
1.1 matthew 877: my $insert_request = 'INSERT INTO '.$tablename.' VALUES(';
1.3 matthew 878: foreach (@{$Tables{$tablename}->{'Col_order'}}) {
1.1 matthew 879: $insert_request.="?,";
880: }
881: chop $insert_request;
882: $insert_request.=")";
883: $sth=$dbh->prepare($insert_request);
1.3 matthew 884: $Tables{$tablename}->{'row_insert_sth'}=$sth;
1.1 matthew 885: }
886: my @Parameters;
887: if (ref($rowdata) eq 'ARRAY') {
888: @Parameters = @$rowdata;
889: } elsif (ref($rowdata) eq 'HASH') {
1.3 matthew 890: foreach (@{$Tables{$tablename}->{'Col_order'}}) {
1.6 matthew 891: push(@Parameters,$rowdata->{$_});
1.1 matthew 892: }
893: }
894: $sth->execute(@Parameters);
895: if ($sth->err) {
896: $errorstring = "$dbh ATTEMPTED insert @Parameters RESULTING ERROR:\n".
897: $sth->errstr;
898: return undef;
899: }
900: $debugstring = "Stored row.";
901: return 1;
902: }
903:
1.9 matthew 904: ###############################
905:
906: =pod
907:
908: =item &replace_row()
909:
910: Inputs: table id, row data
911:
912: returns undef on error, 1 on success.
913:
914: Acts like &store_row() but uses the 'REPLACE' command instead of 'INSERT'.
915:
916: =cut
917:
918: ###############################
919: sub replace_row {
920: my ($table_id,$rowdata) = @_;
921: #
922: return undef if (! defined(&connect_to_db()));
923: my $table_status = &check_table($table_id);
924: return undef if (! defined($table_status));
925: if (! $table_status) {
926: $errorstring = "table $table_id does not exist.";
927: return undef;
928: }
929: #
930: my $tablename = &translate_id($table_id);
931: #
932: my $sth;
933: if (exists($Tables{$tablename}->{'row_replace_sth'})) {
934: $sth = $Tables{$tablename}->{'row_replace_sth'};
935: } else {
936: # Build the insert statement handler
937: return undef if (! defined(&update_table_info($table_id)));
938: my $replace_request = 'REPLACE INTO '.$tablename.' VALUES(';
939: foreach (@{$Tables{$tablename}->{'Col_order'}}) {
940: $replace_request.="?,";
941: }
942: chop $replace_request;
943: $replace_request.=")";
944: $sth=$dbh->prepare($replace_request);
945: $Tables{$tablename}->{'row_replace_sth'}=$sth;
946: }
947: my @Parameters;
948: if (ref($rowdata) eq 'ARRAY') {
949: @Parameters = @$rowdata;
950: } elsif (ref($rowdata) eq 'HASH') {
951: foreach (@{$Tables{$tablename}->{'Col_order'}}) {
952: push(@Parameters,$rowdata->{$_});
953: }
954: }
955: $sth->execute(@Parameters);
956: if ($sth->err) {
957: $errorstring = "$dbh ATTEMPTED replace @Parameters RESULTING ERROR:\n".
958: $sth->errstr;
959: return undef;
960: }
961: $debugstring = "Stored row.";
962: return 1;
963: }
964:
1.1 matthew 965: ###########################################
966:
967: =pod
968:
1.8 matthew 969: =item &tables_in_db()
1.1 matthew 970:
971: Returns a list containing the names of all the tables in the database.
972: Returns undef on error.
973:
974: =cut
975:
976: ###########################################
977: sub tables_in_db {
1.3 matthew 978: return undef if (!defined(&connect_to_db()));
1.5 matthew 979: my $sth=$dbh->prepare('SHOW TABLES');
1.1 matthew 980: $sth->execute();
1.19 matthew 981: $sth->execute();
982: my $aref = $sth->fetchall_arrayref;
983: if ($sth->err()) {
984: $errorstring =
985: "$dbh ATTEMPTED:\n".'fetchall_arrayref after SHOW TABLES'.
1.3 matthew 986: "\nRESULTING ERROR:\n".$sth->errstr;
1.1 matthew 987: return undef;
988: }
1.19 matthew 989: my @table_list;
1.1 matthew 990: foreach (@$aref) {
1.19 matthew 991: push(@table_list,$_->[0]);
1.1 matthew 992: }
1.19 matthew 993: $debugstring = "Got list of tables in DB: ".join(',',@table_list);
994: return(@table_list);
1.1 matthew 995: }
996:
997: ###########################################
998:
999: =pod
1000:
1.8 matthew 1001: =item &translate_id()
1.1 matthew 1002:
1003: Used internally to translate a numeric table id into a MySQL table name.
1004: If the input $id contains non-numeric characters it is assumed to have
1005: already been translated.
1006:
1007: Checks are NOT performed to see if the table actually exists.
1008:
1009: =cut
1010:
1011: ###########################################
1012: sub translate_id {
1013: my $id = shift;
1014: # id should be a digit. If it is not a digit we assume the given id
1015: # is complete and does not need to be translated.
1016: return $id if ($id =~ /\D/);
1017: return $ENV{'user.name'}.'_'.$ENV{'user.domain'}.'_'.$id;
1018: }
1019:
1020: ###########################################
1021:
1022: =pod
1023:
1.8 matthew 1024: =item &check_table()
1025:
1026: Input: table id
1.1 matthew 1027:
1028: Checks to see if the requested table exists. Returns 0 (no), 1 (yes), or
1029: undef (error).
1030:
1031: =cut
1032:
1033: ###########################################
1034: sub check_table {
1035: my $table_id = shift;
1.3 matthew 1036: return undef if (!defined(&connect_to_db()));
1037: #
1.1 matthew 1038: $table_id = &translate_id($table_id);
1039: my @Table_list = &tables_in_db();
1040: my $result = 0;
1041: foreach (@Table_list) {
1.9 matthew 1042: if ($_ eq $table_id) {
1.1 matthew 1043: $result = 1;
1044: last;
1045: }
1046: }
1047: # If it does not exist, make sure we do not have it listed in %Tables
1048: delete($Tables{$table_id}) if ((! $result) && exists($Tables{$table_id}));
1049: $debugstring = "check_table returned $result for $table_id";
1050: return $result;
1051: }
1052:
1.5 matthew 1053: ###########################################
1054:
1055: =pod
1056:
1.8 matthew 1057: =item &remove_from_table()
1058:
1059: Input: $table_id, $column, $value
1060:
1061: Returns: the number of rows deleted. undef on error.
1.5 matthew 1062:
1063: Executes a "delete from $tableid where $column like binary '$value'".
1064:
1065: =cut
1066:
1067: ###########################################
1068: sub remove_from_table {
1069: my ($table_id,$column,$value) = @_;
1070: return undef if (!defined(&connect_to_db()));
1071: #
1072: $table_id = &translate_id($table_id);
1.17 www 1073: my $command = 'DELETE FROM '.$table_id.' WHERE '.$column.
1.5 matthew 1074: " LIKE BINARY ".$dbh->quote($value);
1075: my $sth = $dbh->prepare($command);
1.17 www 1076: unless ($sth->execute()) {
1.5 matthew 1077: $errorstring = "ERROR on execution of ".$command."\n".$sth->errstr;
1078: return undef;
1079: }
1.12 matthew 1080: $debugstring = $command;
1.5 matthew 1081: my $rows = $sth->rows;
1082: return $rows;
1083: }
1084:
1.14 matthew 1085: ###########################################
1086:
1087: =pod
1088:
1089: =item drop_table($table_id)
1090:
1091: Issues a 'drop table if exists' command
1092:
1093: =cut
1094:
1095: ###########################################
1096:
1097: sub drop_table {
1098: my ($table_id) = @_;
1099: return undef if (!defined(&connect_to_db()));
1100: #
1101: $table_id = &translate_id($table_id);
1102: my $command = 'DROP TABLE IF EXISTS '.$table_id;
1103: my $sth = $dbh->prepare($command);
1104: $sth->execute();
1105: if ($sth->err) {
1106: $errorstring = "ERROR on execution of ".$command."\n".$sth->errstr;
1107: return undef;
1108: }
1109: $debugstring = $command;
1.15 matthew 1110: delete($Tables{$table_id}); # remove any knowledge of the table
1.14 matthew 1111: return 1; # if we got here there was no error, so return a 'true' value
1112: }
1.16 www 1113:
1114:
1115:
1116:
1117: # ---------------------------- convert 'time' format into a datetime sql format
1118: sub sqltime {
1119: my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) =
1120: localtime(&unsqltime($_[0]));
1121: $mon++; $year+=1900;
1122: return "$year-$mon-$mday $hour:$min:$sec";
1123: }
1124:
1125: sub maketime {
1126: my %th=@_;
1127: return POSIX::mktime(($th{'seconds'},$th{'minutes'},$th{'hours'},
1128: $th{'day'},$th{'month'}-1,
1129: $th{'year'}-1900,0,0,$th{'dlsav'}));
1130: }
1131:
1132:
1133: #########################################
1134: #
1135: # Retro-fixing of un-backward-compatible time format
1136:
1137: sub unsqltime {
1138: my $timestamp=shift;
1139: if ($timestamp=~/^(\d+)\-(\d+)\-(\d+)\s+(\d+)\:(\d+)\:(\d+)$/) {
1140: $timestamp=&maketime('year'=>$1,'month'=>$2,'day'=>$3,
1141: 'hours'=>$4,'minutes'=>$5,'seconds'=>$6);
1142: }
1143: return $timestamp;
1144: }
1145:
1.5 matthew 1146:
1.1 matthew 1147: 1;
1148:
1149: __END__;
1.5 matthew 1150:
1151: =pod
1152:
1153: =back
1154:
1155: =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