[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.3 and 1.35

version 1.3, 2004/01/12 21:48:38 version 1.35, 2012/03/14 20:53:56
Line 30  package LONCAPA::lonmetadata; Line 30  package LONCAPA::lonmetadata;
   
 use strict;  use strict;
 use DBI;  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 $Allusers_table_description $Allusers_indices);
   
 ######################################################################  ######################################################################
 ######################################################################  ######################################################################
Line 75  creationdate DATETIME, Line 78  creationdate DATETIME,
 lastrevisiondate DATETIME,   lastrevisiondate DATETIME, 
 owner TEXT,   owner TEXT, 
 copyright TEXT,   copyright TEXT, 
   domain TEXT
   
 FULLTEXT idx_title (title),   FULLTEXT idx_title (title), 
 FULLTEXT idx_author (author),   FULLTEXT idx_author (author), 
Line 89  FULLTEXT idx_language (language), Line 93  FULLTEXT idx_language (language),
 FULLTEXT idx_owner (owner),   FULLTEXT idx_owner (owner), 
 FULLTEXT idx_copyright (copyright))   FULLTEXT idx_copyright (copyright)) 
   
 TYPE=MYISAM;  ENGINE=MYISAM;
   
 =cut  =cut
   
 ######################################################################  ######################################################################
 ######################################################################  ######################################################################
 my @Metadata_Table_Description =   $Metadata_Table_Description = 
     (      [
      { name => 'title',     type=>'TEXT'},       { name => 'title',     type=>'TEXT'},
      { name => 'author',    type=>'TEXT'},       { name => 'author',    type=>'TEXT'},
      { name => 'subject',   type=>'TEXT'},       { name => 'subject',   type=>'TEXT'},
Line 111  my @Metadata_Table_Description = Line 115  my @Metadata_Table_Description =
      { name => 'lastrevisiondate', type=>'DATETIME'},       { name => 'lastrevisiondate', type=>'DATETIME'},
      { name => 'owner',     type=>'TEXT'},       { name => 'owner',     type=>'TEXT'},
      { name => 'copyright', type=>'TEXT'},        { name => 'copyright', type=>'TEXT'}, 
        { name => 'domain',    type=>'TEXT'},
       #--------------------------------------------------        #--------------------------------------------------
      { name => 'dependencies',   type=>'TEXT'},       { name => 'dependencies',   type=>'TEXT'},
      { name => 'modifyinguser',  type=>'TEXT'},       { name => 'modifyinguser',  type=>'TEXT'},
Line 133  my @Metadata_Table_Description = Line 138  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 140  my @Metadata_Table_Description = Line 147  my @Metadata_Table_Description =
      { name => 'depth',          type=>'FLOAT'},       { name => 'depth',          type=>'FLOAT'},
      { name => 'hostname',       type=> 'TEXT'},       { name => 'hostname',       type=> 'TEXT'},
      #--------------------------------------------------       #--------------------------------------------------
      );      ];
   
 my @Fulltext_indicies = qw/  $Fulltext_indicies = [ qw/ 
     title      title
     author      author
     subject      subject
Line 154  my @Fulltext_indicies = qw/ Line 161  my @Fulltext_indicies = qw/
     mime      mime
     language      language
     owner      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 => '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/];
   
   ######################################################################
   ######################################################################
   
   $Allusers_table_description =
       [
        { name => 'username',   type=>'TEXT', restrictions => 'NOT NULL' },
        { name => 'domain', type=>'TEXT', restrictions => 'NOT NULL' },
        { name => 'lastname', type=>'TEXT',},
        { name => 'firstname', type=>'TEXT'},
        { name => 'middlename', type=>'TEXT'},
        { name => 'generation', type=>'TEXT'},
        { name => 'permanentemail', type=>'TEXT'},
        { name => 'id', type=>'TEXT'},
      ];
   
   $Allusers_indices = [qw/
       username
       domain
       lastname
       firstname/];
   
 ######################################################################  ######################################################################
 ######################################################################  ######################################################################
Line 172  of the metadata table(s). Line 281  of the metadata table(s).
   
 ######################################################################  ######################################################################
 ######################################################################  ######################################################################
 sub describe_metadata_storage {   sub describe_metadata_storage {
     return (\@Metadata_Table_Description,\@Fulltext_indicies);      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, 
           allusers              => $Allusers_table_description,
       );
       my %index_description = (
           metadata              => $Fulltext_indicies,
           portfolio_metadata    => $Portfolio_metadata_indices,
           portfolio_access      => $Portfolio_access_indices,
           portfolio_addedfields => $Portfolio_addedfields_indices,
           allusers              => $Allusers_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});
       }
 }  }
   
 ######################################################################  ######################################################################
