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