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