[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.2 and 1.5

version 1.2, 2004/01/12 21:32:20 version 1.5, 2004/04/12 21:11:45
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 262  Returns: 1 on success, 0 on failure to s Line 263  Returns: 1 on success, 0 on failure to s
     ##  $dbh, so we can't check our validity.      ##  $dbh, so we can't check our validity.
     ##      ##
     my $sth = undef;      my $sth = undef;
       my $sth_table = undef;
   
 sub create_statement_handler {  sub create_statement_handler {
     my $dbh = shift();      my $dbh = shift();
     my $request = 'INSERT INTO metadata VALUES(';      my $tablename = shift();
       $tablename = 'metadata' if (! defined($tablename));
       $sth_table = $tablename;
       my $request = 'INSERT INTO '.$tablename.' VALUES(';
     foreach (@Metadata_Table_Description) {      foreach (@Metadata_Table_Description) {
         $request .= '?,';          $request .= '?,';
     }      }
Line 275  sub create_statement_handler { Line 280  sub create_statement_handler {
     return;      return;
 }  }
   
 sub clear_sth { $sth=undef; }  sub clear_sth { $sth=undef; $sth_table=undef;}
   
 sub store_metadata {  sub store_metadata {
     my $dbh = shift();      my $dbh = shift();
       my $tablename = shift();
     my $errors = '';      my $errors = '';
     if (! defined($sth)) {      if (! defined($sth) || 
         &create_statement_handler($dbh);          ( defined($tablename) && ($sth_table ne $tablename)) || 
           (! defined($tablename) && $sth_table ne 'metadata')) {
           &create_statement_handler($dbh,$tablename);
     }      }
     my $successcount = 0;      my $successcount = 0;
     while (my $mdata = shift()) {      while (my $mdata = shift()) {
Line 289  sub store_metadata { Line 297  sub store_metadata {
         my @MData;          my @MData;
         foreach my $field (@Metadata_Table_Description) {          foreach my $field (@Metadata_Table_Description) {
             if (exists($mdata->{$field->{'name'}})) {              if (exists($mdata->{$field->{'name'}})) {
                 push(@MData,$mdata->{$field->{'name'}});                  if ($mdata->{$field->{'name'}} eq 'nan') {
                       push(@MData,'NULL');
                   } else {
                       push(@MData,$mdata->{$field->{'name'}});
                   }
             } else {              } else {
                 push(@MData,undef);                  push(@MData,undef);
             }              }
Line 371  sub delete_metadata {} Line 383  sub delete_metadata {}
 ######################################################################  ######################################################################
 ######################################################################  ######################################################################
   
   
   ######################################################################
   ######################################################################
   
   =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 .= '<span class="author">'.$evaluator.'</span>'.
               '<span class="comment">'.
               $resdata->{'evaluation'}->{'comments'}->{$evaluator}.'</span>';
       }
       $comments .= '</div>';
       #
       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__;
Removed from v.1.2  
changed lines
  Added in v.1.5

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