--- loncom/interface/lonmysql.pm 2002/07/30 18:26:40 1.3 +++ loncom/interface/lonmysql.pm 2005/02/09 21:21:08 1.26 @@ -1,7 +1,7 @@ # The LearningOnline Network with CAPA # MySQL utility functions # -# $Id: lonmysql.pm,v 1.3 2002/07/30 18:26:40 matthew Exp $ +# $Id: lonmysql.pm,v 1.26 2005/02/09 21:21:08 matthew Exp $ # # Copyright Michigan State University Board of Trustees # @@ -31,7 +31,25 @@ package Apache::lonmysql; use strict; use DBI; -use Apache::lonnet(); +use POSIX qw(strftime mktime); + +my $mysqluser; +my $mysqlpassword; + +sub set_mysql_user_and_password { + # If we are running under Apache and LONCAPA, use the LON-CAPA + # user and password. Otherwise...? ? ? ? + ($mysqluser,$mysqlpassword) = @_; + if (! defined($mysqluser) || ! defined($mysqlpassword)) { + if (! eval 'require Apache::lonnet();') { + $mysqluser = 'www'; + $mysqlpassword = $Apache::lonnet::perlvar{'lonSqlAccess'}; + } else { + $mysqluser = ''; + $mysqlpassword = ''; + } + } +} ###################################################################### ###################################################################### @@ -71,17 +89,18 @@ To create a table, you need a descriptio for &create_table for a description of what is needed. $table_id = &create_table({ - columns => { - id => { - type => 'INT', - restrictions => 'NOT NULL', - primary_key => 'yes', - auto_inc => 'yes' - } - verbage => { type => 'TEXT' }, - }, - column_order => [qw/id verbage idx_verbage/], - fulltext => [qw/verbage/], + id => 'tableid', # usually you will use the returned id + columns => ( + { name => 'id', + type => 'INT', + restrictions => 'NOT NULL', + primary_key => 'yes', + auto_inc => 'yes' + }, + { name => 'verbage', + type => 'TEXT' }, + ), + fulltext => [qw/verbage/], }); The above command will create a table with two columns, 'id' and 'verbage'. @@ -230,6 +249,10 @@ an array reference which holds the order The statement handler for row inserts. +=item row_replace_sth + +The statement handler for row inserts. + =back Col_order and row_insert_sth are kept internally by lonmysql and are not @@ -323,11 +346,16 @@ connection is established. ############################### sub connect_to_db { return 1 if ($dbh); - if (! ($dbh = DBI->connect("DBI:mysql:loncapa","www", - $Apache::lonnet::perlvar{'lonSqlAccess'}, + if (! defined($mysqluser) || ! defined($mysqlpassword)) { + &set_mysql_user_and_password(); + } + if (! ($dbh = DBI->connect("DBI:mysql:loncapa",$mysqluser,$mysqlpassword, { RaiseError=>0,PrintError=>0}))) { $debugstring = "Unable to connect to loncapa database."; - if ($dbh->err) { + if (! defined($dbh)) { + $debugstring = "Unable to connect to loncapa database."; + $errorstring = "dbh was undefined."; + } elsif ($dbh->err) { $errorstring = "Connection error: ".$dbh->errstr; } return undef; @@ -340,6 +368,36 @@ sub connect_to_db { =pod +=item &verify_sql_connection() + +Inputs: none. + +Returns: 0 (failure) or 1 (success) + +Checks to make sure the database can be connected to. It does not +initialize anything in the lonmysql package. + +=cut + +############################### +sub verify_sql_connection { + if (! defined($mysqluser) || ! defined($mysqlpassword)) { + &set_mysql_user_and_password(); + } + my $connection; + if (! ($connection = DBI->connect("DBI:mysql:loncapa", + $mysqluser,$mysqlpassword, + { RaiseError=>0,PrintError=>0}))) { + return 0; + } + undef($connection); + return 1; +} + +############################### + +=pod + =item &disconnect_from_db() Inputs: none. @@ -359,6 +417,9 @@ sub disconnect_from_db { if (exists($Tables{$_}->{'row_insert_sth'})) { delete($Tables{$_}->{'row_insert_sth'}); } + if (exists($Tables{$_}->{'row_replace_sth'})) { + delete($Tables{$_}->{'row_replace_sth'}); + } } $dbh->disconnect if ($dbh); $debugstring = "Disconnected from database."; @@ -385,6 +446,26 @@ sub number_of_rows { return undef if (! defined(&update_table_info($table_id))); return $Tables{&translate_id($table_id)}->{'Rows'}; } +############################### + +=pod + +=item &get_dbh() + +Input: nothing + +Returns: the database handler, or undef on error. + +This routine allows the programmer to gain access to the database handler. +Be careful. + +=cut + +############################### +sub get_dbh { + return undef if (! defined(&connect_to_db())); + return $dbh; +} ############################### @@ -424,7 +505,7 @@ sub get_debug { =pod -=item &update_table_info($table_id) +=item &update_table_info() Inputs: table id @@ -475,13 +556,18 @@ sub update_table_info { # my @info=$sth->fetchrow_array; for (my $i=0;$i<= $#info ; $i++) { - $Tables{$tablename}->{$tabledesc[$i]}= $info[$i]; + if ($tabledesc[$i] !~ /^(Create_|Update_|Check_)time$/) { + $Tables{$tablename}->{$tabledesc[$i]}= + &unsqltime($info[$i]); + } else { + $Tables{$tablename}->{$tabledesc[$i]}= $info[$i]; + } } # # Determine the column order # $db_command = "DESCRIBE $tablename"; - my $sth = $dbh->prepare($db_command); + $sth = $dbh->prepare($db_command); $sth->execute(); if ($sth->err) { $errorstring = "$dbh ATTEMPTED:\n".$db_command."\nRESULTING ERROR:\n". @@ -504,28 +590,54 @@ sub update_table_info { =pod -=item &create_table +=item &table_information() -Inputs: - table description +Inputs: table id -Input formats: +Returns: hash with the table status - table description = { - permanent => 'yes' or 'no', - columns => { - colA => { - type => mysql type, - restrictions => 'NOT NULL' or empty, - primary_key => 'yes' or empty, - auto_inc => 'yes' or empty, - } - colB => { .. } - colZ => { .. } - }, - column_order => [ colA, colB, ..., colZ], +=cut + +############################### +sub table_information { + my $table_id=shift; + if (&update_table_info($table_id)) { + return %{$Tables{$table_id}}; + } else { + return (); + } +} + +############################### + +=pod + +=item &col_order() + +Inputs: table id + +Returns: array with column order + +=cut + +############################### +sub col_order { + my $table_id=shift; + if (&update_table_info($table_id)) { + return @{$Tables{$table_id}->{'Col_order'}}; + } else { + return (); } +} + +############################### + +=pod +=item &create_table() + +Inputs: + table description, see &build_table_creation_request Returns: undef on error, table id on success. @@ -535,17 +647,86 @@ Returns: sub create_table { return undef if (!defined(&connect_to_db($dbh))); my ($table_des)=@_; + my ($request,$table_id) = &build_table_creation_request($table_des); + # + # Execute the request to create the table + ############################################# + my $count = $dbh->do($request); + if (! defined($count)) { + $errorstring = "$dbh ATTEMPTED:\n".$request."\nRESULTING ERROR:\n". + $dbh->errstr(); + return undef; + } + my $tablename = &translate_id($table_id); + delete($Tables{$tablename}) if (exists($Tables{$tablename})); + return undef if (! defined(&update_table_info($table_id))); + $debugstring = "Created table $tablename at time ".time. + " with request\n$request"; + return $table_id; +} + +############################### + +=pod + +=item build_table_creation_request + +Input: table description + + table description = { + permanent => 'yes' or 'no', + columns => [ + { name => 'colA', + type => mysql type, + restrictions => 'NOT NULL' or empty, + primary_key => 'yes' or empty, + auto_inc => 'yes' or empty, + }, + { name => 'colB', + ... + }, + { name => 'colC', + ... + }, + ], + 'PRIMARY KEY' => (index_col_name,...), + KEY => [{ name => 'idx_name', + columns => (col1,col2,..),},], + INDEX => [{ name => 'idx_name', + columns => (col1,col2,..),},], + UNIQUE => [{ index => 'yes', + name => 'idx_name', + columns => (col1,col2,..),},], + FULLTEXT => [{ index => 'yes', + name => 'idx_name', + columns => (col1,col2,..),},], + + } + +Returns: scalar string containing mysql commands to create the table + +=cut + +############################### +sub build_table_creation_request { + my ($table_des)=@_; # # Build request to create table ################################## my @Columns; my $col_des; - my $table_id = &get_new_table_id(); + my $table_id; + if (exists($table_des->{'id'})) { + $table_id = $table_des->{'id'}; + } else { + $table_id = &get_new_table_id(); + } my $tablename = &translate_id($table_id); my $request = "CREATE TABLE IF NOT EXISTS ".$tablename." "; - foreach my $column (@{$table_des->{'column_order'}}) { + foreach my $coldata (@{$table_des->{'columns'}}) { + my $column = $coldata->{'name'}; + next if (! defined($column)); $col_des = ''; - my $coldata = $table_des->{'columns'}->{$column}; if (lc($coldata->{'type'}) =~ /(enum|set)/) { # 'enum' or 'set' $col_des.=$column." ".$coldata->{'type'}."('". join("', '",@{$coldata->{'values'}})."')"; @@ -570,37 +751,52 @@ sub create_table { # skip blank items. push (@Columns,$col_des) if ($col_des ne ''); } - if (exists($table_des->{'fulltext'})) { - push (@Columns,'FULLTEXT ('.join(',',@{$table_des->{'fulltext'}}).')'); + if (exists($table_des->{'PRIMARY KEY'})) { + push (@Columns,'PRIMARY KEY ('.join(',',@{$table_des->{'PRIMARY KEY'}}) + .')'); } + # + foreach my $indextype ('KEY','INDEX') { + next if (!exists($table_des->{$indextype})); + foreach my $indexdescription (@{$table_des->{$indextype}}) { + my $text = $indextype.' '; + if (exists($indexdescription->{'name'})) { + $text .=$indexdescription->{'name'}; + } + $text .= ' ('.join(',',@{$indexdescription->{'columns'}}).')'; + push (@Columns,$text); + } + } + # + foreach my $indextype ('UNIQUE','FULLTEXT') { + next if (! exists($table_des->{$indextype})); + foreach my $indexdescription (@{$table_des->{$indextype}}) { + my $text = $indextype.' '; + if (exists($indexdescription->{'index'}) && + $indexdescription->{'index'} eq 'yes') { + $text .= 'INDEX '; + } + if (exists($indexdescription->{'name'})) { + $text .=$indexdescription->{'name'}; + } + $text .= ' ('.join(',',@{$indexdescription->{'columns'}}).')'; + push (@Columns,$text); + } + } + # $request .= "(".join(", ",@Columns).") "; unless($table_des->{'permanent'} eq 'yes') { $request.="COMMENT = 'temporary' "; } $request .= "TYPE=MYISAM"; - # - # Execute the request to create the table - ############################################# - my $count = $dbh->do($request); - if (! defined($count)) { - $errorstring = "$dbh ATTEMPTED:\n".$request."\nRESULTING ERROR:\n"; - return undef; - } - # - # Set up the internal bookkeeping - ############################################# - delete($Tables{$tablename}) if (exists($Tables{$tablename})); - return undef if (! defined(&update_table_info($table_id))); - $debugstring = "Created table $tablename at time ".time. - " with request\n$request"; - return $table_id; + return $request,$table_id; } ############################### =pod -=item &get_new_table_id +=item &get_new_table_id() Used internally to prevent table name collisions. @@ -609,7 +805,6 @@ Used internally to prevent table name co ############################### sub get_new_table_id { my $newid = 0; - my $name_regex = '^'.$ENV{'user.name'}.'_'.$ENV{'user.domain'}."_(\d+)\$"; my @tables = &tables_in_db(); foreach (@tables) { if (/^$ENV{'user.name'}_$ENV{'user.domain'}_(\d+)$/) { @@ -623,7 +818,7 @@ sub get_new_table_id { =pod -=item &get_rows +=item &get_rows() Inputs: $table_id,$condition @@ -646,7 +841,13 @@ sub get_rows { return undef; } my $tablename = &translate_id($table_id); - my $request = 'SELECT * FROM '.$tablename.' WHERE '.$condition; + my $request; + if (defined($condition) && $condition ne '') { + $request = 'SELECT * FROM '.$tablename.' WHERE '.$condition; + } else { + $request = 'SELECT * FROM '.$tablename; + $condition = 'no condition'; + } my $sth=$dbh->prepare($request); $sth->execute(); if ($sth->err) { @@ -657,11 +858,6 @@ sub get_rows { } $debugstring = "Got rows matching $condition"; my @Results = @{$sth->fetchall_arrayref}; - foreach my $row (@Results) { - for(my $i=0;$i<@$row;$i++) { - $row->[$i]=&Apache::lonnet::unescape($row->[$i]); - } - } return @Results; } @@ -669,7 +865,7 @@ sub get_rows { =pod -=item &store_row +=item &store_row() Inputs: table id, row data @@ -711,7 +907,7 @@ sub store_row { @Parameters = @$rowdata; } elsif (ref($rowdata) eq 'HASH') { foreach (@{$Tables{$tablename}->{'Col_order'}}) { - push(@Parameters,&Apache::lonnet::escape($rowdata->{$_})); + push(@Parameters,$rowdata->{$_}); } } $sth->execute(@Parameters); @@ -724,11 +920,124 @@ sub store_row { return 1; } + +############################### + +=pod + +=item &bulk_store_rows() + +Inputs: table id, [columns],[[row data1].[row data2],...] + +returns undef on error, 1 on success. + +=cut + +############################### +sub bulk_store_rows { + my ($table_id,$columns,$rows) = @_; + # + return undef if (! defined(&connect_to_db())); + my $dbh = &get_dbh(); + return undef if (! defined($dbh)); + my $table_status = &check_table($table_id); + return undef if (! defined($table_status)); + if (! $table_status) { + $errorstring = "table $table_id does not exist."; + return undef; + } + # + my $tablename = &translate_id($table_id); + # + my $request = 'INSERT IGNORE INTO '.$tablename.' '; + if (defined($columns) && ref($columns) eq 'ARRAY') { + $request .= join(',',@$columns).' '; + } + if (! defined($rows) || ref($rows) ne 'ARRAY') { + $errorstring = "no input rows given."; + return undef; + } + $request .= 'VALUES '; + foreach my $row (@$rows) { + # avoid doing row stuff here... + $request .= '('.join(',',@$row).'),'; + } + $request =~ s/,$//; + $dbh->do($request); + if ($dbh->err) { + $errorstring = 'Attempted '.$/.$request.$/.'Got error '.$dbh->errstr(); + return undef; + } + return 1; +} + + +############################### + +=pod + +=item &replace_row() + +Inputs: table id, row data + +returns undef on error, 1 on success. + +Acts like &store_row() but uses the 'REPLACE' command instead of 'INSERT'. + +=cut + +############################### +sub replace_row { + my ($table_id,$rowdata) = @_; + # + return undef if (! defined(&connect_to_db())); + my $table_status = &check_table($table_id); + return undef if (! defined($table_status)); + if (! $table_status) { + $errorstring = "table $table_id does not exist."; + return undef; + } + # + my $tablename = &translate_id($table_id); + # + my $sth; + if (exists($Tables{$tablename}->{'row_replace_sth'})) { + $sth = $Tables{$tablename}->{'row_replace_sth'}; + } else { + # Build the insert statement handler + return undef if (! defined(&update_table_info($table_id))); + my $replace_request = 'REPLACE INTO '.$tablename.' VALUES('; + foreach (@{$Tables{$tablename}->{'Col_order'}}) { + $replace_request.="?,"; + } + chop $replace_request; + $replace_request.=")"; + $sth=$dbh->prepare($replace_request); + $Tables{$tablename}->{'row_replace_sth'}=$sth; + } + my @Parameters; + if (ref($rowdata) eq 'ARRAY') { + @Parameters = @$rowdata; + } elsif (ref($rowdata) eq 'HASH') { + foreach (@{$Tables{$tablename}->{'Col_order'}}) { + push(@Parameters,$rowdata->{$_}); + } + } + $sth->execute(@Parameters); + if ($sth->err) { + $errorstring = "$dbh ATTEMPTED replace @Parameters RESULTING ERROR:\n". + $sth->errstr; + return undef; + } + $debugstring = "Stored row."; + return 1; +} + ########################################### =pod -=item tables_in_db +=item &tables_in_db() Returns a list containing the names of all the tables in the database. Returns undef on error. @@ -738,27 +1047,29 @@ Returns undef on error. ########################################### sub tables_in_db { return undef if (!defined(&connect_to_db())); - my $sth=$dbh->prepare('SHOW TABLES;'); + my $sth=$dbh->prepare('SHOW TABLES'); $sth->execute(); - if ($sth->err) { - $errorstring = "$dbh ATTEMPTED:\n".'SHOW TABLES'. + $sth->execute(); + my $aref = $sth->fetchall_arrayref; + if ($sth->err()) { + $errorstring = + "$dbh ATTEMPTED:\n".'fetchall_arrayref after SHOW TABLES'. "\nRESULTING ERROR:\n".$sth->errstr; return undef; } - my $aref = $sth->fetchall_arrayref; - my @table_list=(); + my @table_list; foreach (@$aref) { - push @table_list,$_->[0]; + push(@table_list,$_->[0]); } - $debugstring = "Got list of tables in DB: @table_list"; - return @table_list; + $debugstring = "Got list of tables in DB: ".join(',',@table_list); + return(@table_list); } ########################################### =pod -=item &translate_id +=item &translate_id() Used internally to translate a numeric table id into a MySQL table name. If the input $id contains non-numeric characters it is assumed to have @@ -781,7 +1092,9 @@ sub translate_id { =pod -=item &check_table($id) +=item &check_table() + +Input: table id Checks to see if the requested table exists. Returns 0 (no), 1 (yes), or undef (error). @@ -797,7 +1110,7 @@ sub check_table { my @Table_list = &tables_in_db(); my $result = 0; foreach (@Table_list) { - if (/^$table_id$/) { + if ($_ eq $table_id) { $result = 1; last; } @@ -808,6 +1121,121 @@ sub check_table { return $result; } +########################################### + +=pod + +=item &remove_from_table() + +Input: $table_id, $column, $value + +Returns: the number of rows deleted. undef on error. + +Executes a "delete from $tableid where $column like binary '$value'". + +=cut + +########################################### +sub remove_from_table { + my ($table_id,$column,$value) = @_; + return undef if (!defined(&connect_to_db())); + # + $table_id = &translate_id($table_id); + my $command = 'DELETE FROM '.$table_id.' WHERE '.$column. + " LIKE BINARY ".$dbh->quote($value); + my $sth = $dbh->prepare($command); + unless ($sth->execute()) { + $errorstring = "ERROR on execution of ".$command."\n".$sth->errstr; + return undef; + } + $debugstring = $command; + my $rows = $sth->rows; + return $rows; +} + +########################################### + +=pod + +=item drop_table($table_id) + +Issues a 'drop table if exists' command + +=cut + +########################################### + +sub drop_table { + my ($table_id) = @_; + return undef if (!defined(&connect_to_db())); + # + $table_id = &translate_id($table_id); + my $command = 'DROP TABLE IF EXISTS '.$table_id; + my $sth = $dbh->prepare($command); + $sth->execute(); + if ($sth->err) { + $errorstring = "ERROR on execution of ".$command."\n".$sth->errstr; + return undef; + } + $debugstring = $command; + delete($Tables{$table_id}); # remove any knowledge of the table + return 1; # if we got here there was no error, so return a 'true' value +} + +########################################## + +=pod + +=item fix_table_name + +Fixes a table name so that it will work with MySQL. + +=cut + +########################################## +sub fix_table_name { + my ($name) = @_; + $name =~ s/^(\d+e\d+)/_$1/; + return $name; +} + + +# ---------------------------- convert 'time' format into a datetime sql format +sub sqltime { + my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = + localtime(&unsqltime($_[0])); + $mon++; $year+=1900; + return "$year-$mon-$mday $hour:$min:$sec"; +} + +sub maketime { + my %th=@_; + return POSIX::mktime(($th{'seconds'},$th{'minutes'},$th{'hours'}, + $th{'day'},$th{'month'}-1, + $th{'year'}-1900,0,0,$th{'dlsav'})); +} + + +######################################### +# +# Retro-fixing of un-backward-compatible time format + +sub unsqltime { + my $timestamp=shift; + if ($timestamp=~/^(\d+)\-(\d+)\-(\d+)\s+(\d+)\:(\d+)\:(\d+)$/) { + $timestamp=&maketime('year'=>$1,'month'=>$2,'day'=>$3, + 'hours'=>$4,'minutes'=>$5,'seconds'=>$6); + } + return $timestamp; +} + + 1; __END__; + +=pod + +=back + +=cut 500 Internal Server Error

Internal Server Error

The server encountered an internal error or misconfiguration and was unable to complete your request.

Please contact the server administrator at root@localhost to inform them of the time this error occurred, and the actions you performed just before this error.

More information about this error may be available in the server error log.