Diff for /loncom/metadata_database/LONCAPA/lonmetadata.pm between versions 1.20 and 1.27

version 1.20, 2007/05/12 23:03:30 version 1.27, 2009/04/29 15:21:00
Line 32  use strict; Line 32  use strict;
 use DBI;  use DBI;
 use HTML::TokeParser;  use HTML::TokeParser;
 use vars qw($Metadata_Table_Description $Portfolio_metadata_table_description   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);  $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 247  $Portfolio_addedfields_indices = [qw/ Line 247  $Portfolio_addedfields_indices = [qw/
 ######################################################################  ######################################################################
 ######################################################################  ######################################################################
   
   $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/];
   
   ######################################################################
   ######################################################################
   
 =pod  =pod
   
Line 268  sub describe_metadata_storage { Line 288  sub describe_metadata_storage {
         portfolio_metadata    => $Portfolio_metadata_table_description,          portfolio_metadata    => $Portfolio_metadata_table_description,
         portfolio_access      => $Portfolio_access_table_description,          portfolio_access      => $Portfolio_access_table_description,
         portfolio_addedfields => $Portfolio_addedfields_table_description,           portfolio_addedfields => $Portfolio_addedfields_table_description, 
           allusers              => $Allusers_table_description,
     );      );
     my %index_description = (      my %index_description = (
         metadata              => $Fulltext_indicies,          metadata              => $Fulltext_indicies,
         portfolio_metadata    => $Portfolio_metadata_indices,          portfolio_metadata    => $Portfolio_metadata_indices,
         portfolio_access      => $Portfolio_access_indices,          portfolio_access      => $Portfolio_access_indices,
         portfolio_addedfields => $Portfolio_addedfields_indices,          portfolio_addedfields => $Portfolio_addedfields_indices,
           allusers              => $Allusers_indices,
     );      );
     if ($tabletype eq 'portfolio_search') {      if ($tabletype eq 'portfolio_search') {
         my @portfolio_search_table = @{$table_description{portfolio_metadata}};          my @portfolio_search_table = @{$table_description{portfolio_metadata}};
Line 516  Removes a single metadata record, based Line 538  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 525  Returns: undef on success, dbh errorstr Line 548  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 553  Inputs: Line 579  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)    $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 563  $error on failure.  undef on success. Line 592  $error on failure.  undef on success.
 ######################################################################  ######################################################################
 ######################################################################  ######################################################################
 sub update_metadata {  sub update_metadata {
     my ($dbh,$tablename,$tabletype,$newmetadata)=@_;      my ($dbh,$tablename,$tabletype,$newmetadata,$conditions)=@_;
     my $error;      my ($error,$condition);
     $tablename = 'metadata' if (! defined($tablename));      $tablename = 'metadata' if (! defined($tablename));
     $tabletype = 'metadata' if (! defined($tabletype));      $tabletype = 'metadata' if (! defined($tabletype));
     if (! exists($newmetadata->{'url'})) {      if (ref($conditions) eq 'HASH') {
         $error = 'Unable to update: no url specified';          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($tabletype,@{$row->[0]});      my %metadata = &LONCAPA::lonmetadata::metadata_col_to_hash($tabletype,@{$row->[0]});
     #      #
Line 586  sub update_metadata { Line 627  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
Line 795  sub process_dynamic_metadata { Line 836  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 819  sub process_dynamic_metadata { Line 854  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 889  sub process_dynamic_metadata { Line 935  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 995  sub portfolio_metadata { Line 1045  sub portfolio_metadata {
                 }                  }
             }              }
         } # End of ($token->[0] eq 'S')          } # End of ($token->[0] eq 'S')
   
    if (!exists($metacache{'domain'})) {
       $metacache{'domain'} = $dom;
    }
     }      }
     return (\%metacache,$metacache{'courserestricted'},\%addedfields);      return (\%metacache,$metacache{'courserestricted'},\%addedfields);
 }  }
Line 1004  sub process_portfolio_access_data { Line 1058  sub process_portfolio_access_data {
     my %loghash;      my %loghash;
     if ($caller eq 'update') {      if ($caller eq 'update') {
         # Delete old data (no error if deleting non-existent record).          # Delete old data (no error if deleting non-existent record).
         my $error=&delete_metadata($dbh,$newnames->{'access'},$url);          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)) {          if (defined($error)) {
             $loghash{'access'}{'err'} = "MySQL Error Delete: ".$error;              $loghash{'access'}{'err'} = "MySQL Error Delete: ".$error;
             return %loghash;              return %loghash;
Line 1046  sub process_portfolio_metadata { Line 1106  sub process_portfolio_metadata {
     my %loghash;      my %loghash;
     if ($caller eq 'update') {      if ($caller eq 'update') {
         # Delete old data (no error if deleting non-existent record).          # Delete old data (no error if deleting non-existent record).
         my $error=&delete_metadata($dbh,$newnames->{'portfolio'},$url);          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)) {          if (defined($error)) {
             $loghash{'metadata'}{'err'} = "MySQL Error delete metadata: ".              $loghash{'metadata'}{'err'} = "MySQL Error delete metadata: ".
                                                $error;                                                 $error;
             return %loghash;              return %loghash;
         }          }
         $error=&delete_metadata($dbh,$newnames->{'addedfields'},$url);          $error=&delete_metadata($dbh,$newnames->{'addedfields'},$delitem);
         if (defined($error)) {          if (defined($error)) {
             $loghash{'addedfields'}{'err'}="MySQL Error delete addedfields: ".$error;              $loghash{'addedfields'}{'err'}="MySQL Error delete addedfields: ".$error;
         }          }
Line 1110  sub process_portfolio_metadata { Line 1176  sub process_portfolio_metadata {
         }          }
     }      }
     return %loghash;      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;
 }  }
   
 ######################################################################  ######################################################################

Removed from v.1.20  
changed lines
  Added in v.1.27


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