Annotation of loncom/interface/lonmysql.pm, revision 1.30
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()));
1.30 ! albertel 481: &Apache::lonnet::logthis("reconnect set to ".$dbh->{mysql_auto_reconnect});
1.10 matthew 482: return $dbh;
1.1 matthew 483: }
484:
485: ###############################
486:
487: =pod
488:
489: =item &get_error()
490:
491: Inputs: none.
492:
493: Returns: The last error reported.
494:
495: =cut
496:
497: ###############################
498: sub get_error {
499: return $errorstring;
500: }
501:
502: ###############################
503:
504: =pod
505:
506: =item &get_debug()
507:
508: Inputs: none.
509:
510: Returns: A string describing the internal state of the lonmysql package.
511:
512: =cut
513:
514: ###############################
515: sub get_debug {
516: return $debugstring;
517: }
518:
519: ###############################
520:
521: =pod
522:
1.8 matthew 523: =item &update_table_info()
1.1 matthew 524:
525: Inputs: table id
526:
1.3 matthew 527: Returns: undef on error, 1 on success.
1.1 matthew 528:
1.3 matthew 529: &update_table_info updates the %Tables hash with current information about
530: the given table.
531:
532: The default MySQL table status fields are:
1.1 matthew 533:
534: Name Type Row_format
535: Max_data_length Index_length Data_free
536: Create_time Update_time Check_time
537: Avg_row_length Data_length Comment
538: Rows Auto_increment Create_options
539:
1.3 matthew 540: Additionally, "Col_order" is updated as well.
541:
1.1 matthew 542: =cut
543:
544: ###############################
1.3 matthew 545: sub update_table_info {
1.1 matthew 546: my ($table_id) = @_;
1.3 matthew 547: return undef if (! defined(&connect_to_db()));
548: my $table_status = &check_table($table_id);
549: return undef if (! defined($table_status));
550: if (! $table_status) {
551: $errorstring = "table $table_id does not exist.";
552: return undef;
553: }
1.1 matthew 554: my $tablename = &translate_id($table_id);
1.3 matthew 555: #
556: # Get MySQLs table status information.
557: #
1.1 matthew 558: my @tabledesc = qw/
559: Name Type Row_format Rows Avg_row_length Data_length
560: Max_data_length Index_length Data_free Auto_increment
561: Create_time Update_time Check_time Create_options Comment /;
562: my $db_command = "SHOW TABLE STATUS FROM loncapa LIKE '$tablename'";
563: my $sth = $dbh->prepare($db_command);
564: $sth->execute();
565: if ($sth->err) {
566: $errorstring = "$dbh ATTEMPTED:\n".$db_command."\nRESULTING ERROR:\n".
567: $sth->errstr;
1.3 matthew 568: &disconnect_from_db();
1.1 matthew 569: return undef;
570: }
571: #
572: my @info=$sth->fetchrow_array;
573: for (my $i=0;$i<= $#info ; $i++) {
1.25 matthew 574: if ($tabledesc[$i] !~ /^(Create_|Update_|Check_)time$/) {
575: $Tables{$tablename}->{$tabledesc[$i]}=
576: &unsqltime($info[$i]);
577: } else {
578: $Tables{$tablename}->{$tabledesc[$i]}= $info[$i];
579: }
1.3 matthew 580: }
581: #
582: # Determine the column order
583: #
584: $db_command = "DESCRIBE $tablename";
1.5 matthew 585: $sth = $dbh->prepare($db_command);
1.3 matthew 586: $sth->execute();
587: if ($sth->err) {
588: $errorstring = "$dbh ATTEMPTED:\n".$db_command."\nRESULTING ERROR:\n".
589: $sth->errstr;
590: &disconnect_from_db();
591: return undef;
592: }
593: my $aref=$sth->fetchall_arrayref;
594: $Tables{$tablename}->{'Col_order'}=[]; # Clear values.
595: # The values we want are the 'Field' entries, the first column.
596: for (my $i=0;$i< @$aref ; $i++) {
597: push @{$Tables{$tablename}->{'Col_order'}},$aref->[$i]->[0];
1.1 matthew 598: }
599: #
600: $debugstring = "Retrieved table info for $tablename";
1.3 matthew 601: return 1;
1.1 matthew 602: }
1.25 matthew 603:
604: ###############################
605:
606: =pod
607:
608: =item &table_information()
609:
610: Inputs: table id
611:
612: Returns: hash with the table status
613:
614: =cut
615:
616: ###############################
617: sub table_information {
618: my $table_id=shift;
619: if (&update_table_info($table_id)) {
620: return %{$Tables{$table_id}};
621: } else {
622: return ();
623: }
624: }
625:
1.18 www 626: ###############################
627:
628: =pod
629:
630: =item &col_order()
631:
632: Inputs: table id
1.1 matthew 633:
1.18 www 634: Returns: array with column order
635:
636: =cut
637:
1.25 matthew 638: ###############################
1.18 www 639: sub col_order {
640: my $table_id=shift;
641: if (&update_table_info($table_id)) {
642: return @{$Tables{$table_id}->{'Col_order'}};
643: } else {
644: return ();
645: }
646: }
1.21 matthew 647:
1.1 matthew 648: ###############################
649:
650: =pod
651:
1.8 matthew 652: =item &create_table()
1.1 matthew 653:
654: Inputs:
1.21 matthew 655: table description, see &build_table_creation_request
656: Returns:
657: undef on error, table id on success.
658:
659: =cut
660:
661: ###############################
662: sub create_table {
663: return undef if (!defined(&connect_to_db($dbh)));
664: my ($table_des)=@_;
1.24 matthew 665: my ($request,$table_id) = &build_table_creation_request($table_des);
1.21 matthew 666: #
667: # Execute the request to create the table
668: #############################################
669: my $count = $dbh->do($request);
670: if (! defined($count)) {
671: $errorstring = "$dbh ATTEMPTED:\n".$request."\nRESULTING ERROR:\n".
672: $dbh->errstr();
673: return undef;
674: }
675: my $tablename = &translate_id($table_id);
676: delete($Tables{$tablename}) if (exists($Tables{$tablename}));
677: return undef if (! defined(&update_table_info($table_id)));
678: $debugstring = "Created table $tablename at time ".time.
679: " with request\n$request";
680: return $table_id;
681: }
1.1 matthew 682:
1.21 matthew 683: ###############################
684:
685: =pod
686:
687: =item build_table_creation_request
688:
689: Input: table description
1.1 matthew 690:
691: table description = {
692: permanent => 'yes' or 'no',
1.8 matthew 693: columns => [
694: { name => 'colA',
695: type => mysql type,
696: restrictions => 'NOT NULL' or empty,
697: primary_key => 'yes' or empty,
698: auto_inc => 'yes' or empty,
699: },
700: { name => 'colB',
701: ...
702: },
703: { name => 'colC',
704: ...
705: },
706: ],
1.9 matthew 707: 'PRIMARY KEY' => (index_col_name,...),
1.11 matthew 708: KEY => [{ name => 'idx_name',
709: columns => (col1,col2,..),},],
710: INDEX => [{ name => 'idx_name',
711: columns => (col1,col2,..),},],
712: UNIQUE => [{ index => 'yes',
1.9 matthew 713: name => 'idx_name',
1.11 matthew 714: columns => (col1,col2,..),},],
715: FULLTEXT => [{ index => 'yes',
1.9 matthew 716: name => 'idx_name',
1.11 matthew 717: columns => (col1,col2,..),},],
1.9 matthew 718:
1.1 matthew 719: }
720:
1.21 matthew 721: Returns: scalar string containing mysql commands to create the table
1.1 matthew 722:
723: =cut
724:
725: ###############################
1.21 matthew 726: sub build_table_creation_request {
1.1 matthew 727: my ($table_des)=@_;
728: #
729: # Build request to create table
730: ##################################
731: my @Columns;
732: my $col_des;
1.9 matthew 733: my $table_id;
734: if (exists($table_des->{'id'})) {
735: $table_id = $table_des->{'id'};
736: } else {
737: $table_id = &get_new_table_id();
738: }
1.3 matthew 739: my $tablename = &translate_id($table_id);
1.1 matthew 740: my $request = "CREATE TABLE IF NOT EXISTS ".$tablename." ";
1.8 matthew 741: foreach my $coldata (@{$table_des->{'columns'}}) {
742: my $column = $coldata->{'name'};
743: next if (! defined($column));
1.1 matthew 744: $col_des = '';
1.3 matthew 745: if (lc($coldata->{'type'}) =~ /(enum|set)/) { # 'enum' or 'set'
1.1 matthew 746: $col_des.=$column." ".$coldata->{'type'}."('".
747: join("', '",@{$coldata->{'values'}})."')";
748: } else {
749: $col_des.=$column." ".$coldata->{'type'};
750: if (exists($coldata->{'size'})) {
751: $col_des.="(".$coldata->{'size'}.")";
752: }
753: }
754: # Modifiers
755: if (exists($coldata->{'restrictions'})){
756: $col_des.=" ".$coldata->{'restrictions'};
757: }
758: if (exists($coldata->{'default'})) {
759: $col_des.=" DEFAULT '".$coldata->{'default'}."'";
760: }
1.3 matthew 761: $col_des.=' AUTO_INCREMENT' if (exists($coldata->{'auto_inc'}) &&
762: ($coldata->{'auto_inc'} eq 'yes'));
763: $col_des.=' PRIMARY KEY' if (exists($coldata->{'primary_key'}) &&
764: ($coldata->{'primary_key'} eq 'yes'));
1.1 matthew 765: } continue {
766: # skip blank items.
767: push (@Columns,$col_des) if ($col_des ne '');
768: }
1.9 matthew 769: if (exists($table_des->{'PRIMARY KEY'})) {
770: push (@Columns,'PRIMARY KEY ('.join(',',@{$table_des->{'PRIMARY KEY'}})
771: .')');
772: }
1.11 matthew 773: #
774: foreach my $indextype ('KEY','INDEX') {
775: next if (!exists($table_des->{$indextype}));
776: foreach my $indexdescription (@{$table_des->{$indextype}}) {
777: my $text = $indextype.' ';
778: if (exists($indexdescription->{'name'})) {
779: $text .=$indexdescription->{'name'};
1.9 matthew 780: }
1.11 matthew 781: $text .= ' ('.join(',',@{$indexdescription->{'columns'}}).')';
1.9 matthew 782: push (@Columns,$text);
783: }
784: }
1.11 matthew 785: #
786: foreach my $indextype ('UNIQUE','FULLTEXT') {
787: next if (! exists($table_des->{$indextype}));
788: foreach my $indexdescription (@{$table_des->{$indextype}}) {
789: my $text = $indextype.' ';
790: if (exists($indexdescription->{'index'}) &&
791: $indexdescription->{'index'} eq 'yes') {
1.9 matthew 792: $text .= 'INDEX ';
793: }
1.11 matthew 794: if (exists($indexdescription->{'name'})) {
795: $text .=$indexdescription->{'name'};
1.9 matthew 796: }
1.11 matthew 797: $text .= ' ('.join(',',@{$indexdescription->{'columns'}}).')';
1.9 matthew 798: push (@Columns,$text);
799: }
1.3 matthew 800: }
1.11 matthew 801: #
1.1 matthew 802: $request .= "(".join(", ",@Columns).") ";
803: unless($table_des->{'permanent'} eq 'yes') {
804: $request.="COMMENT = 'temporary' ";
805: }
806: $request .= "TYPE=MYISAM";
1.24 matthew 807: return $request,$table_id;
1.1 matthew 808: }
809:
810: ###############################
811:
812: =pod
813:
1.8 matthew 814: =item &get_new_table_id()
1.1 matthew 815:
816: Used internally to prevent table name collisions.
817:
818: =cut
819:
820: ###############################
821: sub get_new_table_id {
822: my $newid = 0;
823: my @tables = &tables_in_db();
824: foreach (@tables) {
1.29 albertel 825: if (/^$env{'user.name'}_$env{'user.domain'}_(\d+)$/) {
1.1 matthew 826: $newid = $1 if ($1 > $newid);
827: }
828: }
829: return ++$newid;
830: }
831:
832: ###############################
833:
834: =pod
835:
1.8 matthew 836: =item &get_rows()
1.1 matthew 837:
838: Inputs: $table_id,$condition
839:
840: Returns: undef on error, an array ref to (array of) results on success.
841:
1.2 matthew 842: Internally, this function does a 'SELECT * FROM table WHERE $condition'.
1.1 matthew 843: $condition = 'id>0' will result in all rows where column 'id' has a value
844: greater than 0 being returned.
845:
846: =cut
847:
848: ###############################
849: sub get_rows {
850: my ($table_id,$condition) = @_;
1.3 matthew 851: return undef if (! defined(&connect_to_db()));
852: my $table_status = &check_table($table_id);
853: return undef if (! defined($table_status));
854: if (! $table_status) {
855: $errorstring = "table $table_id does not exist.";
856: return undef;
857: }
1.1 matthew 858: my $tablename = &translate_id($table_id);
1.9 matthew 859: my $request;
860: if (defined($condition) && $condition ne '') {
861: $request = 'SELECT * FROM '.$tablename.' WHERE '.$condition;
862: } else {
863: $request = 'SELECT * FROM '.$tablename;
864: $condition = 'no condition';
865: }
1.1 matthew 866: my $sth=$dbh->prepare($request);
867: $sth->execute();
868: if ($sth->err) {
869: $errorstring = "$dbh ATTEMPTED:\n".$request."\nRESULTING ERROR:\n".
870: $sth->errstr;
871: $debugstring = "Failed to get rows matching $condition";
872: return undef;
873: }
874: $debugstring = "Got rows matching $condition";
875: my @Results = @{$sth->fetchall_arrayref};
876: return @Results;
877: }
878:
879: ###############################
880:
881: =pod
882:
1.8 matthew 883: =item &store_row()
1.1 matthew 884:
885: Inputs: table id, row data
886:
887: returns undef on error, 1 on success.
888:
889: =cut
890:
891: ###############################
892: sub store_row {
893: my ($table_id,$rowdata) = @_;
1.3 matthew 894: #
895: return undef if (! defined(&connect_to_db()));
896: my $table_status = &check_table($table_id);
897: return undef if (! defined($table_status));
898: if (! $table_status) {
899: $errorstring = "table $table_id does not exist.";
900: return undef;
901: }
902: #
1.1 matthew 903: my $tablename = &translate_id($table_id);
1.3 matthew 904: #
1.1 matthew 905: my $sth;
1.3 matthew 906: if (exists($Tables{$tablename}->{'row_insert_sth'})) {
907: $sth = $Tables{$tablename}->{'row_insert_sth'};
1.1 matthew 908: } else {
1.3 matthew 909: # Build the insert statement handler
910: return undef if (! defined(&update_table_info($table_id)));
1.1 matthew 911: my $insert_request = 'INSERT INTO '.$tablename.' VALUES(';
1.3 matthew 912: foreach (@{$Tables{$tablename}->{'Col_order'}}) {
1.1 matthew 913: $insert_request.="?,";
914: }
915: chop $insert_request;
916: $insert_request.=")";
917: $sth=$dbh->prepare($insert_request);
1.3 matthew 918: $Tables{$tablename}->{'row_insert_sth'}=$sth;
1.1 matthew 919: }
920: my @Parameters;
921: if (ref($rowdata) eq 'ARRAY') {
922: @Parameters = @$rowdata;
923: } elsif (ref($rowdata) eq 'HASH') {
1.3 matthew 924: foreach (@{$Tables{$tablename}->{'Col_order'}}) {
1.6 matthew 925: push(@Parameters,$rowdata->{$_});
1.1 matthew 926: }
927: }
928: $sth->execute(@Parameters);
929: if ($sth->err) {
930: $errorstring = "$dbh ATTEMPTED insert @Parameters RESULTING ERROR:\n".
931: $sth->errstr;
932: return undef;
933: }
934: $debugstring = "Stored row.";
935: return 1;
936: }
937:
1.23 matthew 938:
939: ###############################
940:
941: =pod
942:
943: =item &bulk_store_rows()
944:
945: Inputs: table id, [columns],[[row data1].[row data2],...]
946:
947: returns undef on error, 1 on success.
948:
949: =cut
950:
951: ###############################
952: sub bulk_store_rows {
953: my ($table_id,$columns,$rows) = @_;
954: #
955: return undef if (! defined(&connect_to_db()));
956: my $dbh = &get_dbh();
957: return undef if (! defined($dbh));
958: my $table_status = &check_table($table_id);
959: return undef if (! defined($table_status));
960: if (! $table_status) {
961: $errorstring = "table $table_id does not exist.";
962: return undef;
963: }
964: #
965: my $tablename = &translate_id($table_id);
966: #
967: my $request = 'INSERT IGNORE INTO '.$tablename.' ';
968: if (defined($columns) && ref($columns) eq 'ARRAY') {
969: $request .= join(',',@$columns).' ';
970: }
971: if (! defined($rows) || ref($rows) ne 'ARRAY') {
972: $errorstring = "no input rows given.";
973: return undef;
974: }
975: $request .= 'VALUES ';
976: foreach my $row (@$rows) {
977: # avoid doing row stuff here...
978: $request .= '('.join(',',@$row).'),';
979: }
980: $request =~ s/,$//;
981: $dbh->do($request);
982: if ($dbh->err) {
983: $errorstring = 'Attempted '.$/.$request.$/.'Got error '.$dbh->errstr();
984: return undef;
985: }
986: return 1;
987: }
988:
989:
1.9 matthew 990: ###############################
991:
992: =pod
993:
994: =item &replace_row()
995:
996: Inputs: table id, row data
997:
998: returns undef on error, 1 on success.
999:
1000: Acts like &store_row() but uses the 'REPLACE' command instead of 'INSERT'.
1001:
1002: =cut
1003:
1004: ###############################
1005: sub replace_row {
1006: my ($table_id,$rowdata) = @_;
1007: #
1008: return undef if (! defined(&connect_to_db()));
1009: my $table_status = &check_table($table_id);
1010: return undef if (! defined($table_status));
1011: if (! $table_status) {
1012: $errorstring = "table $table_id does not exist.";
1013: return undef;
1014: }
1015: #
1016: my $tablename = &translate_id($table_id);
1017: #
1018: my $sth;
1019: if (exists($Tables{$tablename}->{'row_replace_sth'})) {
1020: $sth = $Tables{$tablename}->{'row_replace_sth'};
1021: } else {
1022: # Build the insert statement handler
1023: return undef if (! defined(&update_table_info($table_id)));
1024: my $replace_request = 'REPLACE INTO '.$tablename.' VALUES(';
1025: foreach (@{$Tables{$tablename}->{'Col_order'}}) {
1026: $replace_request.="?,";
1027: }
1028: chop $replace_request;
1029: $replace_request.=")";
1030: $sth=$dbh->prepare($replace_request);
1031: $Tables{$tablename}->{'row_replace_sth'}=$sth;
1032: }
1033: my @Parameters;
1034: if (ref($rowdata) eq 'ARRAY') {
1035: @Parameters = @$rowdata;
1036: } elsif (ref($rowdata) eq 'HASH') {
1037: foreach (@{$Tables{$tablename}->{'Col_order'}}) {
1038: push(@Parameters,$rowdata->{$_});
1039: }
1040: }
1041: $sth->execute(@Parameters);
1042: if ($sth->err) {
1043: $errorstring = "$dbh ATTEMPTED replace @Parameters RESULTING ERROR:\n".
1044: $sth->errstr;
1045: return undef;
1046: }
1047: $debugstring = "Stored row.";
1048: return 1;
1049: }
1050:
1.1 matthew 1051: ###########################################
1052:
1053: =pod
1054:
1.8 matthew 1055: =item &tables_in_db()
1.1 matthew 1056:
1057: Returns a list containing the names of all the tables in the database.
1058: Returns undef on error.
1059:
1060: =cut
1061:
1062: ###########################################
1063: sub tables_in_db {
1.3 matthew 1064: return undef if (!defined(&connect_to_db()));
1.5 matthew 1065: my $sth=$dbh->prepare('SHOW TABLES');
1.1 matthew 1066: $sth->execute();
1.19 matthew 1067: $sth->execute();
1068: my $aref = $sth->fetchall_arrayref;
1069: if ($sth->err()) {
1070: $errorstring =
1071: "$dbh ATTEMPTED:\n".'fetchall_arrayref after SHOW TABLES'.
1.3 matthew 1072: "\nRESULTING ERROR:\n".$sth->errstr;
1.1 matthew 1073: return undef;
1074: }
1.19 matthew 1075: my @table_list;
1.1 matthew 1076: foreach (@$aref) {
1.19 matthew 1077: push(@table_list,$_->[0]);
1.1 matthew 1078: }
1.19 matthew 1079: $debugstring = "Got list of tables in DB: ".join(',',@table_list);
1080: return(@table_list);
1.1 matthew 1081: }
1082:
1083: ###########################################
1084:
1085: =pod
1086:
1.8 matthew 1087: =item &translate_id()
1.1 matthew 1088:
1089: Used internally to translate a numeric table id into a MySQL table name.
1090: If the input $id contains non-numeric characters it is assumed to have
1091: already been translated.
1092:
1093: Checks are NOT performed to see if the table actually exists.
1094:
1095: =cut
1096:
1097: ###########################################
1098: sub translate_id {
1099: my $id = shift;
1100: # id should be a digit. If it is not a digit we assume the given id
1101: # is complete and does not need to be translated.
1102: return $id if ($id =~ /\D/);
1.29 albertel 1103: return $env{'user.name'}.'_'.$env{'user.domain'}.'_'.$id;
1.1 matthew 1104: }
1105:
1106: ###########################################
1107:
1108: =pod
1109:
1.8 matthew 1110: =item &check_table()
1111:
1112: Input: table id
1.1 matthew 1113:
1114: Checks to see if the requested table exists. Returns 0 (no), 1 (yes), or
1115: undef (error).
1116:
1117: =cut
1118:
1119: ###########################################
1120: sub check_table {
1121: my $table_id = shift;
1.3 matthew 1122: return undef if (!defined(&connect_to_db()));
1123: #
1.1 matthew 1124: $table_id = &translate_id($table_id);
1125: my @Table_list = &tables_in_db();
1126: my $result = 0;
1127: foreach (@Table_list) {
1.9 matthew 1128: if ($_ eq $table_id) {
1.1 matthew 1129: $result = 1;
1130: last;
1131: }
1132: }
1133: # If it does not exist, make sure we do not have it listed in %Tables
1134: delete($Tables{$table_id}) if ((! $result) && exists($Tables{$table_id}));
1135: $debugstring = "check_table returned $result for $table_id";
1136: return $result;
1137: }
1138:
1.5 matthew 1139: ###########################################
1140:
1141: =pod
1142:
1.8 matthew 1143: =item &remove_from_table()
1144:
1145: Input: $table_id, $column, $value
1146:
1147: Returns: the number of rows deleted. undef on error.
1.5 matthew 1148:
1149: Executes a "delete from $tableid where $column like binary '$value'".
1150:
1151: =cut
1152:
1153: ###########################################
1154: sub remove_from_table {
1155: my ($table_id,$column,$value) = @_;
1156: return undef if (!defined(&connect_to_db()));
1157: #
1158: $table_id = &translate_id($table_id);
1.17 www 1159: my $command = 'DELETE FROM '.$table_id.' WHERE '.$column.
1.5 matthew 1160: " LIKE BINARY ".$dbh->quote($value);
1161: my $sth = $dbh->prepare($command);
1.17 www 1162: unless ($sth->execute()) {
1.5 matthew 1163: $errorstring = "ERROR on execution of ".$command."\n".$sth->errstr;
1164: return undef;
1165: }
1.12 matthew 1166: $debugstring = $command;
1.5 matthew 1167: my $rows = $sth->rows;
1168: return $rows;
1169: }
1170:
1.14 matthew 1171: ###########################################
1172:
1173: =pod
1174:
1175: =item drop_table($table_id)
1176:
1177: Issues a 'drop table if exists' command
1178:
1179: =cut
1180:
1181: ###########################################
1182:
1183: sub drop_table {
1184: my ($table_id) = @_;
1185: return undef if (!defined(&connect_to_db()));
1186: #
1187: $table_id = &translate_id($table_id);
1188: my $command = 'DROP TABLE IF EXISTS '.$table_id;
1189: my $sth = $dbh->prepare($command);
1190: $sth->execute();
1191: if ($sth->err) {
1192: $errorstring = "ERROR on execution of ".$command."\n".$sth->errstr;
1193: return undef;
1194: }
1195: $debugstring = $command;
1.15 matthew 1196: delete($Tables{$table_id}); # remove any knowledge of the table
1.14 matthew 1197: return 1; # if we got here there was no error, so return a 'true' value
1198: }
1.16 www 1199:
1.26 matthew 1200: ##########################################
1.16 www 1201:
1.26 matthew 1202: =pod
1203:
1204: =item fix_table_name
1205:
1206: Fixes a table name so that it will work with MySQL.
1207:
1208: =cut
1209:
1210: ##########################################
1211: sub fix_table_name {
1212: my ($name) = @_;
1.28 matthew 1213: $name =~ s/^(\d+[eE]\d+)/_$1/;
1.26 matthew 1214: return $name;
1215: }
1.16 www 1216:
1217:
1218: # ---------------------------- convert 'time' format into a datetime sql format
1219: sub sqltime {
1220: my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) =
1221: localtime(&unsqltime($_[0]));
1222: $mon++; $year+=1900;
1223: return "$year-$mon-$mday $hour:$min:$sec";
1224: }
1225:
1226: sub maketime {
1227: my %th=@_;
1228: return POSIX::mktime(($th{'seconds'},$th{'minutes'},$th{'hours'},
1229: $th{'day'},$th{'month'}-1,
1230: $th{'year'}-1900,0,0,$th{'dlsav'}));
1231: }
1232:
1233:
1234: #########################################
1235: #
1236: # Retro-fixing of un-backward-compatible time format
1237:
1238: sub unsqltime {
1239: my $timestamp=shift;
1240: if ($timestamp=~/^(\d+)\-(\d+)\-(\d+)\s+(\d+)\:(\d+)\:(\d+)$/) {
1241: $timestamp=&maketime('year'=>$1,'month'=>$2,'day'=>$3,
1242: 'hours'=>$4,'minutes'=>$5,'seconds'=>$6);
1243: }
1244: return $timestamp;
1245: }
1246:
1.5 matthew 1247:
1.1 matthew 1248: 1;
1249:
1250: __END__;
1.5 matthew 1251:
1252: =pod
1253:
1254: =back
1255:
1256: =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