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