--- loncom/metadata_database/LONCAPA/lonmetadata.pm 2004/01/12 21:48:38 1.3 +++ loncom/metadata_database/LONCAPA/lonmetadata.pm 2007/01/19 06:09:08 1.18 @@ -1,6 +1,6 @@ # The LearningOnline Network with CAPA # -# $Id: lonmetadata.pm,v 1.3 2004/01/12 21:48:38 matthew Exp $ +# $Id: lonmetadata.pm,v 1.18 2007/01/19 06:09:08 albertel 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); ###################################################################### ###################################################################### @@ -75,6 +78,7 @@ creationdate DATETIME, lastrevisiondate DATETIME, owner TEXT, copyright TEXT, +domain TEXT FULLTEXT idx_title (title), FULLTEXT idx_author (author), @@ -95,8 +99,8 @@ TYPE=MYISAM; ###################################################################### ###################################################################### -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,10 +161,94 @@ 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 => 'addedfieldnames', type=>'TEXT'}, + { name => 'addedfieldvalues', 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/]; + +###################################################################### +###################################################################### + =pod @@ -172,8 +263,36 @@ of the metadata table(s). ###################################################################### ###################################################################### -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, + ); + my %index_description = ( + metadata => $Fulltext_indicies, + portfolio_metadata => $Portfolio_metadata_indices, + portfolio_access => $Portfolio_access_indices, + portfolio_addedfields => $Portfolio_addedfields_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}); + } } ###################################################################### @@ -193,15 +312,20 @@ metadata storage to be initialized. ###################################################################### ###################################################################### sub create_metadata_storage { - my ($tablename) = @_; + 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'}."('". @@ -227,8 +351,14 @@ 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).") TYPE=MyISAM"; @@ -242,8 +372,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. @@ -259,15 +389,21 @@ Returns: 1 on success, 0 on failure to s ## ## 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 appearantly does not have a link back to the + ## 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 = shift(); - my $request = 'INSERT INTO metadata VALUES('; - foreach (@Metadata_Table_Description) { + 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; @@ -276,21 +412,36 @@ sub create_statement_handler { return; } -sub clear_sth { $sth=undef; } +sub clear_sth { $sth=undef; $sth_table=undef;} sub store_metadata { - my $dbh = shift(); + my ($dbh,$tablename,$tabletype,@Metadata)=@_; my $errors = ''; - if (! defined($sth)) { - &create_statement_handler($dbh); + if (! defined($sth) || + ( defined($tablename) && ($sth_table ne $tablename)) || + (! defined($tablename) && $sth_table ne 'metadata')) { + &create_statement_handler($dbh,$tablename,$tabletype); } my $successcount = 0; - while (my $mdata = shift()) { + 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 (@Metadata_Table_Description) { - if (exists($mdata->{$field->{'name'}})) { - push(@MData,$mdata->{$field->{'name'}}); + 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,$mdata->{$fname}); + } } else { push(@MData,undef); } @@ -301,6 +452,7 @@ sub store_metadata { } else { $errors = join(',',$errors,$sth->errstr); } + $errors =~ s/^,//; } if (wantarray()) { return ($successcount,$errors); @@ -329,10 +481,11 @@ The array reference is the same one retu ###################################################################### ###################################################################### sub lookup_metadata { - my ($dbh,$condition,$fetchparameter) = @_; + my ($dbh,$condition,$fetchparameter,$tablename) = @_; + $tablename = 'metadata' if (! defined($tablename)); my $error; my $returnvalue=[]; - my $request = 'SELECT * FROM metadata'; + my $request = 'SELECT * FROM '.$tablename; if (defined($condition)) { $request .= ' WHERE '.$condition; } @@ -350,7 +503,7 @@ sub lookup_metadata { $error = $sth->errstr; } } - } + } return ($error,$returnvalue); } @@ -361,16 +514,703 @@ 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' +$url, the url of the resource to remove from the metadata database. + +Returns: undef on success, dbh errorstr on failure. + +=cut + +###################################################################### +###################################################################### +sub delete_metadata { + my ($dbh,$tablename,$url) = @_; + $tablename = 'metadata' if (! defined($tablename)); + my $error; + my $delete_command = 'DELETE FROM '.$tablename.' WHERE url='. + $dbh->quote($url); + $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) + +Returns: +$error on failure. undef on success. + +=cut + +###################################################################### +###################################################################### +sub update_metadata { + my ($dbh,$tablename,$tabletype,$newmetadata)=@_; + my $error; + $tablename = 'metadata' if (! defined($tablename)); + $tabletype = 'metadata' if (! defined($tabletype)); + if (! exists($newmetadata->{'url'})) { + $error = 'Unable to update: no url specified'; + } + return $error if (defined($error)); + # + # Retrieve current values + my $row; + ($error,$row) = &lookup_metadata($dbh, + ' url='.$dbh->quote($newmetadata->{'url'}), + 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,$newmetadata->{'url'}); + 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 delete_metadata {} +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 $sum; + my @Values; + my @Students; + # + # Old data + foreach my $coursedata (values(%{$resdata->{'statistics'}}), + values(%{$resdata->{'stats'}})) { + if (ref($coursedata) eq 'HASH' && exists($coursedata->{$type})) { + $studentcount += $coursedata->{'stdno'}; + $sum += ($coursedata->{$type}*$coursedata->{'stdno'}); + push(@Values,$coursedata->{$type}); + push(@Students,$coursedata->{'stdno'}); + } + } + if (exists($resdata->{'stats'})) { + foreach my $identifier (sort(keys(%{$resdata->{'stats'}}))) { + my $coursedata = $resdata->{'stats'}->{$identifier}; + $studentcount += $coursedata->{'stdno'}; + $sum += $coursedata->{$type}*$coursedata->{'stdno'}; + push(@Values,$coursedata->{$type}); + push(@Students,$coursedata->{'stdno'}); + } + } + # + # New data + 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; + foreach my $coursedata (values(%{$resdata->{'statistics'}}), + values(%{$resdata->{'stats'}})) { + if (ref($coursedata) eq 'HASH' && exists($coursedata->{'stdno'})) { + $stdno += $coursedata->{'stdno'}; + } + } + 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; + $coursemax = 0; + $current_course = $coursedata->{'course'}; + } + if ($coursemax < $coursedata->{'stdno'}) { + $coursemax = $coursedata->{'stdno'}; + } + } + $stdno += $coursemax; # pick up the final course in the list + } + $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}}); + } + } + 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}. + '