Line 193  metadata storage to be initialized. Line 332  metadata storage to be initialized.
 ######################################################################  ######################################################################
 ######################################################################  ######################################################################
 sub create_metadata_storage {   sub create_metadata_storage { 
     my ($tablename) = @_;      my ($tablename,$tabletype) = @_;
     $tablename = 'metadata' if (! defined($tablename));      $tablename = 'metadata' if (! defined($tablename));
       $tabletype = 'metadata' if (! defined($tabletype));
     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)
     my @Columns;      my @Columns;
     my $col_des; # mysql column description      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'};          my $column = $coldata->{'name'};
           $coltype{$column} = $coldata->{'type'};
         $col_des = '';          $col_des = '';
         if (lc($coldata->{'type'}) =~ /(enum|set)/) { # 'enum' or 'set'          if (lc($coldata->{'type'}) =~ /(enum|set)/) { # 'enum' or 'set'
             $col_des.=$column." ".$coldata->{'type'}."('".              $col_des.=$column." ".$coldata->{'type'}."('".
Line 212  sub create_metadata_storage { Line 356  sub create_metadata_storage {
                 $col_des.="(".$coldata->{'size'}.")";                  $col_des.="(".$coldata->{'size'}.")";
             }              }
         }          }
           if (($tablename =~ /allusers/) && ($column eq 'username')) {  
               $col_des .= ' CHARACTER SET latin1 COLLATE latin1_general_cs';
           }
         # Modifiers          # Modifiers
         if (exists($coldata->{'restrictions'})){          if (exists($coldata->{'restrictions'})){
             $col_des.=" ".$coldata->{'restrictions'};              $col_des.=" ".$coldata->{'restrictions'};
Line 227  sub create_metadata_storage { Line 374  sub create_metadata_storage {
         # skip blank items.          # skip blank items.
         push (@Columns,$col_des) if ($col_des ne '');          push (@Columns,$col_des) if ($col_des ne '');
     }      }
     foreach my $colname (@Fulltext_indicies) {      foreach my $colname (@{$table_indices}) {
         my $text = 'FULLTEXT idx_'.$colname.' ('.$colname.')';          my $text;
           if ($coltype{$colname} eq 'TEXT') {
               $text = 'FULLTEXT ';
           } else {
               $text = 'INDEX ';
           }
           $text .= 'idx_'.$colname.' ('.$colname.')';
         push (@Columns,$text);          push (@Columns,$text);
     }      }
     $request .= "(".join(", ",@Columns).") TYPE=MyISAM";      $request .= "(".join(", ",@Columns).") ENGINE=MyISAM";
     return $request;      return $request;
 }  }
   
Line 242  sub create_metadata_storage { Line 395  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, table type and a hash or hash 
 metadata for a single resource.  reference 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 259  Returns: 1 on success, 0 on failure to s Line 412  Returns: 1 on success, 0 on failure to s
     ##      ##
     ##  In most scripts, this will work fine.  If the dbi is going to be      ##  In most scripts, this will work fine.  If the dbi is going to be
     ##  dropped and (possibly) later recreated, call &clear_sth.  Yes it      ##  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.      ##  $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,$tablename,$tabletype) = @_;
     my $request = 'INSERT INTO metadata VALUES(';      $tablename = 'metadata' if (! defined($tablename));
     foreach (@Metadata_Table_Description) {      $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 .= '?,';          $request .= '?,';
     }      }
     chop $request;      chop $request;
Line 276  sub create_statement_handler { Line 435  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,$tablename,$tabletype,@Metadata)=@_;
     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,$tabletype);
     }      }
     my $successcount = 0;      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");          next if (ref($mdata) ne "HASH");
         my @MData;          my @MData;
         foreach my $field (@Metadata_Table_Description) {          foreach my $field (@{$table_columns}) {
             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, $field->{type} eq 'DATETIME' ? 
                           sqltime($mdata->{$fname}) : $mdata->{$fname});
                   }
             } else {              } else {
                 push(@MData,undef);                  push(@MData,undef);
             }              }
