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

version 1.5, 2004/04/12 21:11:45 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), a table name, and a hash or hash reference   Inputs: database handle ($dbh), a table name, table type and a hash or hash 
 containing the 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;      my $sth_table = undef;
   
 sub create_statement_handler {  sub create_statement_handler {
     my $dbh = shift();      my ($dbh,$tablename,$tabletype) = @_;
     my $tablename = shift();  
     $tablename = 'metadata' if (! defined($tablename));      $tablename = 'metadata' if (! defined($tablename));
       $tabletype = 'metadata' if (! defined($tabletype));
       my ($table_columns,$table_indices) = 
             &describe_metadata_storage($tabletype);
     $sth_table = $tablename;      $sth_table = $tablename;
     my $request = 'INSERT INTO '.$tablename.' VALUES(';      my $request = 'INSERT INTO '.$tablename.' VALUES(';
     foreach (@Metadata_Table_Description) {      foreach (@{$table_columns}) {
         $request .= '?,';          $request .= '?,';
     }      }
     chop $request;      chop $request;
Line 283  sub create_statement_handler { Line 438  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,$tabletype,@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)) || 
         (! defined($tablename) && $sth_table ne 'metadata')) {          (! defined($tablename) && $sth_table ne 'metadata')) {
         &create_statement_handler($dbh,$tablename);          &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'};
                 if ($mdata->{$field->{'name'}} eq 'nan') {              if (exists($mdata->{$fname}) && 
                   defined($mdata->{$fname}) &&
                   $mdata->{$fname} ne '') {
                   if ($mdata->{$fname} eq 'nan' ||
                       $mdata->{$fname} eq '') {
                     push(@MData,'NULL');                      push(@MData,'NULL');
                 } else {                  } else {
                     push(@MData,$mdata->{$field->{'name'}});                      push(@MData, $field->{type} eq 'DATETIME' ? 
                           sqltime($mdata->{$fname}) : $mdata->{$fname});
                 }                  }
             } else {              } else {
                 push(@MData,undef);                  push(@MData,undef);
Line 312  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 340  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 361  sub lookup_metadata { Line 527  sub lookup_metadata {
                 $error = $sth->errstr;                  $error = $sth->errstr;
             }              }
         }          }
     }      } 
     return ($error,$returnvalue);      return ($error,$returnvalue);
 }  }
   
Line 372  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  =cut
   
 ######################################################################  ######################################################################
 ######################################################################  ######################################################################
 sub delete_metadata {}  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
   
 ######################################################################  ######################################################################
 ######################################################################  ######################################################################
Line 435  sub process_reseval_data { Line 769  sub process_reseval_data {
             #              #
             # Statistics: $source is course id              # Statistics: $source is course id
             $DynamicData{$file}->{'statistics'}->{$source}->{$type}=$value;              $DynamicData{$file}->{'statistics'}->{$source}->{$type}=$value;
         } elsif ($type =~ /^(clear|comments|depth|technical|helpful)$/){          } elsif ($type =~ /^(clear|comments|depth|technical|helpful|correct)$/){
             #              #
             # Evaluation $source is username, check if they evaluated it              # Evaluation $source is username, check if they evaluated it
             # more than once.  If so, pad the entry with a space.              # more than once.  If so, pad the entry with a space.
Line 453  sub process_reseval_data { Line 787  sub process_reseval_data {
             # $source is $cid\_$sec\_$stdno              # $source is $cid\_$sec\_$stdno
             # $value is stat1=value&stat2=value&stat3=value,....              # $value is stat1=value&stat2=value&stat3=value,....
             #              #
             my ($cid,$sec,$stdno)=split('_',$source);              my ($cid,$sec,$stdno)=split('&',$source);
             my $crssec = $cid.'_'.$sec;              my $crssec = $cid.'&'.$sec;
             my @Data = split('&',$value);              my @Data = split('&',$value);
             my %Statistics;              my %Statistics;
             while (my ($key,$value) = split('=',pop(@Data))) {              while (my ($key,$value) = split('=',pop(@Data))) {
                 $Statistics{$key} = $value;                  $Statistics{$key} = $value;
             }              }
               $sec =~ s:("$|^")::g;
               $Statistics{'sections'} = $sec;
             #              #
             # Only store the data if the number of students is greater              # Only store the data if the number of students is greater
             # than the data already stored              # than the data already stored
Line 501  sub process_dynamic_metadata { Line 837  sub process_dynamic_metadata {
     my %data;      my %data;
     my $resdata = $DynamicData->{$url};      my $resdata = $DynamicData->{$url};
     #      #
     # Get the statistical data      # Get the statistical data - Use a weighted average
     foreach my $type (qw/avetries difficulty stdno/) {      foreach my $type (qw/avetries difficulty disc/) {
         my $count;          my $studentcount;
    my %course_counted;
         my $sum;          my $sum;
         my @Values;          my @Values;
           my @Students;
         #          #
         foreach my $coursedata (values(%{$resdata->{'statistics'}}),          # New data
                                 values(%{$resdata->{'stats'}})) {          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})) {              if (ref($coursedata) eq 'HASH' && exists($coursedata->{$type})) {
                 $count++;   next if (lc($coursedata->{$type}) eq 'nan');
                 $sum += $coursedata->{$type};                  $studentcount += $coursedata->{'stdno'};
                   $sum += ($coursedata->{$type}*$coursedata->{'stdno'});
                 push(@Values,$coursedata->{$type});                  push(@Values,$coursedata->{$type});
                   push(@Students,$coursedata->{'stdno'});
             }              }
         }          }
         if ($count) {          if (defined($studentcount) && $studentcount>0) {
             $data{$type} = $sum/$count;              $data{$type} = $sum/$studentcount;
             $data{$type.'_list'} = join(',',@Values);              $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      # Get the context data
     foreach my $type (qw/course goto comefrom/) {      foreach my $type (qw/course goto comefrom/) {
         if (defined($resdata->{$type}) &&           if (defined($resdata->{$type}) && 
Line 529  sub process_dynamic_metadata { Line 919  sub process_dynamic_metadata {
             $data{$type.'_list'} = join(',',@{$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'}) &&       if (defined($resdata->{'usage'}) && 
         ref($resdata->{'usage'}) eq 'ARRAY') {          ref($resdata->{'usage'}) eq 'ARRAY') {
         $data{'sequsage'} = scalar(@{$resdata->{'usage'}});          $data{'sequsage'} = scalar(@{$resdata->{'usage'}});
Line 549  sub process_dynamic_metadata { Line 943  sub process_dynamic_metadata {
     }      }
     #      #
     # put together comments      # put together comments
     my $comments = '<div class="LCevalcomments">';      my $comments = '';
     foreach my $evaluator (keys(%{$resdata->{'evaluation'}->{'comments'}})){      foreach my $evaluator (keys(%{$resdata->{'evaluation'}->{'comments'}})){
         $comments .= '<span class="author">'.$evaluator.'</span>'.          $comments .= 
             '<span class="comment">'.              '<p>'.
             $resdata->{'evaluation'}->{'comments'}->{$evaluator}.'</span>';              '<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'};
     }      }
     $comments .= '</div>';  
     #      #
     return %data;      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;
   }
   
 ######################################################################  ######################################################################
 ######################################################################  ######################################################################
 ##  ##
Line 579  sub escape { Line 1322  sub escape {
     return $str;      return $str;
 }  }
   
   
 1;  1;
   
 __END__;  __END__;
Removed from v.1.5  
changed lines
  Added in v.1.35

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