version 1.1, 2004/01/12 15:07:08
|
version 1.7, 2004/04/14 20:35:29
|
Line 165 my @Fulltext_indicies = qw/
|
Line 165 my @Fulltext_indicies = qw/
|
|
|
Input: None |
Input: None |
|
|
Returns: An array of hash references describing the columns and rows |
Returns: An array of hash references describing the columns and indicies |
of the metadata table. |
of the metadata table(s). |
|
|
=cut |
=cut |
|
|
Line 183 sub describe_metadata_storage {
|
Line 183 sub describe_metadata_storage {
|
|
|
=item create_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 |
Returns: A perl string which, when executed by MySQL, will cause the |
metadata storage to be initialized. |
metadata storage to be initialized. |
Line 193 metadata storage to be initialized.
|
Line 193 metadata storage to be initialized.
|
###################################################################### |
###################################################################### |
###################################################################### |
###################################################################### |
sub create_metadata_storage { |
sub create_metadata_storage { |
my $tablename = 'metadata'; |
my ($tablename) = @_; |
|
$tablename = 'metadata' if (! defined($tablename)); |
my $request = "CREATE TABLE IF NOT EXISTS ".$tablename." "; |
my $request = "CREATE TABLE IF NOT EXISTS ".$tablename." "; |
# |
# |
# Process the columns (this code is stolen from lonmysql.pm) |
# Process the columns (this code is stolen from lonmysql.pm) |
Line 230 sub create_metadata_storage {
|
Line 231 sub create_metadata_storage {
|
my $text = 'FULLTEXT idx_'.$colname.' ('.$colname.')'; |
my $text = 'FULLTEXT idx_'.$colname.' ('.$colname.')'; |
push (@Columns,$text); |
push (@Columns,$text); |
} |
} |
$request .= "(".join(", ",@Columns).") "; |
$request .= "(".join(", ",@Columns).") TYPE=MyISAM"; |
return $request; |
return $request; |
} |
} |
|
|
Line 241 sub create_metadata_storage {
|
Line 242 sub create_metadata_storage {
|
|
|
=item store_metadata() |
=item store_metadata() |
|
|
Inputs: database handle ($dbh) and a hash or hash reference containing the |
Inputs: database handle ($dbh), a table name, and a hash or hash reference |
metadata for a single resource. |
containing the metadata for a single resource. |
|
|
Returns: 1 on success, 0 on failure to store. |
Returns: 1 on success, 0 on failure to store. |
|
|
Line 250 Returns: 1 on success, 0 on failure to s
|
Line 251 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 appearantly 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 $tablename = shift(); |
|
$tablename = 'metadata' if (! defined($tablename)); |
|
$sth_table = $tablename; |
|
my $request = 'INSERT INTO '.$tablename.' VALUES('; |
|
foreach (@Metadata_Table_Description) { |
|
$request .= '?,'; |
|
} |
|
chop $request; |
|
$request.= ')'; |
|
$sth = $dbh->prepare($request); |
|
return; |
|
} |
|
|
|
sub clear_sth { $sth=undef; $sth_table=undef;} |
|
|
sub store_metadata { |
sub store_metadata { |
|
my $dbh = shift(); |
|
my $tablename = shift(); |
|
my $errors = ''; |
|
if (! defined($sth) || |
|
( defined($tablename) && ($sth_table ne $tablename)) || |
|
(! defined($tablename) && $sth_table ne 'metadata')) { |
|
&create_statement_handler($dbh,$tablename); |
|
} |
|
my $successcount = 0; |
|
while (my $mdata = shift()) { |
|
next if (ref($mdata) ne "HASH"); |
|
my @MData; |
|
foreach my $field (@Metadata_Table_Description) { |
|
if (exists($mdata->{$field->{'name'}})) { |
|
if ($mdata->{$field->{'name'}} eq 'nan') { |
|
push(@MData,'NULL'); |
|
} else { |
|
push(@MData,$mdata->{$field->{'name'}}); |
|
} |
|
} else { |
|
push(@MData,undef); |
|
} |
|
} |
|
$sth->execute(@MData); |
|
if (! $sth->err) { |
|
$successcount++; |
|
} else { |
|
$errors = join(',',$errors,$sth->errstr); |
|
} |
|
} |
|
if (wantarray()) { |
|
return ($successcount,$errors); |
|
} else { |
|
return $successcount; |
|
} |
|
} |
|
|
} |
} |
|
|
Line 264 sub store_metadata {
|
Line 332 sub store_metadata {
|
Inputs: database handle ($dbh) and a hash or hash reference containing |
Inputs: database handle ($dbh) and a hash or hash reference containing |
metadata which will be used for a search. |
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 |
=cut |
|
|
###################################################################### |
###################################################################### |
###################################################################### |
###################################################################### |
sub lookup_metadata {} |
sub lookup_metadata { |
|
my ($dbh,$condition,$fetchparameter) = @_; |
|
my $error; |
|
my $returnvalue=[]; |
|
my $request = 'SELECT * FROM metadata'; |
|
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); |
|
} |
|
|
###################################################################### |
###################################################################### |
###################################################################### |
###################################################################### |
Line 279 sub lookup_metadata {}
|
Line 372 sub lookup_metadata {}
|
|
|
=item delete_metadata() |
=item delete_metadata() |
|
|
|
Not implemented yet |
|
|
=cut |
=cut |
|
|
Line 290 sub delete_metadata {}
|
Line 383 sub delete_metadata {}
|
###################################################################### |
###################################################################### |
###################################################################### |
###################################################################### |
|
|
|
=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 @cols=@_; |
|
my %hash=(); |
|
for (my $i=0; $i<=$#Metadata_Table_Description;$i++) { |
|
$hash{$Metadata_Table_Description[$i]->{'name'}}=$cols[$i]; |
|
} |
|
return %hash; |
|
} |
|
|
|
###################################################################### |
|
###################################################################### |
|
|
|
=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)$/){ |
|
# |
|
# 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; |
|
} |
|
# |
|
# 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 |
|
foreach my $type (qw/avetries difficulty stdno/) { |
|
my $count; |
|
my $sum; |
|
my @Values; |
|
# |
|
foreach my $coursedata (values(%{$resdata->{'statistics'}}), |
|
values(%{$resdata->{'stats'}})) { |
|
if (ref($coursedata) eq 'HASH' && exists($coursedata->{$type})) { |
|
$count++; |
|
$sum += $coursedata->{$type}; |
|
push(@Values,$coursedata->{$type}); |
|
} |
|
} |
|
if ($count) { |
|
$data{$type} = $sum/$count; |
|
$data{$type.'_list'} = join(',',@Values); |
|
} |
|
} |
|
# |
|
# 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 = '<div class="LCevalcomments">'; |
|
foreach my $evaluator (keys(%{$resdata->{'evaluation'}->{'comments'}})){ |
|
$comments .= |
|
'<p>'. |
|
'<b>'.$evaluator.'</b>:'. |
|
$resdata->{'evaluation'}->{'comments'}->{$evaluator}. |
|
'</p>'; |
|
} |
|
$comments .= '</div>'; |
|
$data{'comments'} = $comments; |
|
# |
|
return %data; |
|
} |
|
|
|
|
|
###################################################################### |
|
###################################################################### |
|
## |
|
## 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; |
1; |
|
|
__END__; |
__END__; |