1: # The LearningOnline Network with CAPA
2: # MySQL utility functions
3: #
4: # $Id: lonmysql.pm,v 1.1 2002/07/26 16:22:24 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 Apache::lonnet();
35:
36: ######################################################################
37: ######################################################################
38:
39: =pod
40:
41: =head1 Name
42:
43: lonmysql - LONCAPA MySQL utility functions
44:
45: =head1 Synopsis
46:
47: lonmysql contains utility functions to make accessing the mysql loncapa
48: database easier.
49:
50: =head1 Description
51:
52: lonmysql does its best to encapsulate all the database/table functions
53: and provide a common interface. The goal, however, is not to provide
54: a complete reimplementation of the DBI interface. Instead we try to
55: make using mysql as painless as possible.
56:
57: Each table has a numeric ID that is a parameter to most lonmysql functions.
58: The table id is returned by &create_table.
59: If you lose the table id, it is lost forever.
60: The table names in MySQL correspond to
61: $ENV{'user.name'}.'_'.$ENV{'user.domain'}.'_'.$table_id. If the table id
62: is non-numeric, it is assumed to be the full name of a table. If you pass
63: the table id in a form, you MUST ensure that what you send to lonmysql is
64: numeric, otherwise you are opening up all the tables in the MySQL database.
65:
66: =over 4
67:
68: =item Creating a table
69:
70: To create a table, you need a description of its structure. See the entry
71: for &create_table for a description of what is needed.
72:
73: $table_id = &create_table({
74: columns => {
75: id => {
76: type => 'INT',
77: restrictions => 'NOT NULL',
78: primary_key => 'yes',
79: auto_inc => 'yes'
80: }
81: verbage => { type => 'TEXT' },
82: idx_verbage => { type => 'FULLTEXT',
83: target => 'verbage'
84: }
85: },
86: column_order => [qw/id verbage idx_verbage/]
87: });
88:
89: The above command will create a table with two columns, 'id' and 'verbage'.
90:
91: 'id' will be an integer which is autoincremented and non-null.
92:
93: 'verbage' will be of type 'TEXT', which (conceivably) allows any length
94: text string to be stored. Depending on your intentions for this database,
95: setting restrictions => 'NOT NULL' may help you avoid storing empty data.
96:
97: 'idx_verbage' sets up the 'verbage' column for 'FULLTEXT' searching.
98:
99:
100:
101: =item Storing rows
102:
103: Storing a row in a table requires calling &store_row($table_id,$data)
104:
105: $data is either a hash reference or an array reference. If it is an array
106: reference, the data is passed as is (after being escaped) to the
107: "INSERT INTO <table> VALUES( ... )" SQL command. If $data is a hash reference,
108: the data will be placed into an array in the proper column order for the table
109: and then passed to the database.
110:
111: An example of inserting into the table created above is:
112:
113: &store_row($table_id,[undef,'I am not a crackpot!']);
114:
115: or equivalently,
116:
117: &store_row($table_id,{ verbage => 'I am not a crackpot!'});
118:
119: Since the above table was created with the first column ('id') as
120: autoincrement, providing a value is unnecessary even though the column was
121: marked as 'NOT NULL'.
122:
123: In the future an array of arrays or hashes may be supported, but currently
124: the system only performs one insert at a time. Given the nature of this
125: interface, transactions (locking of the table) are not supported.
126:
127:
128:
129: =item Retrieving rows
130:
131: Retrieving rows requires calling get_rows:
132:
133: @row = &Apache::lonmysql::get_rows($table_id,$condition)
134:
135: This results in the query "SELECT * FROM <table> HAVING $condition".
136:
137: @row = &Apache::lonmysql::get_rows($table_id,'id>20');
138:
139: returns all rows with column 'id' greater than 20.
140:
141: =back
142:
143: =cut
144:
145: ######################################################################
146: ######################################################################
147: =pod
148:
149: =head1 Package Variables
150:
151: =over 4
152:
153: =cut
154:
155: ##################################################
156: ##################################################
157:
158: =pod
159:
160: =item %Tables
161:
162: Holds information regarding the currently open connections. Each key
163: in the %Tables hash will be a unique table key. The value associated
164: with a key is a hash reference. Most values are initialized when the
165: table is created.
166:
167: The following entries are allowed in the hash reference:
168:
169: =over 4
170:
171: =item columns
172:
173: The columns information required by &create_table.
174:
175: =item column_order
176:
177: Reference to an array containing the order of columns in the table.
178:
179: =item table_info
180:
181: Set to the results of &get_table_info.
182:
183: =item row_insert_sth
184:
185: The statement handler for row inserts.
186:
187: =back
188:
189: =cut
190:
191: ##################################################
192: ##################################################
193: my %Tables;
194:
195: ##################################################
196: ##################################################
197: =pod
198:
199: =item $errorstring
200:
201: Holds the last error.
202:
203: =cut
204: ##################################################
205: ##################################################
206: my $errorstring;
207:
208: ##################################################
209: ##################################################
210: =pod
211:
212: =item $debugstring
213:
214: Describes current events within the package.
215:
216: =cut
217: ##################################################
218: ##################################################
219: my $debugstring;
220:
221: ##################################################
222: ##################################################
223:
224: =pod
225:
226: =item $dbh
227:
228: The database handler; The actual connection to MySQL via the perl DBI.
229:
230: =cut
231:
232: ##################################################
233: ##################################################
234: my $dbh;
235:
236: ##################################################
237: ##################################################
238:
239: # End of global variable declarations
240:
241: =pod
242:
243: =back
244:
245: =cut
246:
247: ######################################################################
248: ######################################################################
249:
250: =pod
251:
252: =head1 Internals
253:
254: =over 4
255:
256: =cut
257:
258: ######################################################################
259: ######################################################################
260:
261: =pod
262:
263: =item &connect_to_db()
264:
265: Inputs: none.
266:
267: Returns: undef on error, 1 on success.
268:
269: Checks to make sure the database has been connected to. If not, the
270: connection is established.
271:
272: =cut
273:
274: ###############################
275: sub connect_to_db {
276: return 1 if ($dbh);
277: if (! ($dbh = DBI->connect("DBI:mysql:loncapa","www",
278: $Apache::lonnet::perlvar{'lonSqlAccess'},
279: { RaiseError=>0,PrintError=>0}))) {
280: $debugstring = "Unable to connect to loncapa database.";
281: if ($dbh->err) {
282: $errorstring = "Connection error: ".$dbh->errstr;
283: }
284: return undef;
285: }
286: # The code below will let us switch to a different database.
287: # my $db_command = "USE $db;";
288: # my $sth = $dbh->prepare($db_command);
289: # $sth->execute();
290: # if ($sth->err) {
291: # # Unable to use the database. Interesting...
292: # $dbh->disconnect;
293: # return undef;
294: # }
295: $debugstring = "Successfully connected to loncapa database.";
296: return 1;
297: }
298:
299: ###############################
300:
301: =pod
302:
303: =item &disconnect_from_db()
304:
305: Inputs: none.
306:
307: Returns: Always returns 1.
308:
309: Severs the connection to the mysql database.
310:
311: =cut
312:
313: ###############################
314: sub disconnect_from_db {
315: foreach (keys(%Tables)) {
316: # Supposedly, having statement handlers running around after the
317: # database connection has been lost will cause trouble. So we
318: # kill them off just to be sure.
319: if (exists($Tables{$_}->{'row_insert_sth'})) {
320: delete($Tables{$_}->{'row_insert_sth'});
321: }
322: }
323: $dbh->disconnect if ($dbh);
324: $debugstring = "Disconnected from database.";
325: $dbh = undef;
326: return 1;
327: }
328:
329: ###############################
330:
331: =pod
332:
333: =item &query_table()
334:
335: Currently unimplemented.
336:
337: =cut
338:
339: ###############################
340: sub query_table {
341: # someday this will work.
342: }
343:
344:
345:
346: ###############################
347:
348: =pod
349:
350: =item &get_error()
351:
352: Inputs: none.
353:
354: Returns: The last error reported.
355:
356: =cut
357:
358: ###############################
359: sub get_error {
360: return $errorstring;
361: }
362:
363: ###############################
364:
365: =pod
366:
367: =item &get_debug()
368:
369: Inputs: none.
370:
371: Returns: A string describing the internal state of the lonmysql package.
372:
373: =cut
374:
375: ###############################
376: sub get_debug {
377: return $debugstring;
378: }
379:
380: ###############################
381:
382: =pod
383:
384: =item &get_table_info($table_id)
385:
386: Inputs: table id
387:
388: Returns: undef or a pointer to a hash of data about a table.
389:
390: &get_table_info returns all of the information it can about a table in the
391: form of a hash. Currently the fields in the hash are:
392:
393: Name Type Row_format
394: Max_data_length Index_length Data_free
395: Create_time Update_time Check_time
396: Avg_row_length Data_length Comment
397: Rows Auto_increment Create_options
398:
399: =cut
400:
401: ###############################
402: sub get_table_info {
403: my ($table_id) = @_;
404: my $tablename = &translate_id($table_id);
405: return undef if (! &check_table($table_id));
406: my %tableinfo;
407: my @tabledesc = qw/
408: Name Type Row_format Rows Avg_row_length Data_length
409: Max_data_length Index_length Data_free Auto_increment
410: Create_time Update_time Check_time Create_options Comment /;
411: my $db_command = "SHOW TABLE STATUS FROM loncapa LIKE '$tablename'";
412: my $sth = $dbh->prepare($db_command);
413: $sth->execute();
414: if ($sth->err) {
415: # Unable to use the database. Interesting...
416: $errorstring = "$dbh ATTEMPTED:\n".$db_command."\nRESULTING ERROR:\n".
417: $sth->errstr;
418: $dbh->disconnect;
419: return undef;
420: }
421: #
422: my @info=$sth->fetchrow_array;
423: for (my $i=0;$i<= $#info ; $i++) {
424: $tableinfo{$tabledesc[$i]}= $info[$i];
425: }
426: #
427: $debugstring = "Retrieved table info for $tablename";
428: return \%tableinfo;
429: }
430:
431: ###############################
432:
433: =pod
434:
435: =item &create_table
436:
437: Inputs:
438: table description
439:
440: Input formats:
441:
442: table description = {
443: permanent => 'yes' or 'no',
444: columns => {
445: colA => {
446: type => mysql type,
447: restrictions => 'NOT NULL' or empty,
448: primary_key => 'yes' or empty,
449: auto_inc => 'yes' or empty,
450: target => 'colB' (only if type eq 'FULLTEXT'),
451: }
452: colB => { .. }
453: colZ => { .. }
454: },
455: column_order => [ colA, colB, ..., colZ],
456: }
457:
458: Returns:
459: undef on error, table id on success.
460:
461: =cut
462:
463: ###############################
464: sub create_table {
465: return undef if (!&connect_to_db($dbh));
466: my ($table_des)=@_;
467: #
468: # Build request to create table
469: ##################################
470: my @Columns;
471: my $col_des;
472: my $tableid = &get_new_table_id();
473: my $tablename = &translate_id($tableid);
474: my $request = "CREATE TABLE IF NOT EXISTS ".$tablename." ";
475: foreach my $column (@{$table_des->{'column_order'}}) {
476: $col_des = '';
477: my $coldata = $table_des->{'columns'}->{$column};
478: if (lc($coldata->{'type'}) eq 'fulltext') {
479: $col_des.='FULLTEXT '.$column." (".$coldata->{'target'}.")";
480: next; # Skip to the continue block and store the column data
481: } elsif (lc($coldata->{'type'}) =~ /(enum|set)/) { # 'enum' or 'set'
482: $col_des.=$column." ".$coldata->{'type'}."('".
483: join("', '",@{$coldata->{'values'}})."')";
484: } else {
485: $col_des.=$column." ".$coldata->{'type'};
486: if (exists($coldata->{'size'})) {
487: $col_des.="(".$coldata->{'size'}.")";
488: }
489: }
490: # Modifiers
491: if (exists($coldata->{'restrictions'})){
492: $col_des.=" ".$coldata->{'restrictions'};
493: }
494: if (exists($coldata->{'default'})) {
495: $col_des.=" DEFAULT '".$coldata->{'default'}."'";
496: }
497: $col_des.=' AUTO_INCREMENT' if (exists($coldata->{'auto_inc'}));
498: $col_des.=' PRIMARY KEY' if (exists($coldata->{'primary_key'}));
499: } continue {
500: # skip blank items.
501: push (@Columns,$col_des) if ($col_des ne '');
502: }
503: $request .= "(".join(", ",@Columns).") ";
504: unless($table_des->{'permanent'} eq 'yes') {
505: $request.="COMMENT = 'temporary' ";
506: }
507: $request .= "TYPE=MYISAM";
508: #
509: # Execute the request to create the table
510: #############################################
511: my $count = $dbh->do($request);
512: if (! defined($count)) {
513: $errorstring = "$dbh ATTEMPTED:\n".$request."\nRESULTING ERROR:\n".
514: return undef;
515: }
516: #
517: # Set up the internal bookkeeping
518: #############################################
519: delete($Tables{$tablename}) if (exists($Tables{$tablename}));
520: my @column_order_copy = @{$table_des->{'column_order'}};
521: $Tables{$tablename} = {
522: columns => $table_des->{'columns'},
523: column_order => $table_des->{'column_order'},
524: table_info => &get_table_info($tableid),
525: };
526: $debugstring = "$dbh Created table $tablename at time ".time.
527: " with request\n$request";
528: return $tableid;
529: }
530:
531: ###############################
532:
533: =pod
534:
535: =item &get_new_table_id
536:
537: Used internally to prevent table name collisions.
538:
539: =cut
540:
541: ###############################
542: sub get_new_table_id {
543: my $newid = 0;
544: my $name_regex = '^'.$ENV{'user.name'}.'_'.$ENV{'user.domain'}."_(\d+)\$";
545: my @tables = &tables_in_db();
546: foreach (@tables) {
547: if (/^$ENV{'user.name'}_$ENV{'user.domain'}_(\d+)$/) {
548: $newid = $1 if ($1 > $newid);
549: }
550: }
551: return ++$newid;
552: }
553:
554: ###############################
555:
556: =pod
557:
558: =item &execute_db_command
559:
560: Currently unimplemented
561:
562: =cut
563:
564: ###############################
565: sub execute_db_command {
566: my ($tablename,$command) = @_;
567: return 1;
568: }
569:
570: ###############################
571:
572: =pod
573:
574: =item &get_rows
575:
576: Inputs: $table_id,$condition
577:
578: Returns: undef on error, an array ref to (array of) results on success.
579:
580: Internally, this function does a 'SELECT * FROM table HAVING $condition'.
581: $condition = 'id>0' will result in all rows where column 'id' has a value
582: greater than 0 being returned.
583:
584: =cut
585:
586: ###############################
587: sub get_rows {
588: my ($table_id,$condition) = @_;
589: my $tablename = &translate_id($table_id);
590: my $request = 'SELECT * FROM '.$tablename.' HAVING '.$condition;
591: my $sth=$dbh->prepare($request);
592: $sth->execute();
593: if ($sth->err) {
594: $errorstring = "$dbh ATTEMPTED:\n".$request."\nRESULTING ERROR:\n".
595: $sth->errstr;
596: $debugstring = "Failed to get rows matching $condition";
597: return undef;
598: }
599: $debugstring = "Got rows matching $condition";
600: my @Results = @{$sth->fetchall_arrayref};
601: foreach my $row (@Results) {
602: for(my $i=0;$i<@$row;$i++) {
603: $row->[$i]=&Apache::lonnet::unescape($row->[$i]);
604: }
605: }
606: return @Results;
607: }
608:
609: ###############################
610:
611: =pod
612:
613: =item &store_row
614:
615: Inputs: table id, row data
616:
617: returns undef on error, 1 on success.
618:
619: =cut
620:
621: ###############################
622: sub store_row {
623: my ($table_id,$rowdata) = @_;
624: my $tablename = &translate_id($table_id);
625: my $table = $Tables{$tablename};
626: my $sth;
627: if (exists($table->{'row_insert_sth'})) {
628: $sth = $table->{'row_insert_sth'};
629: } else {
630: # We need to build a statement handler
631: my $insert_request = 'INSERT INTO '.$tablename.' VALUES(';
632: foreach (@{$table->{'column_order'}}) {
633: # Skip the 'fulltext' columns.
634: next if (lc($table->{'columns'}->{$_}->{'type'}) eq 'fulltext');
635: $insert_request.="?,";
636: }
637: chop $insert_request;
638: $insert_request.=")";
639: $sth=$dbh->prepare($insert_request);
640: }
641: my @Parameters;
642: if (ref($rowdata) eq 'ARRAY') {
643: @Parameters = @$rowdata;
644: } elsif (ref($rowdata) eq 'HASH') {
645: foreach (@{$table->{'column_order'}}) {
646: # Is this appropriate? Am I being presumptious? ACK!!!!!
647: next if (lc($table->{'columns'}->{$_}->{'type'}) eq 'fulltext');
648: push(@Parameters,&Apache::lonnet::escape($rowdata->{$_}));
649: }
650: }
651: $sth->execute(@Parameters);
652: if ($sth->err) {
653: $errorstring = "$dbh ATTEMPTED insert @Parameters RESULTING ERROR:\n".
654: $sth->errstr;
655: return undef;
656: }
657: $debugstring = "Stored row.";
658: return 1;
659: }
660:
661: ###########################################
662:
663: =pod
664:
665: =item tables_in_db
666:
667: Returns a list containing the names of all the tables in the database.
668: Returns undef on error.
669:
670: =cut
671:
672: ###########################################
673: sub tables_in_db {
674: return undef if (! &connect_to_db()); # bail out if we cannot connect
675: my $sth=$dbh->prepare('SHOW TABLES;');
676: $sth->execute();
677: if ($sth->err) {
678: $errorstring = "$dbh ATTEMPTED:\n".'SHOW TABLES'."\nRESULTING ERROR:\n".
679: $sth->errstr;
680: return undef;
681: }
682: my $aref = $sth->fetchall_arrayref;
683: my @table_list=();
684: foreach (@$aref) {
685: push @table_list,$_->[0];
686: }
687: $debugstring = "Got list of tables in DB: @table_list";
688: return @table_list;
689: }
690:
691: ###########################################
692:
693: =pod
694:
695: =item &translate_id
696:
697: Used internally to translate a numeric table id into a MySQL table name.
698: If the input $id contains non-numeric characters it is assumed to have
699: already been translated.
700:
701: Checks are NOT performed to see if the table actually exists.
702:
703: =cut
704:
705: ###########################################
706: sub translate_id {
707: my $id = shift;
708: # id should be a digit. If it is not a digit we assume the given id
709: # is complete and does not need to be translated.
710: return $id if ($id =~ /\D/);
711: return $ENV{'user.name'}.'_'.$ENV{'user.domain'}.'_'.$id;
712: }
713:
714: ###########################################
715:
716: =pod
717:
718: =item &check_table($id)
719:
720: Checks to see if the requested table exists. Returns 0 (no), 1 (yes), or
721: undef (error).
722:
723: =cut
724:
725: ###########################################
726: sub check_table {
727: my $table_id = shift;
728: $table_id = &translate_id($table_id);
729: return undef if (! &connect_to_db());
730: my @Table_list = &tables_in_db();
731: my $result = 0;
732: foreach (@Table_list) {
733: if (/^$table_id$/) {
734: $result = 1;
735: last;
736: }
737: }
738: # If it does not exist, make sure we do not have it listed in %Tables
739: delete($Tables{$table_id}) if ((! $result) && exists($Tables{$table_id}));
740: $debugstring = "check_table returned $result for $table_id";
741: return $result;
742: }
743:
744: 1;
745:
746: __END__;
747:
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