Line 301  sub store_metadata { Line 476  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 329  The array reference is the same one retu Line 505  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 350  sub lookup_metadata { Line 527  sub lookup_metadata {
                 $error = $sth->errstr;                  $error = $sth->errstr;
             }              }
         }          }
     }      } 
     return ($error,$returnvalue);      return ($error,$returnvalue);
 }  }
   
Line 361  sub lookup_metadata { Line 538  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'
   $delitem, the resource to remove from the metadata database, in the form: 
             url = quoted url 
   
   Returns: undef on success, dbh errorstr on failure.
   
   =cut
   
   ######################################################################
   ######################################################################
   sub delete_metadata {
       my ($dbh,$tablename,$delitem) = @_;
       $tablename = 'metadata' if (! defined($tablename));
       my ($error,$delete_command);
       if ($delitem eq '') {
           $error = 'deletion aborted - no resource specified';    
       } else {
           $delete_command = 'DELETE FROM '.$tablename.' WHERE '.$delitem;
           $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, 
                              allusers)
   $conditions, optional hash of conditions to use in SQL queries; 
                default used if none provided.
   
   Returns:
   $error on failure.  undef on success.
   
   =cut
   
   ######################################################################
   ######################################################################
   sub update_metadata {
       my ($dbh,$tablename,$tabletype,$newmetadata,$conditions)=@_;
       my ($error,$condition);
       $tablename = 'metadata' if (! defined($tablename));
       $tabletype = 'metadata' if (! defined($tabletype));
       if (ref($conditions) eq 'HASH') {
           my @items;
           foreach my $key (keys(%{$conditions})) {
               if (! exists($newmetadata->{$key})) {
                   $error .= "Unable to update: no $key specified";
               } else {
                   push(@items,"$key = ".$dbh->quote($newmetadata->{$key}));
               }
           }
           $condition = join(' AND ',@items); 
       } else {
           if (! exists($newmetadata->{'url'})) {
               $error = 'Unable to update: no url specified';
           } else {
               $condition = 'url = '.$dbh->quote($newmetadata->{'url'});
           }
       }
       return $error if (defined($error));
       # 
       # Retrieve current values
       my $row;
       ($error,$row) = &lookup_metadata($dbh,$condition,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,$condition);
       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  =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 %course_counted;
           my $sum;
           my @Values;
           my @Students;
           #
           # New data
           if (exists($resdata->{'stats'})) {
               foreach my $identifier (sort(keys(%{$resdata->{'stats'}}))) {
                   my $coursedata = $resdata->{'stats'}->{$identifier};
    next if (lc($coursedata->{$type}) eq 'nan');
    $course_counted{$coursedata->{'course'}}++;
                   $studentcount += $coursedata->{'stdno'};
                   $sum += $coursedata->{$type}*$coursedata->{'stdno'};
                   push(@Values,$coursedata->{$type});                
                   push(@Students,$coursedata->{'stdno'});
               }
           }
           #
           # Old data
    foreach my $course (keys(%{$resdata->{'statistics'}})) {
       next if (exists($course_counted{$course}));
       my $coursedata = $resdata->{'statistics'}{$course};
               if (ref($coursedata) eq 'HASH' && exists($coursedata->{$type})) {
    next if (lc($coursedata->{$type}) eq 'nan');
                   $studentcount += $coursedata->{'stdno'};
                   $sum += ($coursedata->{$type}*$coursedata->{'stdno'});
                   push(@Values,$coursedata->{$type});
                   push(@Students,$coursedata->{'stdno'});
               }
           }
           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;
       my %course_counted;
       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;
    $course_counted{$coursedata->{'course'}}++;
                   $coursemax = 0;
                   $current_course = $coursedata->{'course'};                
               }
               if ($coursemax < $coursedata->{'stdno'}) {
                   $coursemax = $coursedata->{'stdno'};
               }
           }
           $stdno += $coursemax; # pick up the final course in the list
       }
       # check for old data that has not been run since the format was changed
       foreach my $course (keys(%{$resdata->{'statistics'}})) {
    next if (exists($course_counted{$course}));
    my $coursedata = $resdata->{'statistics'}{$course};
           if (ref($coursedata) eq 'HASH' && exists($coursedata->{'stdno'})) {
       $stdno += $coursedata->{'stdno'};
           }
       }
       $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}});
           }
       }
   #
   # NOTE: usage is named sequsage elsewhere in LON-CAPA
   # The translation happens here
   #
       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 .= 
               '<p>'.
               '<b>'.$evaluator.'</b>: '.
               $resdata->{'evaluation'}->{'comments'}->{$evaluator}.
               '</p>';
       }
       if ($comments) {
           $comments = '<div class="LCevalcomments">'
                      .$comments
                      .'</div>';
           $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 (!exists($metacache{'domain'})) {
       $metacache{'domain'} = $dom;
    }
       }
       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;
           if ($url eq '') {
               $error = 'No url specified'; 
           } else {
               my $delitem = 'url = '.$dbh->quote($url);
               $error=&delete_metadata($dbh,$newnames->{'access'},$delitem);
           }
           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;
               my $sqltime_error;
               if ($end != 0) {
                   $acc_data->{end} = &sqltime($end,\$sqltime_error);
               }
               $acc_data->{start} = &sqltime($start,\$sqltime_error);
               if ($sqltime_error) {
                   $loghash{$key}{'err'} = $sqltime_error;
               }
               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,$delitem);
           if ($url eq '') {
               $error = 'No url specified';
           } else {
               $delitem = 'url = '.$dbh->quote($url);
               $error=&delete_metadata($dbh,$newnames->{'portfolio'},$delitem);
           }
           if (defined($error)) {
               $loghash{'metadata'}{'err'} = "MySQL Error delete metadata: ".
                                                  $error;
               return %loghash;
           }
           $error=&delete_metadata($dbh,$newnames->{'addedfields'},$delitem);
           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);
           my $sqltime_error;
           &getfiledates($ref,$fullpath,\$sqltime_error);
           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) {
               if ($sqltime_error) {
                   $loghash{'metadata'."\0"}{'err'} = $sqltime_error;
               }
               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 process_allusers_data {
       my ($dbh,$simulate,$newnames,$uname,$udom,$userdata,$caller) = @_;
       my %loghash;
       if ($caller eq 'update') {
           # Delete old data (no error if deleting non-existent record).
           my ($error,$delitem);
           if ($udom eq '' || $uname eq '' ) {
               $error = 'No domain and/or username specified';
           } else {
               $delitem = 'domain = '.$dbh->quote($udom).' AND username '.
                          'COLLATE latin1_general_cs = '.$dbh->quote($uname);
               $error=&delete_metadata($dbh,$newnames->{'allusers'},$delitem);
           }
           if (defined($error)) {
               $loghash{'err'} = 'MySQL Error in allusers delete: '.$error;
               return %loghash;
           }
       }
       if (!$simulate) {
           if ($udom ne '' && $uname ne '') {
               my ($count,$err) = &store_metadata($dbh,$newnames->{'allusers'},
                                                  'allusers',$userdata);
               if ($err) {
                   $loghash{'err'} = 'MySQL Error in allusers insert: '.$err;
               }
               if ($count < 1) {
                   $loghash{'count'} = 
                       'Unable to insert record into MySQL allusers database for '.
                       $uname.' in '.$udom;
               }
           } else {
               $loghash{'err'} = 
                   'MySQL Error allusrs insert: missing username and/or domain';
           }
       }
       return %loghash;
   }
   
   ######################################################################
   ######################################################################
   
   sub getfile {
       my $file = shift();
       if (! -e $file ) { 
           return undef; 
       }
       open(my $fh,"<$file");
       my $contents = '';
       while (<$fh>) { 
           $contents .= $_;
       }
       return $contents;
   }
   
   ##
   ## &getfiledates($ref,$target,$sqltime_error)
   ## Converts creationdate and modifieddates to SQL format
   ## Applies stat() to file to retrieve dates if missing
   sub getfiledates {
       my ($ref,$target,$sqltime_error) = @_;
       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'},$sqltime_error);
       $ref->{'lastrevisiondate'} = &sqltime($ref->{'lastrevisiondate'},$sqltime_error);
   }
    
   ##
   ## &sqltime($timestamp,$sqltime_error)
   ##
   ## Convert perl $timestamp to MySQL time.  MySQL expects YYYY-MM-DD HH:MM:SS
   ##
   sub sqltime {
       my ($time,$sqltime_error) = @_;
       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 {
           if (ref($sqltime_error) eq 'SCALAR') {
               $$sqltime_error = "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;  1;
   
Removed from v.1.3  
changed lines
  Added in v.1.35

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