[LON-CAPA-cvs] cvs: loncom /interface lonmysql.pm
matthew
lon-capa-cvs@mail.lon-capa.org
Fri, 26 Jul 2002 16:22:24 -0000
This is a MIME encoded message
--matthew1027700544
Content-Type: text/plain
matthew Fri Jul 26 12:22:24 2002 EDT
Added files:
/loncom/interface lonmysql.pm
Log:
LON-CAPA interface to MySQLs loncapa database. perldoc lonmysql.pm for more
information and interface description. Not yet complete, but reasonably close.
--matthew1027700544
Content-Type: text/plain
Content-Disposition: attachment; filename="matthew-20020726122224.txt"
Index: loncom/interface/lonmysql.pm
+++ loncom/interface/lonmysql.pm
# The LearningOnline Network with CAPA
# MySQL utility functions
#
# $Id: lonmysql.pm,v 1.1 2002/07/26 16:22:24 matthew Exp $
#
# Copyright Michigan State University Board of Trustees
#
# This file is part of the LearningOnline Network with CAPA (LON-CAPA).
#
# LON-CAPA is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# LON-CAPA is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with LON-CAPA; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
#
# /home/httpd/html/adm/gpl.txt
#
# http://www.lon-capa.org/
#
######################################################################
package Apache::lonmysql;
use strict;
use DBI;
use Apache::lonnet();
######################################################################
######################################################################
=pod
=head1 Name
lonmysql - LONCAPA MySQL utility functions
=head1 Synopsis
lonmysql contains utility functions to make accessing the mysql loncapa
database easier.
=head1 Description
lonmysql does its best to encapsulate all the database/table functions
and provide a common interface. The goal, however, is not to provide
a complete reimplementation of the DBI interface. Instead we try to
make using mysql as painless as possible.
Each table has a numeric ID that is a parameter to most lonmysql functions.
The table id is returned by &create_table.
If you lose the table id, it is lost forever.
The table names in MySQL correspond to
$ENV{'user.name'}.'_'.$ENV{'user.domain'}.'_'.$table_id. If the table id
is non-numeric, it is assumed to be the full name of a table. If you pass
the table id in a form, you MUST ensure that what you send to lonmysql is
numeric, otherwise you are opening up all the tables in the MySQL database.
=over 4
=item Creating a table
To create a table, you need a description of its structure. See the entry
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' },
idx_verbage => { type => 'FULLTEXT',
target => 'verbage'
}
},
column_order => [qw/id verbage idx_verbage/]
});
The above command will create a table with two columns, 'id' and 'verbage'.
'id' will be an integer which is autoincremented and non-null.
'verbage' will be of type 'TEXT', which (conceivably) allows any length
text string to be stored. Depending on your intentions for this database,
setting restrictions => 'NOT NULL' may help you avoid storing empty data.
'idx_verbage' sets up the 'verbage' column for 'FULLTEXT' searching.
=item Storing rows
Storing a row in a table requires calling &store_row($table_id,$data)
$data is either a hash reference or an array reference. If it is an array
reference, the data is passed as is (after being escaped) to the
"INSERT INTO <table> VALUES( ... )" SQL command. If $data is a hash reference,
the data will be placed into an array in the proper column order for the table
and then passed to the database.
An example of inserting into the table created above is:
&store_row($table_id,[undef,'I am not a crackpot!']);
or equivalently,
&store_row($table_id,{ verbage => 'I am not a crackpot!'});
Since the above table was created with the first column ('id') as
autoincrement, providing a value is unnecessary even though the column was
marked as 'NOT NULL'.
In the future an array of arrays or hashes may be supported, but currently
the system only performs one insert at a time. Given the nature of this
interface, transactions (locking of the table) are not supported.
=item Retrieving rows
Retrieving rows requires calling get_rows:
@row = &Apache::lonmysql::get_rows($table_id,$condition)
This results in the query "SELECT * FROM <table> HAVING $condition".
@row = &Apache::lonmysql::get_rows($table_id,'id>20');
returns all rows with column 'id' greater than 20.
=back
=cut
######################################################################
######################################################################
=pod
=head1 Package Variables
=over 4
=cut
##################################################
##################################################
=pod
=item %Tables
Holds information regarding the currently open connections. Each key
in the %Tables hash will be a unique table key. The value associated
with a key is a hash reference. Most values are initialized when the
table is created.
The following entries are allowed in the hash reference:
=over 4
=item columns
The columns information required by &create_table.
=item column_order
Reference to an array containing the order of columns in the table.
=item table_info
Set to the results of &get_table_info.
=item row_insert_sth
The statement handler for row inserts.
=back
=cut
##################################################
##################################################
my %Tables;
##################################################
##################################################
=pod
=item $errorstring
Holds the last error.
=cut
##################################################
##################################################
my $errorstring;
##################################################
##################################################
=pod
=item $debugstring
Describes current events within the package.
=cut
##################################################
##################################################
my $debugstring;
##################################################
##################################################
=pod
=item $dbh
The database handler; The actual connection to MySQL via the perl DBI.
=cut
##################################################
##################################################
my $dbh;
##################################################
##################################################
# End of global variable declarations
=pod
=back
=cut
######################################################################
######################################################################
=pod
=head1 Internals
=over 4
=cut
######################################################################
######################################################################
=pod
=item &connect_to_db()
Inputs: none.
Returns: undef on error, 1 on success.
Checks to make sure the database has been connected to. If not, the
connection is established.
=cut
###############################
sub connect_to_db {
return 1 if ($dbh);
if (! ($dbh = DBI->connect("DBI:mysql:loncapa","www",
$Apache::lonnet::perlvar{'lonSqlAccess'},
{ RaiseError=>0,PrintError=>0}))) {
$debugstring = "Unable to connect to loncapa database.";
if ($dbh->err) {
$errorstring = "Connection error: ".$dbh->errstr;
}
return undef;
}
# The code below will let us switch to a different database.
# my $db_command = "USE $db;";
# my $sth = $dbh->prepare($db_command);
# $sth->execute();
# if ($sth->err) {
# # Unable to use the database. Interesting...
# $dbh->disconnect;
# return undef;
# }
$debugstring = "Successfully connected to loncapa database.";
return 1;
}
###############################
=pod
=item &disconnect_from_db()
Inputs: none.
Returns: Always returns 1.
Severs the connection to the mysql database.
=cut
###############################
sub disconnect_from_db {
foreach (keys(%Tables)) {
# Supposedly, having statement handlers running around after the
# database connection has been lost will cause trouble. So we
# kill them off just to be sure.
if (exists($Tables{$_}->{'row_insert_sth'})) {
delete($Tables{$_}->{'row_insert_sth'});
}
}
$dbh->disconnect if ($dbh);
$debugstring = "Disconnected from database.";
$dbh = undef;
return 1;
}
###############################
=pod
=item &query_table()
Currently unimplemented.
=cut
###############################
sub query_table {
# someday this will work.
}
###############################
=pod
=item &get_error()
Inputs: none.
Returns: The last error reported.
=cut
###############################
sub get_error {
return $errorstring;
}
###############################
=pod
=item &get_debug()
Inputs: none.
Returns: A string describing the internal state of the lonmysql package.
=cut
###############################
sub get_debug {
return $debugstring;
}
###############################
=pod
=item &get_table_info($table_id)
Inputs: table id
Returns: undef or a pointer to a hash of data about a table.
&get_table_info returns all of the information it can about a table in the
form of a hash. Currently the fields in the hash are:
Name Type Row_format
Max_data_length Index_length Data_free
Create_time Update_time Check_time
Avg_row_length Data_length Comment
Rows Auto_increment Create_options
=cut
###############################
sub get_table_info {
my ($table_id) = @_;
my $tablename = &translate_id($table_id);
return undef if (! &check_table($table_id));
my %tableinfo;
my @tabledesc = qw/
Name Type Row_format Rows Avg_row_length Data_length
Max_data_length Index_length Data_free Auto_increment
Create_time Update_time Check_time Create_options Comment /;
my $db_command = "SHOW TABLE STATUS FROM loncapa LIKE '$tablename'";
my $sth = $dbh->prepare($db_command);
$sth->execute();
if ($sth->err) {
# Unable to use the database. Interesting...
$errorstring = "$dbh ATTEMPTED:\n".$db_command."\nRESULTING ERROR:\n".
$sth->errstr;
$dbh->disconnect;
return undef;
}
#
my @info=$sth->fetchrow_array;
for (my $i=0;$i<= $#info ; $i++) {
$tableinfo{$tabledesc[$i]}= $info[$i];
}
#
$debugstring = "Retrieved table info for $tablename";
return \%tableinfo;
}
###############################
=pod
=item &create_table
Inputs:
table description
Input formats:
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,
target => 'colB' (only if type eq 'FULLTEXT'),
}
colB => { .. }
colZ => { .. }
},
column_order => [ colA, colB, ..., colZ],
}
Returns:
undef on error, table id on success.
=cut
###############################
sub create_table {
return undef if (!&connect_to_db($dbh));
my ($table_des)=@_;
#
# Build request to create table
##################################
my @Columns;
my $col_des;
my $tableid = &get_new_table_id();
my $tablename = &translate_id($tableid);
my $request = "CREATE TABLE IF NOT EXISTS ".$tablename." ";
foreach my $column (@{$table_des->{'column_order'}}) {
$col_des = '';
my $coldata = $table_des->{'columns'}->{$column};
if (lc($coldata->{'type'}) eq 'fulltext') {
$col_des.='FULLTEXT '.$column." (".$coldata->{'target'}.")";
next; # Skip to the continue block and store the column data
} elsif (lc($coldata->{'type'}) =~ /(enum|set)/) { # 'enum' or 'set'
$col_des.=$column." ".$coldata->{'type'}."('".
join("', '",@{$coldata->{'values'}})."')";
} else {
$col_des.=$column." ".$coldata->{'type'};
if (exists($coldata->{'size'})) {
$col_des.="(".$coldata->{'size'}.")";
}
}
# Modifiers
if (exists($coldata->{'restrictions'})){
$col_des.=" ".$coldata->{'restrictions'};
}
if (exists($coldata->{'default'})) {
$col_des.=" DEFAULT '".$coldata->{'default'}."'";
}
$col_des.=' AUTO_INCREMENT' if (exists($coldata->{'auto_inc'}));
$col_des.=' PRIMARY KEY' if (exists($coldata->{'primary_key'}));
} continue {
# skip blank items.
push (@Columns,$col_des) if ($col_des ne '');
}
$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}));
my @column_order_copy = @{$table_des->{'column_order'}};
$Tables{$tablename} = {
columns => $table_des->{'columns'},
column_order => $table_des->{'column_order'},
table_info => &get_table_info($tableid),
};
$debugstring = "$dbh Created table $tablename at time ".time.
" with request\n$request";
return $tableid;
}
###############################
=pod
=item &get_new_table_id
Used internally to prevent table name collisions.
=cut
###############################
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+)$/) {
$newid = $1 if ($1 > $newid);
}
}
return ++$newid;
}
###############################
=pod
=item &execute_db_command
Currently unimplemented
=cut
###############################
sub execute_db_command {
my ($tablename,$command) = @_;
return 1;
}
###############################
=pod
=item &get_rows
Inputs: $table_id,$condition
Returns: undef on error, an array ref to (array of) results on success.
Internally, this function does a 'SELECT * FROM table HAVING $condition'.
$condition = 'id>0' will result in all rows where column 'id' has a value
greater than 0 being returned.
=cut
###############################
sub get_rows {
my ($table_id,$condition) = @_;
my $tablename = &translate_id($table_id);
my $request = 'SELECT * FROM '.$tablename.' HAVING '.$condition;
my $sth=$dbh->prepare($request);
$sth->execute();
if ($sth->err) {
$errorstring = "$dbh ATTEMPTED:\n".$request."\nRESULTING ERROR:\n".
$sth->errstr;
$debugstring = "Failed to get rows matching $condition";
return undef;
}
$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;
}
###############################
=pod
=item &store_row
Inputs: table id, row data
returns undef on error, 1 on success.
=cut
###############################
sub store_row {
my ($table_id,$rowdata) = @_;
my $tablename = &translate_id($table_id);
my $table = $Tables{$tablename};
my $sth;
if (exists($table->{'row_insert_sth'})) {
$sth = $table->{'row_insert_sth'};
} else {
# We need to build a statement handler
my $insert_request = 'INSERT INTO '.$tablename.' VALUES(';
foreach (@{$table->{'column_order'}}) {
# Skip the 'fulltext' columns.
next if (lc($table->{'columns'}->{$_}->{'type'}) eq 'fulltext');
$insert_request.="?,";
}
chop $insert_request;
$insert_request.=")";
$sth=$dbh->prepare($insert_request);
}
my @Parameters;
if (ref($rowdata) eq 'ARRAY') {
@Parameters = @$rowdata;
} elsif (ref($rowdata) eq 'HASH') {
foreach (@{$table->{'column_order'}}) {
# Is this appropriate? Am I being presumptious? ACK!!!!!
next if (lc($table->{'columns'}->{$_}->{'type'}) eq 'fulltext');
push(@Parameters,&Apache::lonnet::escape($rowdata->{$_}));
}
}
$sth->execute(@Parameters);
if ($sth->err) {
$errorstring = "$dbh ATTEMPTED insert @Parameters RESULTING ERROR:\n".
$sth->errstr;
return undef;
}
$debugstring = "Stored row.";
return 1;
}
###########################################
=pod
=item tables_in_db
Returns a list containing the names of all the tables in the database.
Returns undef on error.
=cut
###########################################
sub tables_in_db {
return undef if (! &connect_to_db()); # bail out if we cannot connect
my $sth=$dbh->prepare('SHOW TABLES;');
$sth->execute();
if ($sth->err) {
$errorstring = "$dbh ATTEMPTED:\n".'SHOW TABLES'."\nRESULTING ERROR:\n".
$sth->errstr;
return undef;
}
my $aref = $sth->fetchall_arrayref;
my @table_list=();
foreach (@$aref) {
push @table_list,$_->[0];
}
$debugstring = "Got list of tables in DB: @table_list";
return @table_list;
}
###########################################
=pod
=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
already been translated.
Checks are NOT performed to see if the table actually exists.
=cut
###########################################
sub translate_id {
my $id = shift;
# id should be a digit. If it is not a digit we assume the given id
# is complete and does not need to be translated.
return $id if ($id =~ /\D/);
return $ENV{'user.name'}.'_'.$ENV{'user.domain'}.'_'.$id;
}
###########################################
=pod
=item &check_table($id)
Checks to see if the requested table exists. Returns 0 (no), 1 (yes), or
undef (error).
=cut
###########################################
sub check_table {
my $table_id = shift;
$table_id = &translate_id($table_id);
return undef if (! &connect_to_db());
my @Table_list = &tables_in_db();
my $result = 0;
foreach (@Table_list) {
if (/^$table_id$/) {
$result = 1;
last;
}
}
# If it does not exist, make sure we do not have it listed in %Tables
delete($Tables{$table_id}) if ((! $result) && exists($Tables{$table_id}));
$debugstring = "check_table returned $result for $table_id";
return $result;
}
1;
__END__;
--matthew1027700544--