[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.12 and 1.33

version 1.12, 2005/03/11 03:25:18 version 1.33, 2011/05/31 14:45:53
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 90  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 144  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 158  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 176  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 197  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 216  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 231  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 246  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 263  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 287  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,$tablename,@Metadata)=@_;      my ($dbh,$tablename,$tabletype,@Metadata)=@_;
     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;
       if (! defined($tabletype)) {
           $tabletype = 'metadata';
       }
       my ($table_columns,$table_indices) = 
                           &describe_metadata_storage($tabletype);
     foreach my $mdata (@Metadata) {      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}) {
             my $fname = $field->{'name'};              my $fname = $field->{'name'};
             if (exists($mdata->{$fname}) &&               if (exists($mdata->{$fname}) && 
                 defined($mdata->{$fname}) &&                  defined($mdata->{$fname}) &&
Line 370  sub lookup_metadata { Line 526  sub lookup_metadata {
                 $error = $sth->errstr;                  $error = $sth->errstr;
             }              }
         }          }
     }      } 
     return ($error,$returnvalue);      return ($error,$returnvalue);
 }  }
   
Line 385  Removes a single metadata record, based Line 541  Removes a single metadata record, based
   
 Inputs: $dbh, the database handler.  Inputs: $dbh, the database handler.
 $tablename, the name of the metadata table to remove from. default: 'metadata'  $tablename, the name of the metadata table to remove from. default: 'metadata'
 $url, the url of the resource to remove from the metadata database.  $delitem, the resource to remove from the metadata database, in the form: 
             url = quoted url 
   
 Returns: undef on success, dbh errorstr on failure.  Returns: undef on success, dbh errorstr on failure.
   
Line 394  Returns: undef on success, dbh errorstr Line 551  Returns: undef on success, dbh errorstr
 ######################################################################  ######################################################################
 ######################################################################  ######################################################################
 sub delete_metadata {  sub delete_metadata {
     my ($dbh,$tablename,$url) = @_;      my ($dbh,$tablename,$delitem) = @_;
     $tablename = 'metadata' if (! defined($tablename));      $tablename = 'metadata' if (! defined($tablename));
     my $error;      my ($error,$delete_command);
     my $delete_command = 'DELETE FROM '.$tablename.' WHERE url='.      if ($delitem eq '') {
         $dbh->quote($url);          $error = 'deletion aborted - no resource specified';    
     $dbh->do($delete_command);      } else {
     if ($dbh->err) {          $delete_command = 'DELETE FROM '.$tablename.' WHERE '.$delitem;
         $error = $dbh->errstr();          $dbh->do($delete_command);
           if ($dbh->err) {
               $error = $dbh->errstr();
           }
     }      }
     return $error;      return $error;
 }  }
Line 422  Inputs: Line 582  Inputs:
 $dbh, database handle  $dbh, database handle
 $newmetadata, hash reference containing the new metadata  $newmetadata, hash reference containing the new metadata
 $tablename, metadata table name.  Defaults to '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:  Returns:
 $error on failure.  undef on success.  $error on failure.  undef on success.
