--- loncom/metadata_database/LONCAPA/lonmetadata.pm 2004/01/12 15:07:08 1.1
+++ loncom/metadata_database/LONCAPA/lonmetadata.pm 2012/03/15 23:01:59 1.38
@@ -1,6 +1,6 @@
# The LearningOnline Network with CAPA
#
-# $Id: lonmetadata.pm,v 1.1 2004/01/12 15:07:08 matthew Exp $
+# $Id: lonmetadata.pm,v 1.38 2012/03/15 23:01:59 www Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -30,6 +30,9 @@ 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);
######################################################################
######################################################################
@@ -75,6 +78,7 @@ creationdate DATETIME,
lastrevisiondate DATETIME,
owner TEXT,
copyright TEXT,
+domain TEXT
FULLTEXT idx_title (title),
FULLTEXT idx_author (author),
@@ -89,14 +93,14 @@ FULLTEXT idx_language (language),
FULLTEXT idx_owner (owner),
FULLTEXT idx_copyright (copyright))
-TYPE=MYISAM;
+ENGINE=MYISAM;
=cut
######################################################################
######################################################################
-my @Metadata_Table_Description =
- (
+$Metadata_Table_Description =
+ [
{ name => 'title', type=>'TEXT'},
{ name => 'author', type=>'TEXT'},
{ name => 'subject', type=>'TEXT'},
@@ -111,6 +115,7 @@ my @Metadata_Table_Description =
{ name => 'lastrevisiondate', type=>'DATETIME'},
{ name => 'owner', type=>'TEXT'},
{ name => 'copyright', type=>'TEXT'},
+ { name => 'domain', type=>'TEXT'},
#--------------------------------------------------
{ name => 'dependencies', type=>'TEXT'},
{ name => 'modifyinguser', type=>'TEXT'},
@@ -133,6 +138,8 @@ my @Metadata_Table_Description =
{ 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'},
@@ -140,9 +147,9 @@ my @Metadata_Table_Description =
{ name => 'depth', type=>'FLOAT'},
{ name => 'hostname', type=> 'TEXT'},
#--------------------------------------------------
- );
+ ];
-my @Fulltext_indicies = qw/
+$Fulltext_indicies = [ qw/
title
author
subject
@@ -154,7 +161,109 @@ my @Fulltext_indicies = qw/
mime
language
owner
- copyright/;
+ 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/];
######################################################################
######################################################################
@@ -165,15 +274,45 @@ my @Fulltext_indicies = qw/
Input: None
-Returns: An array of hash references describing the columns and rows
-of the metadata table.
+Returns: An array of hash references describing the columns and indicies
+of the metadata table(s).
=cut
######################################################################
######################################################################
-sub describe_metadata_storage {
- return (\@Metadata_Table_Description,\@Fulltext_indicies);
+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});
+ }
}
######################################################################
@@ -183,7 +322,7 @@ sub describe_metadata_storage {
=item create_metadata_storage()
-Inputs: None
+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.
@@ -193,14 +332,20 @@ metadata storage to be initialized.
######################################################################
######################################################################
sub create_metadata_storage {
- my $tablename = 'metadata';
+ 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
- foreach my $coldata (@Metadata_Table_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'}."('".
@@ -211,6 +356,9 @@ sub create_metadata_storage {
$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'};
@@ -226,11 +374,17 @@ sub create_metadata_storage {
# skip blank items.
push (@Columns,$col_des) if ($col_des ne '');
}
- foreach my $colname (@Fulltext_indicies) {
- my $text = 'FULLTEXT idx_'.$colname.' ('.$colname.')';
+ 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).") ";
+ $request .= "(".join(", ",@Columns).") ENGINE=MyISAM";
return $request;
}
@@ -241,8 +395,8 @@ sub create_metadata_storage {
=item store_metadata()
-Inputs: database handle ($dbh) and a hash or hash reference containing the
-metadata for a single resource.
+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.
@@ -250,7 +404,86 @@ Returns: 1 on success, 0 on failure to s
######################################################################
######################################################################
+{
+ ##
+ ## 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;
+ }
+}
}
@@ -264,13 +497,39 @@ sub store_metadata {
Inputs: database handle ($dbh) and a hash or hash reference containing
metadata which will be used for a search.
-Returns:
+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 {}
+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);
+}
######################################################################
######################################################################
@@ -279,16 +538,790 @@ sub lookup_metadata {}
=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 (@keycomponents) = split('___',$storedkey);
+ my $type=pop(@keycomponents);
+ my $file=&unescape(pop(@keycomponents));
+ my $source = &unescape(join('___',@keycomponents));
+ $file = &unescape($file);
+ $value = &unescape($value);
+ 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,$part,$instance)=split('&',$source);
+ my $datakey = $cid.'&'.$sec.'&'.$part.'&'.$instance;
+ 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'}->{$datakey}) ||
+ $DynamicData{$file}->{'stats'}->{$datakey}->{'stdno'}<$stdno){
+ $DynamicData{$file}->{'stats'}->{$datakey}=\%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 delete_metadata {}
+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 .=
+ ''.
+ ''.$evaluator.': '.
+ $resdata->{'evaluation'}->{'comments'}->{$evaluator}.
+ '
';
+ }
+ if ($comments) {
+ $comments = '';
+ $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;