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