Line 431  $error on failure.  undef on success. Line 595  $error on failure.  undef on success.
 ######################################################################  ######################################################################
 ######################################################################  ######################################################################
 sub update_metadata {  sub update_metadata {
     my ($dbh,$tablename,$newmetadata)=@_;      my ($dbh,$tablename,$tabletype,$newmetadata,$conditions)=@_;
     my $error;      my ($error,$condition);
     $tablename = 'metadata' if (! defined($tablename));      $tablename = 'metadata' if (! defined($tablename));
     if (! exists($newmetadata->{'url'})) {      $tabletype = 'metadata' if (! defined($tabletype));
         $error = 'Unable to update: no url specified';      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));      return $error if (defined($error));
     #       # 
     # Retrieve current values      # Retrieve current values
     my $row;      my $row;
     ($error,$row) = &lookup_metadata($dbh,      ($error,$row) = &lookup_metadata($dbh,$condition,undef,$tablename);
                                    ' url='.$dbh->quote($newmetadata->{'url'}),  
                                      undef,$tablename);  
     return $error if ($error);      return $error if ($error);
     my %metadata = &LONCAPA::lonmetadata::metadata_col_to_hash(@{$row->[0]});      my %metadata = &LONCAPA::lonmetadata::metadata_col_to_hash($tabletype,@{$row->[0]});
     #      #
     # Update metadata values      # Update metadata values
     while (my ($key,$value) = each(%$newmetadata)) {      while (my ($key,$value) = each(%$newmetadata)) {
Line 453  sub update_metadata { Line 630  sub update_metadata {
     }      }
     #      #
     # Delete old data (deleting a nonexistant record does not produce an error.      # Delete old data (deleting a nonexistant record does not produce an error.
     $error = &delete_metadata($dbh,$tablename,$newmetadata->{'url'});      $error = &delete_metadata($dbh,$tablename,$condition);
     return $error if (defined($error));      return $error if (defined($error));
     #      #
     # Store updated metadata      # Store updated metadata
     my $success;      my $success;
     ($success,$error) = &store_metadata($dbh,$tablename,\%metadata);      ($success,$error) = &store_metadata($dbh,$tablename,$tabletype,\%metadata);
     return $error;      return $error;
 }  }
   
Line 479  passed in as values Line 656  passed in as values
 ######################################################################  ######################################################################
 ######################################################################  ######################################################################
 sub metadata_col_to_hash {  sub metadata_col_to_hash {
     my @cols=@_;      my ($tabletype,@cols)=@_;
     my %hash=();      my %hash=();
     for (my $i=0; $i<=$#Metadata_Table_Description;$i++) {      my ($columns,$indices) = &describe_metadata_storage($tabletype);
         $hash{$Metadata_Table_Description[$i]->{'name'}}=$cols[$i];      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;      return %hash;
 }  }
Line 652  sub process_dynamic_metadata { Line 839  sub process_dynamic_metadata {
     # Get the statistical data - Use a weighted average      # Get the statistical data - Use a weighted average
     foreach my $type (qw/avetries difficulty disc/) {      foreach my $type (qw/avetries difficulty disc/) {
         my $studentcount;          my $studentcount;
    my %course_counted;
         my $sum;          my $sum;
         my @Values;          my @Values;
         my @Students;          my @Students;
         #          #
         # Old data          # New data
         foreach my $coursedata (values(%{$resdata->{'statistics'}}),  
                                 values(%{$resdata->{'stats'}})) {  
             if (ref($coursedata) eq 'HASH' && exists($coursedata->{$type})) {  
                 $studentcount += $coursedata->{'stdno'};  
                 $sum += ($coursedata->{$type}*$coursedata->{'stdno'});  
                 push(@Values,$coursedata->{$type});  
                 push(@Students,$coursedata->{'stdno'});  
             }  
         }  
         if (exists($resdata->{'stats'})) {          if (exists($resdata->{'stats'})) {
             foreach my $identifier (sort(keys(%{$resdata->{'stats'}}))) {              foreach my $identifier (sort(keys(%{$resdata->{'stats'}}))) {
                 my $coursedata = $resdata->{'stats'}->{$identifier};                  my $coursedata = $resdata->{'stats'}->{$identifier};
    next if (lc($coursedata->{$type}) eq 'nan');
    $course_counted{$coursedata->{'course'}}++;
                 $studentcount += $coursedata->{'stdno'};                  $studentcount += $coursedata->{'stdno'};
                 $sum += $coursedata->{$type}*$coursedata->{'stdno'};                  $sum += $coursedata->{$type}*$coursedata->{'stdno'};
                 push(@Values,$coursedata->{$type});                                  push(@Values,$coursedata->{$type});                
Line 676  sub process_dynamic_metadata { Line 857  sub process_dynamic_metadata {
             }              }
         }          }
         #          #
         # New data          # 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) {          if (defined($studentcount) && $studentcount>0) {
             $data{$type} = $sum/$studentcount;              $data{$type} = $sum/$studentcount;
             $data{$type.'_list'} = join(',',@Values);              $data{$type.'_list'} = join(',',@Values);
Line 685  sub process_dynamic_metadata { Line 877  sub process_dynamic_metadata {
     #      #
     # Find out the number of students who have completed the resource...      # Find out the number of students who have completed the resource...
     my $stdno;      my $stdno;
     foreach my $coursedata (values(%{$resdata->{'statistics'}}),      my %course_counted;
                             values(%{$resdata->{'stats'}})) {  
         if (ref($coursedata) eq 'HASH' && exists($coursedata->{'stdno'})) {  
             $stdno += $coursedata->{'stdno'};  
         }  
     }  
     if (exists($resdata->{'stats'})) {      if (exists($resdata->{'stats'})) {
         #          #
         # For the number of students, take the maximum found for the class          # For the number of students, take the maximum found for the class
Line 703  sub process_dynamic_metadata { Line 890  sub process_dynamic_metadata {
             }              }
             if ($current_course ne $coursedata->{'course'}) {              if ($current_course ne $coursedata->{'course'}) {
                 $stdno += $coursemax;                  $stdno += $coursemax;
    $course_counted{$coursedata->{'course'}}++;
                 $coursemax = 0;                  $coursemax = 0;
                 $current_course = $coursedata->{'course'};                                  $current_course = $coursedata->{'course'};                
             }              }
Line 712  sub process_dynamic_metadata { Line 900  sub process_dynamic_metadata {
         }          }
         $stdno += $coursemax; # pick up the final course in the list          $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;      $data{'stdno'}=$stdno;
     #      #
     # Get the context data      # Get the context data
Line 742  sub process_dynamic_metadata { Line 938  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 .=           $comments .= 
             '<p>'.              '<p>'.
             '<b>'.$evaluator.'</b>:'.              '<b>'.$evaluator.'</b>: '.
             $resdata->{'evaluation'}->{'comments'}->{$evaluator}.              $resdata->{'evaluation'}->{'comments'}->{$evaluator}.
             '</p>';              '</p>';
     }      }
     $comments .= '</div>';      if ($comments) {
     $data{'comments'} = $comments;          $comments = '<div class="LCevalcomments">'
                      .$comments
                      .'</div>';
           $data{'comments'} = $comments;
       }
     #      #
     if (exists($resdata->{'stats'})) {      if (exists($resdata->{'stats'})) {
         $data{'stats'} = $resdata->{'stats'};          $data{'stats'} = $resdata->{'stats'};
Line 784  sub dynamic_metadata_storage { Line 984  sub dynamic_metadata_storage {
     return %Store;      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;
   }
   
 ######################################################################  ######################################################################
 ######################################################################  ######################################################################
 ##  ##
Removed from v.1.12  
changed lines
  Added in v.1.33

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