[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.1 and 1.8

version 1.1, 2004/01/12 15:07:08 version 1.8, 2004/04/16 21:43:56
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 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
   
   ######################################################################
   ######################################################################
   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.1  
changed lines
  Added in v.1.8

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