# The LearningOnline Network with CAPA
#
# $Id: lonmetadata.pm,v 1.36 2012/03/15 20:53:27 www 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 LONCAPA::lonmetadata;
use strict;
use DBI;
use HTML::TokeParser;
use vars qw($Metadata_Table_Description $Portfolio_metadata_table_description
$Portfolio_access_table_description $Fulltext_indicies $Portfolio_metadata_indices $Portfolio_access_indices $Portfolio_addedfields_table_description $Portfolio_addedfields_indices $Allusers_table_description $Allusers_indices);
######################################################################
######################################################################
=pod
=head1 Name
lonmetadata
=head1 Synopsis
lonmetadata holds a description of the metadata table and provides
wrappers for the storage and retrieval of metadata to/from the database.
=head1 Description
=head1 Methods
=over 4
=cut
######################################################################
######################################################################
=pod
=item Old table creation command
CREATE TABLE IF NOT EXISTS metadata
(title TEXT,
author TEXT,
subject TEXT,
url TEXT,
keywords TEXT,
version TEXT,
notes TEXT,
abstract TEXT,
mime TEXT,
language TEXT,
creationdate DATETIME,
lastrevisiondate DATETIME,
owner TEXT,
copyright TEXT,
domain TEXT
FULLTEXT idx_title (title),
FULLTEXT idx_author (author),
FULLTEXT idx_subject (subject),
FULLTEXT idx_url (url),
FULLTEXT idx_keywords (keywords),
FULLTEXT idx_version (version),
FULLTEXT idx_notes (notes),
FULLTEXT idx_abstract (abstract),
FULLTEXT idx_mime (mime),
FULLTEXT idx_language (language),
FULLTEXT idx_owner (owner),
FULLTEXT idx_copyright (copyright))
ENGINE=MYISAM;
=cut
######################################################################
######################################################################
$Metadata_Table_Description =
[
{ name => 'title', type=>'TEXT'},
{ name => 'author', type=>'TEXT'},
{ name => 'subject', type=>'TEXT'},
{ name => 'url', type=>'TEXT', restrictions => 'NOT NULL' },
{ name => 'keywords', type=>'TEXT'},
{ name => 'version', type=>'TEXT'},
{ name => 'notes', type=>'TEXT'},
{ name => 'abstract', type=>'TEXT'},
{ name => 'mime', type=>'TEXT'},
{ name => 'language', type=>'TEXT'},
{ name => 'creationdate', type=>'DATETIME'},
{ name => 'lastrevisiondate', type=>'DATETIME'},
{ name => 'owner', type=>'TEXT'},
{ name => 'copyright', type=>'TEXT'},
{ name => 'domain', type=>'TEXT'},
#--------------------------------------------------
{ name => 'dependencies', type=>'TEXT'},
{ name => 'modifyinguser', type=>'TEXT'},
{ name => 'authorspace', type=>'TEXT'},
{ name => 'lowestgradelevel', type=>'INT'},
{ name => 'highestgradelevel', type=>'INT'},
{ name => 'standards', type=>'TEXT'},
{ name => 'count', type=>'INT'},
{ name => 'course', type=>'INT'},
{ name => 'course_list', type=>'TEXT'},
{ name => 'goto', type=>'INT'},
{ name => 'goto_list', type=>'TEXT'},
{ name => 'comefrom', type=>'INT'},
{ name => 'comefrom_list', type=>'TEXT'},
{ name => 'sequsage', type=>'INT'},
{ name => 'sequsage_list', type=>'TEXT'},
{ name => 'stdno', type=>'INT'},
{ name => 'stdno_list', type=>'TEXT'},
{ name => 'avetries', type=>'FLOAT'},
{ name => 'avetries_list', type=>'TEXT'},
{ name => 'difficulty', type=>'FLOAT'},
{ name => 'difficulty_list',type=>'TEXT'},
{ name => 'disc', type=>'FLOAT'},
{ name => 'disc_list', type=>'TEXT'},
{ name => 'clear', type=>'FLOAT'},
{ name => 'technical', type=>'FLOAT'},
{ name => 'correct', type=>'FLOAT'},
{ name => 'helpful', type=>'FLOAT'},
{ name => 'depth', type=>'FLOAT'},
{ name => 'hostname', type=> 'TEXT'},
#--------------------------------------------------
];
$Fulltext_indicies = [ qw/
title
author
subject
url
keywords
version
notes
abstract
mime
language
owner
copyright/ ];
######################################################################
######################################################################
$Portfolio_metadata_table_description =
[
{ name => 'title', type=>'TEXT'},
{ name => 'author', type=>'TEXT'},
{ name => 'subject', type=>'TEXT'},
{ name => 'url', type=>'TEXT', restrictions => 'NOT NULL' },
{ name => 'keywords', type=>'TEXT'},
{ name => 'version', type=>'TEXT'},
{ name => 'notes', type=>'TEXT'},
{ name => 'abstract', type=>'TEXT'},
{ name => 'mime', type=>'TEXT'},
{ name => 'language', type=>'TEXT'},
{ name => 'creationdate', type=>'DATETIME'},
{ name => 'lastrevisiondate', type=>'DATETIME'},
{ name => 'owner', type=>'TEXT'},
{ name => 'copyright', type=>'TEXT'},
{ name => 'domain', type=>'TEXT'},
{ name => 'groupname', type=>'TEXT'},
{ name => 'courserestricted', type=>'TEXT'},
#--------------------------------------------------
{ name => 'dependencies', type=>'TEXT'},
{ name => 'modifyinguser', type=>'TEXT'},
{ name => 'authorspace', type=>'TEXT'},
{ name => 'lowestgradelevel', type=>'INT'},
{ name => 'highestgradelevel', type=>'INT'},
{ name => 'standards', type=>'TEXT'},
{ name => 'hostname', type=> 'TEXT'},
#--------------------------------------------------
];
$Portfolio_metadata_indices = [qw/
title
author
subject
url
keywords
version
notes
abstract
mime
language
owner/];
######################################################################
######################################################################
$Portfolio_access_table_description =
[
{ name => 'url', type=>'TEXT', restrictions => 'NOT NULL' },
{ name => 'keynum', type=>'TEXT', restrictions => 'NOT NULL' },
{ name => 'scope', type=>'TEXT'},
{ name => 'start', type=>'DATETIME'},
{ name => 'end', type=>'DATETIME'},
];
$Portfolio_access_indices = [qw/
url
keynum
scope
start
end/];
######################################################################
######################################################################
$Portfolio_addedfields_table_description =
[
{ name => 'url', type=>'TEXT', restrictions => 'NOT NULL' },
{ name => 'field', type=>'TEXT', restrictions => 'NOT NULL' },
{ name => 'courserestricted', type=>'TEXT', restrictions => 'NOT NULL' },
{ name => 'value', type=>'TEXT'},
];
$Portfolio_addedfields_indices = [qw/
url
field
value
courserestricted/];
######################################################################
######################################################################
$Allusers_table_description =
[
{ name => 'username', type=>'TEXT', restrictions => 'NOT NULL' },
{ name => 'domain', type=>'TEXT', restrictions => 'NOT NULL' },
{ name => 'lastname', type=>'TEXT',},
{ name => 'firstname', type=>'TEXT'},
{ name => 'middlename', type=>'TEXT'},
{ name => 'generation', type=>'TEXT'},
{ name => 'permanentemail', type=>'TEXT'},
{ name => 'id', type=>'TEXT'},
];
$Allusers_indices = [qw/
username
domain
lastname
firstname/];
######################################################################
######################################################################
=pod
=item &describe_metadata_storage
Input: None
Returns: An array of hash references describing the columns and indicies
of the metadata table(s).
=cut
######################################################################
######################################################################
sub describe_metadata_storage {
my ($tabletype) = @_;
my %table_description = (
metadata => $Metadata_Table_Description,
portfolio_metadata => $Portfolio_metadata_table_description,
portfolio_access => $Portfolio_access_table_description,
portfolio_addedfields => $Portfolio_addedfields_table_description,
allusers => $Allusers_table_description,
);
my %index_description = (
metadata => $Fulltext_indicies,
portfolio_metadata => $Portfolio_metadata_indices,
portfolio_access => $Portfolio_access_indices,
portfolio_addedfields => $Portfolio_addedfields_indices,
allusers => $Allusers_indices,
);
if ($tabletype eq 'portfolio_search') {
my @portfolio_search_table = @{$table_description{portfolio_metadata}};
foreach my $item (@{$table_description{portfolio_access}}) {
if (ref($item) eq 'HASH') {
if ($item->{'name'} eq 'url') {
next;
}
}
push(@portfolio_search_table,$item);
}
my @portfolio_search_indices = @{$index_description{portfolio_metadata}};
push(@portfolio_search_indices,('scope','keynum'));
return (\@portfolio_search_table,\@portfolio_search_indices);
} else {
return ($table_description{$tabletype},$index_description{$tabletype});
}
}
######################################################################
######################################################################
=pod
=item create_metadata_storage()
Inputs: table name (optional): the name of the table. Default is 'metadata'.
Returns: A perl string which, when executed by MySQL, will cause the
metadata storage to be initialized.
=cut
######################################################################
######################################################################
sub create_metadata_storage {
my ($tablename,$tabletype) = @_;
$tablename = 'metadata' if (! defined($tablename));
$tabletype = 'metadata' if (! defined($tabletype));
my $request = "CREATE TABLE IF NOT EXISTS ".$tablename." ";
#
# Process the columns (this code is stolen from lonmysql.pm)
my @Columns;
my $col_des; # mysql column description
my ($table_columns,$table_indices) =
&describe_metadata_storage($tabletype);
my %coltype;
foreach my $coldata (@{$table_columns}) {
my $column = $coldata->{'name'};
$coltype{$column} = $coldata->{'type'};
$col_des = '';
if (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'}.")";
}
}
if (($tablename =~ /allusers/) && ($column eq 'username')) {
$col_des .= ' CHARACTER SET latin1 COLLATE latin1_general_cs';
}
# 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'}) &&
($coldata->{'auto_inc'} eq 'yes'));
$col_des.=' PRIMARY KEY' if (exists($coldata->{'primary_key'}) &&
($coldata->{'primary_key'} eq 'yes'));
} continue {
# skip blank items.
push (@Columns,$col_des) if ($col_des ne '');
}
foreach my $colname (@{$table_indices}) {
my $text;
if ($coltype{$colname} eq 'TEXT') {
$text = 'FULLTEXT ';
} else {
$text = 'INDEX ';
}
$text .= 'idx_'.$colname.' ('.$colname.')';
push (@Columns,$text);
}
$request .= "(".join(", ",@Columns).") ENGINE=MyISAM";
return $request;
}
######################################################################
######################################################################
=pod
=item store_metadata()
Inputs: database handle ($dbh), a table name, table type and a hash or hash
reference containing the metadata for a single resource.
Returns: 1 on success, 0 on failure to store.
=cut
######################################################################
######################################################################
{
##
## WARNING: The following cleverness may cause trouble in cases where
## the dbi connection is dropped and recreated - a stale statement
## handler may linger around and cause trouble.
##
## In most scripts, this will work fine. If the dbi is going to be
## dropped and (possibly) later recreated, call &clear_sth. Yes it
## is annoying but $sth apparently does not have a link back to the
## $dbh, so we can't check our validity.
##
my $sth = undef;
my $sth_table = undef;
sub create_statement_handler {
my ($dbh,$tablename,$tabletype) = @_;
$tablename = 'metadata' if (! defined($tablename));
$tabletype = 'metadata' if (! defined($tabletype));
my ($table_columns,$table_indices) =
&describe_metadata_storage($tabletype);
$sth_table = $tablename;
my $request = 'INSERT INTO '.$tablename.' VALUES(';
foreach (@{$table_columns}) {
$request .= '?,';
}
chop $request;
$request.= ')';
$sth = $dbh->prepare($request);
return;
}
sub clear_sth { $sth=undef; $sth_table=undef;}
sub store_metadata {
my ($dbh,$tablename,$tabletype,@Metadata)=@_;
my $errors = '';
if (! defined($sth) ||
( defined($tablename) && ($sth_table ne $tablename)) ||
(! defined($tablename) && $sth_table ne 'metadata')) {
&create_statement_handler($dbh,$tablename,$tabletype);
}
my $successcount = 0;
if (! defined($tabletype)) {
$tabletype = 'metadata';
}
my ($table_columns,$table_indices) =
&describe_metadata_storage($tabletype);
foreach my $mdata (@Metadata) {
next if (ref($mdata) ne "HASH");
my @MData;
foreach my $field (@{$table_columns}) {
my $fname = $field->{'name'};
if (exists($mdata->{$fname}) &&
defined($mdata->{$fname}) &&
$mdata->{$fname} ne '') {
if ($mdata->{$fname} eq 'nan' ||
$mdata->{$fname} eq '') {
push(@MData,'NULL');
} else {
push(@MData, $field->{type} eq 'DATETIME' ?
sqltime($mdata->{$fname}) : $mdata->{$fname});
}
} else {
push(@MData,undef);
}
}
$sth->execute(@MData);
if (! $sth->err) {
$successcount++;
} else {
$errors = join(',',$errors,$sth->errstr);
}
$errors =~ s/^,//;
}
if (wantarray()) {
return ($successcount,$errors);
} else {
return $successcount;
}
}
}
######################################################################
######################################################################
=pod
=item lookup_metadata()
Inputs: database handle ($dbh) and a hash or hash reference containing
metadata which will be used for a search.
Returns: scalar with error string on failure, array reference on success.
The array reference is the same one returned by $sth->fetchall_arrayref().
=cut
######################################################################
######################################################################
sub lookup_metadata {
my ($dbh,$condition,$fetchparameter,$tablename) = @_;
$tablename = 'metadata' if (! defined($tablename));
my $error;
my $returnvalue=[];
my $request = 'SELECT * FROM '.$tablename;
if (defined($condition)) {
$request .= ' WHERE '.$condition;
}
my $sth = $dbh->prepare($request);
if ($sth->err) {
$error = $sth->errstr;
}
if (! $error) {
$sth->execute();
if ($sth->err) {
$error = $sth->errstr;
} else {
$returnvalue = $sth->fetchall_arrayref($fetchparameter);
if ($sth->err) {
$error = $sth->errstr;
}
}
}
return ($error,$returnvalue);
}
######################################################################
######################################################################
=pod
=item delete_metadata()
Removes a single metadata record, based on its url.
Inputs: $dbh, the database handler.
$tablename, the name of the metadata table to remove from. default: 'metadata'
$delitem, the resource to remove from the metadata database, in the form:
url = quoted url
Returns: undef on success, dbh errorstr on failure.
=cut
######################################################################
######################################################################
sub delete_metadata {
my ($dbh,$tablename,$delitem) = @_;
$tablename = 'metadata' if (! defined($tablename));
my ($error,$delete_command);
if ($delitem eq '') {
$error = 'deletion aborted - no resource specified';
} else {
$delete_command = 'DELETE FROM '.$tablename.' WHERE '.$delitem;
$dbh->do($delete_command);
if ($dbh->err) {
$error = $dbh->errstr();
}
}
return $error;
}
######################################################################
######################################################################
=pod
=item update_metadata
Updates metadata record in mysql database. It does not matter if the record
currently exists. Fields not present in the new metadata will be taken
from the current record, if it exists. To delete an entry for a key, set
it to "" or undef.
Inputs:
$dbh, database handle
$newmetadata, hash reference containing the new metadata
$tablename, metadata table name. Defaults to 'metadata'.
$tabletype, type of table (metadata, portfolio_metadata, portfolio_access,
allusers)
$conditions, optional hash of conditions to use in SQL queries;
default used if none provided.
Returns:
$error on failure. undef on success.
=cut
######################################################################
######################################################################
sub update_metadata {
my ($dbh,$tablename,$tabletype,$newmetadata,$conditions)=@_;
my ($error,$condition);
$tablename = 'metadata' if (! defined($tablename));
$tabletype = 'metadata' if (! defined($tabletype));
if (ref($conditions) eq 'HASH') {
my @items;
foreach my $key (keys(%{$conditions})) {
if (! exists($newmetadata->{$key})) {
$error .= "Unable to update: no $key specified";
} else {
push(@items,"$key = ".$dbh->quote($newmetadata->{$key}));
}
}
$condition = join(' AND ',@items);
} else {
if (! exists($newmetadata->{'url'})) {
$error = 'Unable to update: no url specified';
} else {
$condition = 'url = '.$dbh->quote($newmetadata->{'url'});
}
}
return $error if (defined($error));
#
# Retrieve current values
my $row;
($error,$row) = &lookup_metadata($dbh,$condition,undef,$tablename);
return $error if ($error);
my %metadata = &LONCAPA::lonmetadata::metadata_col_to_hash($tabletype,@{$row->[0]});
#
# Update metadata values
while (my ($key,$value) = each(%$newmetadata)) {
$metadata{$key} = $value;
}
#
# Delete old data (deleting a nonexistant record does not produce an error.
$error = &delete_metadata($dbh,$tablename,$condition);
return $error if (defined($error));
#
# Store updated metadata
my $success;
($success,$error) = &store_metadata($dbh,$tablename,$tabletype,\%metadata);
return $error;
}
######################################################################
######################################################################
=pod
=item metdata_col_to_hash
Input: Array of metadata columns
Return: Hash with the metadata columns as keys and the array elements
passed in as values
=cut
######################################################################
######################################################################
sub metadata_col_to_hash {
my ($tabletype,@cols)=@_;
my %hash=();
my ($columns,$indices) = &describe_metadata_storage($tabletype);
for (my $i=0; $i<@{$columns};$i++) {
$hash{$columns->[$i]->{'name'}}=$cols[$i];
unless ($hash{$columns->[$i]->{'name'}}) {
if ($columns->[$i]->{'type'} eq 'TEXT') {
$hash{$columns->[$i]->{'name'}}='';
} elsif ($columns->[$i]->{'type'} eq 'DATETIME') {
$hash{$columns->[$i]->{'name'}}='0000-00-00 00:00:00';
} else {
$hash{$columns->[$i]->{'name'}}=0;
}
}
}
return %hash;
}
######################################################################
######################################################################
=pod
=item nohist_resevaldata.db data structure
The nohist_resevaldata.db file has the following possible keys:
Statistics Data (values are integers, perl times, or real numbers)
------------------------------------------
$course___$resource___avetries
$course___$resource___count
$course___$resource___difficulty
$course___$resource___stdno
$course___$resource___timestamp
Evaluation Data (values are on a 1 to 5 scale)
------------------------------------------
$username@$dom___$resource___clear
$username@$dom___$resource___comments
$username@$dom___$resource___depth
$username@$dom___$resource___technical
$username@$dom___$resource___helpful
$username@$dom___$resource___correct
Course Context Data
------------------------------------------
$course___$resource___course course id
$course___$resource___comefrom resource preceeding this resource
$course___$resource___goto resource following this resource
$course___$resource___usage resource containing this resource
New statistical data storage
------------------------------------------
$course&$sec&$numstud___$resource___stats
$sec is a string describing the sections: all, 1 2, 1 2 3,...
Value is a '&' deliminated list of key=value pairs.
Possible keys are (currently) disc,course,sections,difficulty,
stdno, timestamp
=cut
######################################################################
######################################################################
=pod
=item &process_reseval_data
Process a nohist_resevaldata hash into a more complex data structure.
Input: Hash reference containing reseval data
Returns: Hash with the following structure:
$hash{$url}->{'statistics'}->{$courseid}->{'avetries'} = $value
$hash{$url}->{'statistics'}->{$courseid}->{'count'} = $value
$hash{$url}->{'statistics'}->{$courseid}->{'difficulty'} = $value
$hash{$url}->{'statistics'}->{$courseid}->{'stdno'} = $value
$hash{$url}->{'statistics'}->{$courseid}->{'timestamp'} = $value
$hash{$url}->{'evaluation'}->{$username}->{'clear'} = $value
$hash{$url}->{'evaluation'}->{$username}->{'comments'} = $value
$hash{$url}->{'evaluation'}->{$username}->{'depth'} = $value
$hash{$url}->{'evaluation'}->{$username}->{'technical'} = $value
$hash{$url}->{'evaluation'}->{$username}->{'helpful'} = $value
$hash{$url}->{'course'} = \@Courses
$hash{$url}->{'comefrom'} = \@Resources
$hash{$url}->{'goto'} = \@Resources
$hash{$url}->{'usage'} = \@Resources
$hash{$url}->{'stats'}->{$courseid\_$section}->{$key} = $value
=cut
######################################################################
######################################################################
sub process_reseval_data {
my ($evaldata) = @_;
my %DynamicData;
#
# Process every stored element
while (my ($storedkey,$value) = each(%{$evaldata})) {
my ($source,$file,$type) = split('___',$storedkey);
$source = &unescape($source);
$file = &unescape($file);
$value = &unescape($value);
" got ".$file."\n ".$type." ".$source."\n";
if ($type =~ /^(avetries|count|difficulty|stdno|timestamp)$/) {
#
# Statistics: $source is course id
$DynamicData{$file}->{'statistics'}->{$source}->{$type}=$value;
} elsif ($type =~ /^(clear|comments|depth|technical|helpful|correct)$/){
#
# Evaluation $source is username, check if they evaluated it
# more than once. If so, pad the entry with a space.
while(exists($DynamicData{$file}->{'evaluation'}->{$type}->{$source})) {
$source .= ' ';
}
$DynamicData{$file}->{'evaluation'}->{$type}->{$source}=$value;
} elsif ($type =~ /^(course|comefrom|goto|usage)$/) {
#
# Context $source is course id or resource
push(@{$DynamicData{$file}->{$type}},&unescape($source));
} elsif ($type eq 'stats') {
#
# Statistics storage...
# $source is $cid\_$sec\_$stdno
# $value is stat1=value&stat2=value&stat3=value,....
#
my ($cid,$sec,$stdno)=split('&',$source);
my $crssec = $cid.'&'.$sec;
my @Data = split('&',$value);
my %Statistics;
while (my ($key,$value) = split('=',pop(@Data))) {
$Statistics{$key} = $value;
}
$sec =~ s:("$|^")::g;
$Statistics{'sections'} = $sec;
#
# Only store the data if the number of students is greater
# than the data already stored
if (! exists($DynamicData{$file}->{'stats'}->{$crssec}) ||
$DynamicData{$file}->{'stats'}->{$crssec}->{'stdno'}<$stdno){
$DynamicData{$file}->{'stats'}->{$crssec}=\%Statistics;
}
}
}
return %DynamicData;
}
######################################################################
######################################################################
=pod
=item &process_dynamic_metadata
Inputs: $url: the url of the item to process
$DynamicData: hash reference for the results of &process_reseval_data
Returns: Hash containing the following keys:
avetries, avetries_list, difficulty, difficulty_list, stdno, stdno_list,
course, course_list, goto, goto_list, comefrom, comefrom_list,
usage, clear, technical, correct, helpful, depth, comments
Each of the return keys is associated with either a number or a string
The *_list items are comma-seperated strings. 'comments' is a string
containing generically marked-up comments.
=cut
######################################################################
######################################################################
sub process_dynamic_metadata {
my ($url,$DynamicData) = @_;
my %data;
my $resdata = $DynamicData->{$url};
#
# Get the statistical data - Use a weighted average
foreach my $type (qw/avetries difficulty disc/) {
my $studentcount;
my %course_counted;
my $sum;
my @Values;
my @Students;
#
# New data
if (exists($resdata->{'stats'})) {
foreach my $identifier (sort(keys(%{$resdata->{'stats'}}))) {
my $coursedata = $resdata->{'stats'}->{$identifier};
next if (lc($coursedata->{$type}) eq 'nan');
$course_counted{$coursedata->{'course'}}++;
$studentcount += $coursedata->{'stdno'};
$sum += $coursedata->{$type}*$coursedata->{'stdno'};
push(@Values,$coursedata->{$type});
push(@Students,$coursedata->{'stdno'});
}
}
#
# Old data
foreach my $course (keys(%{$resdata->{'statistics'}})) {
next if (exists($course_counted{$course}));
my $coursedata = $resdata->{'statistics'}{$course};
if (ref($coursedata) eq 'HASH' && exists($coursedata->{$type})) {
next if (lc($coursedata->{$type}) eq 'nan');
$studentcount += $coursedata->{'stdno'};
$sum += ($coursedata->{$type}*$coursedata->{'stdno'});
push(@Values,$coursedata->{$type});
push(@Students,$coursedata->{'stdno'});
}
}
if (defined($studentcount) && $studentcount>0) {
$data{$type} = $sum/$studentcount;
$data{$type.'_list'} = join(',',@Values);
}
}
#
# Find out the number of students who have completed the resource...
my $stdno;
my %course_counted;
if (exists($resdata->{'stats'})) {
#
# For the number of students, take the maximum found for the class
my $current_course;
my $coursemax=0;
foreach my $identifier (sort(keys(%{$resdata->{'stats'}}))) {
my $coursedata = $resdata->{'stats'}->{$identifier};
if (! defined($current_course)) {
$current_course = $coursedata->{'course'};
}
if ($current_course ne $coursedata->{'course'}) {
$stdno += $coursemax;
$course_counted{$coursedata->{'course'}}++;
$coursemax = 0;
$current_course = $coursedata->{'course'};
}
if ($coursemax < $coursedata->{'stdno'}) {
$coursemax = $coursedata->{'stdno'};
}
}
$stdno += $coursemax; # pick up the final course in the list
}
# check for old data that has not been run since the format was changed
foreach my $course (keys(%{$resdata->{'statistics'}})) {
next if (exists($course_counted{$course}));
my $coursedata = $resdata->{'statistics'}{$course};
if (ref($coursedata) eq 'HASH' && exists($coursedata->{'stdno'})) {
$stdno += $coursedata->{'stdno'};
}
}
$data{'stdno'}=$stdno;
#
# Get the context data
foreach my $type (qw/course goto comefrom/) {
if (defined($resdata->{$type}) &&
ref($resdata->{$type}) eq 'ARRAY') {
$data{$type} = scalar(@{$resdata->{$type}});
$data{$type.'_list'} = join(',',@{$resdata->{$type}});
}
}
#
# NOTE: usage is named sequsage elsewhere in LON-CAPA
# The translation happens here
#
if (defined($resdata->{'usage'}) &&
ref($resdata->{'usage'}) eq 'ARRAY') {
$data{'sequsage'} = scalar(@{$resdata->{'usage'}});
$data{'sequsage_list'} = join(',',@{$resdata->{'usage'}});
}
#
# Get the evaluation data
foreach my $type (qw/clear technical correct helpful depth/) {
my $count;
my $sum;
foreach my $evaluator (keys(%{$resdata->{'evaluation'}->{$type}})){
$sum += $resdata->{'evaluation'}->{$type}->{$evaluator};
$count++;
}
if ($count > 0) {
$data{$type}=$sum/$count;
}
}
#
# put together comments
my $comments = '';
foreach my $evaluator (keys(%{$resdata->{'evaluation'}->{'comments'}})){
$comments .=
'<p>'.
'<b>'.$evaluator.'</b>: '.
$resdata->{'evaluation'}->{'comments'}->{$evaluator}.
'</p>';
}
if ($comments) {
$comments = '<div class="LCevalcomments">'
.$comments
.'</div>';
$data{'comments'} = $comments;
}
#
if (exists($resdata->{'stats'})) {
$data{'stats'} = $resdata->{'stats'};
}
if (exists($DynamicData->{'domain'})) {
$data{'domain'} = $DynamicData->{'domain'};
}
#
return %data;
}
sub dynamic_metadata_storage {
my ($data) = @_;
my %Store;
my $courseid = $data->{'course'};
my $sections = $data->{'sections'};
my $numstu = $data->{'num_students'};
my $part = $data->{'part'};
my $symb = $data->{'symb'};
my $key = $courseid.'&'.$sections.'&'.$numstu.'&'.$part.'___'.$symb.'___stats';
$Store{$key} =
'course='.$courseid.'&'.
'sections='.$sections.'&'.
'timestamp='.time.'&'.
'part='.$part.'&'.
'stdno='.$numstu.'&'.
'avetries='.$data->{'mean_tries'}.'&'.
'difficulty='.$data->{'deg_of_diff'}.'&'.
'disc='.$data->{'deg_of_disc'};
return %Store;
}
###############################################################
###############################################################
### ###
### &portfolio_metadata($filepath,$dom,$uname,$group) ###
### Retrieve metadata for the given file ###
### Returns array - ###
### contains reference to metadatahash and ###
### optional reference to addedfields hash ###
### ###
###############################################################
###############################################################
sub portfolio_metadata {
my ($fullpath,$dom,$uname,$group)=@_;
my ($mime) = ( $fullpath=~/\.(\w+)$/ );
my %metacache=();
if ($fullpath !~ /\.meta$/) {
$fullpath .= '.meta';
}
my (@standard_fields,%addedfields);
my $colsref = $Portfolio_metadata_table_description;
if (ref($colsref) eq 'ARRAY') {
my @columns = @{$colsref};
foreach my $coldata (@columns) {
push(@standard_fields,$coldata->{'name'});
}
}
my $metastring=&getfile($fullpath);
if (! defined($metastring)) {
$metacache{'keys'}= 'owner,domain,mime';
$metacache{'owner'} = $uname.':'.$dom;
$metacache{'domain'} = $dom;
$metacache{'mime'} = $mime;
if ($group ne '') {
$metacache{'keys'} .= ',courserestricted';
$metacache{'courserestricted'} = 'course.'.$dom.'_'.$uname;
}
} else {
my $parser=HTML::TokeParser->new(\$metastring);
my $token;
while ($token=$parser->get_token) {
if ($token->[0] eq 'S') {
my $entry=$token->[1];
if ($metacache{'keys'}) {
$metacache{'keys'}.=','.$entry;
} else {
$metacache{'keys'}=$entry;
}
my $value = $parser->get_text('/'.$entry);
if (!grep(/^\Q$entry\E$/,@standard_fields)) {
my $clean_value = lc($value);
$clean_value =~ s/\s/_/g;
if ($clean_value ne $entry) {
if (defined($addedfields{$entry})) {
$addedfields{$entry} .=','.$value;
} else {
$addedfields{$entry} = $value;
}
}
} else {
$metacache{$entry} = $value;
}
}
} # End of ($token->[0] eq 'S')
if (!exists($metacache{'domain'})) {
$metacache{'domain'} = $dom;
}
}
return (\%metacache,$metacache{'courserestricted'},\%addedfields);
}
sub process_portfolio_access_data {
my ($dbh,$simulate,$newnames,$url,$fullpath,$access_hash,$caller) = @_;
my %loghash;
if ($caller eq 'update') {
# Delete old data (no error if deleting non-existent record).
my $error;
if ($url eq '') {
$error = 'No url specified';
} else {
my $delitem = 'url = '.$dbh->quote($url);
$error=&delete_metadata($dbh,$newnames->{'access'},$delitem);
}
if (defined($error)) {
$loghash{'access'}{'err'} = "MySQL Error Delete: ".$error;
return %loghash;
}
}
# Check the file exists
if (-e $fullpath) {
foreach my $key (keys(%{$access_hash})) {
my $acc_data;
$acc_data->{url} = $url;
$acc_data->{keynum} = $key;
my ($num,$scope,$end,$start) =
($key =~ /^([^:]+):([a-z]+)_(\d*)_?(\d*)$/);
next if (($scope ne 'public') && ($scope ne 'guest'));
$acc_data->{scope} = $scope;
my $sqltime_error;
if ($end != 0) {
$acc_data->{end} = &sqltime($end,\$sqltime_error);
}
$acc_data->{start} = &sqltime($start,\$sqltime_error);
if ($sqltime_error) {
$loghash{$key}{'err'} = $sqltime_error;
}
if (! $simulate) {
my ($count,$err) =
&store_metadata($dbh,$newnames->{'access'},
'portfolio_access',$acc_data);
if ($err) {
$loghash{$key}{'err'} = "MySQL Error Insert: ".$err;
}
if ($count < 1) {
$loghash{$key}{'count'} =
"Unable to insert record into MySQL database for $url";
}
}
}
}
return %loghash;
}
sub process_portfolio_metadata {
my ($dbh,$simulate,$newnames,$url,$fullpath,$is_course,$dom,$uname,$group,$caller) = @_;
my %loghash;
if ($caller eq 'update') {
# Delete old data (no error if deleting non-existent record).
my ($error,$delitem);
if ($url eq '') {
$error = 'No url specified';
} else {
$delitem = 'url = '.$dbh->quote($url);
$error=&delete_metadata($dbh,$newnames->{'portfolio'},$delitem);
}
if (defined($error)) {
$loghash{'metadata'}{'err'} = "MySQL Error delete metadata: ".
$error;
return %loghash;
}
$error=&delete_metadata($dbh,$newnames->{'addedfields'},$delitem);
if (defined($error)) {
$loghash{'addedfields'}{'err'}="MySQL Error delete addedfields: ".$error;
}
}
# Check the file exists.
if (-e $fullpath) {
my ($ref,$crs,$addedfields) = &portfolio_metadata($fullpath,$dom,$uname,
$group);
my $sqltime_error;
&getfiledates($ref,$fullpath,\$sqltime_error);
if ($is_course) {
$ref->{'groupname'} = $group;
}
my %Data;
if (ref($ref) eq 'HASH') {
%Data = %{$ref};
}
%Data = (
%Data,
'url'=>$url,
'version'=>'current',
);
my %loghash;
if (! $simulate) {
if ($sqltime_error) {
$loghash{'metadata'."\0"}{'err'} = $sqltime_error;
}
my ($count,$err) =
&store_metadata($dbh,$newnames->{'portfolio'},'portfolio_metadata',
\%Data);
if ($err) {
$loghash{'metadata'."\0"}{'err'} = "MySQL Error Insert: ".$err;
}
if ($count < 1) {
$loghash{'metadata'."\0"}{'count'} = "Unable to insert record into MySQL portfolio_metadata database table for $url";
}
if (ref($addedfields) eq 'HASH') {
if (keys(%{$addedfields}) > 0) {
foreach my $key (keys(%{$addedfields})) {
my $added_data = {
'url' => $url,
'field' => $key,
'value' => $addedfields->{$key},
'courserestricted' => $crs,
};
my ($count,$err) =
&store_metadata($dbh,$newnames->{'addedfields'},
'portfolio_addedfields',$added_data);
if ($err) {
$loghash{$key}{'err'} =
"MySQL Error Insert: ".$err;
}
if ($count < 1) {
$loghash{$key}{'count'} = "Unable to insert record into MySQL portfolio_addedfields database table for url = $url and field = $key";
}
}
}
}
}
}
return %loghash;
}
sub process_allusers_data {
my ($dbh,$simulate,$newnames,$uname,$udom,$userdata,$caller) = @_;
my %loghash;
if ($caller eq 'update') {
# Delete old data (no error if deleting non-existent record).
my ($error,$delitem);
if ($udom eq '' || $uname eq '' ) {
$error = 'No domain and/or username specified';
} else {
$delitem = 'domain = '.$dbh->quote($udom).' AND username '.
'COLLATE latin1_general_cs = '.$dbh->quote($uname);
$error=&delete_metadata($dbh,$newnames->{'allusers'},$delitem);
}
if (defined($error)) {
$loghash{'err'} = 'MySQL Error in allusers delete: '.$error;
return %loghash;
}
}
if (!$simulate) {
if ($udom ne '' && $uname ne '') {
my ($count,$err) = &store_metadata($dbh,$newnames->{'allusers'},
'allusers',$userdata);
if ($err) {
$loghash{'err'} = 'MySQL Error in allusers insert: '.$err;
}
if ($count < 1) {
$loghash{'count'} =
'Unable to insert record into MySQL allusers database for '.
$uname.' in '.$udom;
}
} else {
$loghash{'err'} =
'MySQL Error allusrs insert: missing username and/or domain';
}
}
return %loghash;
}
######################################################################
######################################################################
sub getfile {
my $file = shift();
if (! -e $file ) {
return undef;
}
open(my $fh,"<$file");
my $contents = '';
while (<$fh>) {
$contents .= $_;
}
return $contents;
}
##
## &getfiledates($ref,$target,$sqltime_error)
## Converts creationdate and modifieddates to SQL format
## Applies stat() to file to retrieve dates if missing
sub getfiledates {
my ($ref,$target,$sqltime_error) = @_;
if (! defined($ref->{'creationdate'}) ||
$ref->{'creationdate'} =~ /^\s*$/) {
$ref->{'creationdate'} = (stat($target))[9];
}
if (! defined($ref->{'lastrevisiondate'}) ||
$ref->{'lastrevisiondate'} =~ /^\s*$/) {
$ref->{'lastrevisiondate'} = (stat($target))[9];
}
$ref->{'creationdate'} = &sqltime($ref->{'creationdate'},$sqltime_error);
$ref->{'lastrevisiondate'} = &sqltime($ref->{'lastrevisiondate'},$sqltime_error);
}
##
## &sqltime($timestamp,$sqltime_error)
##
## Convert perl $timestamp to MySQL time. MySQL expects YYYY-MM-DD HH:MM:SS
##
sub sqltime {
my ($time,$sqltime_error) = @_;
my $mysqltime;
if ($time =~
/(\d+)-(\d+)-(\d+) # YYYY-MM-DD
\s # a space
(\d+):(\d+):(\d+) # HH:MM::SS
/x ) {
# Some of the .meta files have the time in mysql
# format already, so just make sure they are 0 padded and
# pass them back.
$mysqltime = sprintf('%04d-%02d-%02d %02d:%02d:%02d',
$1,$2,$3,$4,$5,$6);
} elsif ($time =~ /^\d+$/) {
my @TimeData = gmtime($time);
# Alter the month to be 1-12 instead of 0-11
$TimeData[4]++;
# Alter the year to be from 0 instead of from 1900
$TimeData[5]+=1900;
$mysqltime = sprintf('%04d-%02d-%02d %02d:%02d:%02d',
@TimeData[5,4,3,2,1,0]);
} elsif (! defined($time) || $time == 0) {
$mysqltime = 0;
} else {
if (ref($sqltime_error) eq 'SCALAR') {
$$sqltime_error = "sqltime:Unable to decode time ".$time;
}
$mysqltime = 0;
}
return $mysqltime;
}
######################################################################
######################################################################
##
## The usual suspects, repeated here to reduce dependency hell
##
######################################################################
######################################################################
sub unescape {
my $str=shift;
$str =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
return $str;
}
sub escape {
my $str=shift;
$str =~ s/(\W)/"%".unpack('H2',$1)/eg;
return $str;
}
1;
__END__;
=pod
=back
=cut
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/back.gif){kind=icon}
Return to lonmetadata.pm CVS log ![[TXT]](/icons/text.gif){kind=icon}
![[DIR]](/icons/dir.gif){kind=icon}
Up to [LON-CAPA] / loncom / metadata_database / LONCAPA