'; + } + $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 $urlres = $data->{'urlres'}; + my $key = $courseid.'&'.$sections.'&'.$numstu.'___'.$urlres.'___stats'; + $Store{$key} = + 'course='.$courseid.'&'. + 'sections='.$sections.'&'. + 'timestamp='.time.'&'. + 'stdno='.$data->{'num_students'}.'&'. + 'avetries='.$data->{'mean_tries'}.'&'. + 'difficulty='.$data->{'deg_of_diff'}; + if (exists($data->{'deg_of_disc'})) { + $Store{$key} .= '&'.'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 (keys(%addedfields) > 0) { + foreach my $key (sort keys(%addedfields)) { + $metacache{'addedfieldnames'} .= $key.','; + $metacache{'addedfieldvalues'} .= $addedfields{$key}.'&&&'; + } + $metacache{'addedfieldnames'} =~ s/,$//; + $metacache{'addedfieldvalues'} =~ s/\&\&\&$//; + if ($metacache{'keys'}) { + $metacache{'keys'}.=',addedfieldnames'; + } else { + $metacache{'keys'}='addedfieldnames'; + } + $metacache{'keys'}.=',addedfieldvalues'; + } + 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=&delete_metadata($dbh,$newnames->{'access'},$url); + 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; + if ($end != 0) { + $acc_data->{end} = &sqltime($end); + } + $acc_data->{start} = &sqltime($start); + 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=&delete_metadata($dbh,$newnames->{'portfolio'},$url); + if (defined($error)) { + $loghash{'metadata'}{'err'} = "MySQL Error delete metadata: ". + $error; + return %loghash; + } + $error=&delete_metadata($dbh,$newnames->{'addedfields'},$url); + 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); + &getfiledates($ref,$fullpath); + 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) { + 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 getfile { + my $file = shift(); + if (! -e $file ) { + return undef; + } + open(my $fh,"<$file"); + my $contents = ''; + while (<$fh>) { + $contents .= $_; + } + return $contents; +} + +## +## &getfiledates() +## Converts creationdate and modifieddates to SQL format +## Applies stat() to file to retrieve dates if missing +sub getfiledates { + my ($ref,$target) = @_; + 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'}); + $ref->{'lastrevisiondate'} = &sqltime($ref->{'lastrevisiondate'}); +} + +## +## &sqltime($timestamp) +## +## Convert perl $timestamp to MySQL time. MySQL expects YYYY-MM-DD HH:MM:SS +## +sub sqltime { + my ($time) = @_; + 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 { + &log(0," 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;