[BACK]Return to lonmetadata.pm CVS log [TXT] [DIR] Up to [LON-CAPA] / loncom / metadata_database / LONCAPA

Diff for /loncom/metadata_database/LONCAPA/lonmetadata.pm between versions 1.4 and 1.10

version 1.4, 2004/04/08 14:50:44 version 1.10, 2004/06/11 19:52:12
Line 133  my @Metadata_Table_Description = Line 133  my @Metadata_Table_Description =
      { name => 'avetries_list',  type=>'TEXT'},       { name => 'avetries_list',  type=>'TEXT'},
      { name => 'difficulty',     type=>'FLOAT'},       { name => 'difficulty',     type=>'FLOAT'},
      { name => 'difficulty_list',type=>'TEXT'},       { name => 'difficulty_list',type=>'TEXT'},
        { name => 'disc',           type=>'FLOAT'},
        { name => 'disc_list',      type=>'TEXT'},
      { name => 'clear',          type=>'FLOAT'},       { name => 'clear',          type=>'FLOAT'},
      { name => 'technical',      type=>'FLOAT'},       { name => 'technical',      type=>'FLOAT'},
      { name => 'correct',        type=>'FLOAT'},       { name => 'correct',        type=>'FLOAT'},
Line 283  sub create_statement_handler { Line 285  sub create_statement_handler {
 sub clear_sth { $sth=undef; $sth_table=undef;}  sub clear_sth { $sth=undef; $sth_table=undef;}
   
 sub store_metadata {  sub store_metadata {
     my $dbh = shift();      my ($dbh,$tablename,@Metadata)=@_;
     my $tablename = shift();  
     my $errors = '';      my $errors = '';
     if (! defined($sth) ||       if (! defined($sth) || 
         ( defined($tablename) && ($sth_table ne $tablename)) ||           ( defined($tablename) && ($sth_table ne $tablename)) || 
Line 292  sub store_metadata { Line 293  sub store_metadata {
         &create_statement_handler($dbh,$tablename);          &create_statement_handler($dbh,$tablename);
     }      }
     my $successcount = 0;      my $successcount = 0;
     while (my $mdata = shift()) {      foreach my $mdata (@Metadata) {
         next if (ref($mdata) ne "HASH");          next if (ref($mdata) ne "HASH");
         my @MData;          my @MData;
         foreach my $field (@Metadata_Table_Description) {          foreach my $field (@Metadata_Table_Description) {
             if (exists($mdata->{$field->{'name'}})) {              my $fname = $field->{'name'};
                 push(@MData,$mdata->{$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 {              } else {
                 push(@MData,undef);                  push(@MData,undef);
             }              }
Line 308  sub store_metadata { Line 317  sub store_metadata {
         } else {          } else {
             $errors = join(',',$errors,$sth->errstr);              $errors = join(',',$errors,$sth->errstr);
         }          }
           $errors =~ s/^,//;
     }      }
     if (wantarray()) {      if (wantarray()) {
         return ($successcount,$errors);          return ($successcount,$errors);
Line 336  The array reference is the same one retu Line 346  The array reference is the same one retu
 ######################################################################  ######################################################################
 ######################################################################  ######################################################################
 sub lookup_metadata {  sub lookup_metadata {
     my ($dbh,$condition,$fetchparameter) = @_;      my ($dbh,$condition,$fetchparameter,$tablename) = @_;
       $tablename = 'metadata' if (! defined($tablename));
     my $error;      my $error;
     my $returnvalue=[];      my $returnvalue=[];
     my $request = 'SELECT * FROM metadata';      my $request = 'SELECT * FROM '.$tablename;
     if (defined($condition)) {      if (defined($condition)) {
         $request .= ' WHERE '.$condition;          $request .= ' WHERE '.$condition;
     }      }
Line 368  sub lookup_metadata { Line 379  sub lookup_metadata {
   
 =item delete_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'.
   
   Returns:
   $error on failure.  undef on success.
   
   =cut
   
   ######################################################################
   ######################################################################
   sub update_metadata {
       my ($dbh,$tablename,$newmetadata)=@_;
       my $error;
       $tablename = 'metadata' if (! defined($tablename));
       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(@{$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,\%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 @cols=@_;
       my %hash=();
       for (my $i=0; $i<=$#Metadata_Table_Description;$i++) {
           $hash{$Metadata_Table_Description[$i]->{'name'}}=$cols[$i];
       }
       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
   
    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  =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)$/){
               #
               # 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 = '<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;
       #
       if (exists($resdata->{'stats'})) {
           $data{'stats'} = $resdata->{'stats'};
       }
       #
       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;
   }
   
   ######################################################################
   ######################################################################
   ##
   ## 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__;
Removed from v.1.4  
changed lines
  Added in v.1.10

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>