[BACK]Return to loncoursedata.pm CVS log [TXT] [DIR] Up to [LON-CAPA] / loncom / interface

Diff for /loncom/interface/loncoursedata.pm between versions 1.60 and 1.61

version 1.60, 2003/03/21 16:04:10 version 1.61, 2003/03/25 22:29:31
Line 66  and/or itself. Line 66  and/or itself.
   
 =cut  =cut
   
 # ----- DOWNLOAD INFORMATION -------------------------------------------  
   
 =pod  
   
 =item &DownloadClasslist()  
   
 Collects lastname, generation, middlename, firstname, PID, and section for each  
 student from their environment database.  The section data is also download, though  
 it is in a rough format, and is processed later.  The list of students is built from  
 collecting a classlist for the course that is to be displayed.  Once the classlist  
 has been downloaded, its date stamp is recorded.  Unless the datestamp for the  
 class database is reset or is modified, this data will not be downloaded again.    
 Also, there was talk about putting the fullname and section  
 and perhaps other pieces of data into the classlist file.  This would  
 reduce the number of different file accesses and reduce the amount of   
 processing on this side.  
   
 =over 4  
   
 Input: $courseID, $lastDownloadTime, $c  
   
 $courseID:  The id of the course  
   
 $lastDownloadTime:  This is the date stamp for when this information was  
 last gathered.  If it is set to Not downloaded, it will gather the data  
 again, though it currently does not remove the old data.  
   
 $c: The connection class that can determine if the browser has aborted.  It  
 is used to short circuit this function so that it does not continue to   
 get information when there is no need.  
   
 Output: \%classlist  
   
 \%classlist: A pointer to a hash containing the following data:  
   
 -A list of student name:domain (as keys) (known below as $name)  
   
 -A hash pointer for each student containing lastname, generation, firstname,  
 middlename, and PID : Key is $name.studentInformation  
   
 -A hash pointer to each students section data : Key is $name.section  
   
 -If there was an error in dump, it will be returned in the hash.  See  
 the error codes for dump in lonnet.  Also, an error key will be   
 generated if an abort occurs.  
   
 =back  
   
 =cut  
   
 sub DownloadClasslist {  
     my ($courseID, $lastDownloadTime, $c)=@_;  
     my ($courseDomain,$courseNumber)=split(/\_/,$courseID);  
     my %classlist;  
   
     my $modifiedTime = &Apache::lonnet::GetFileTimestamp($courseDomain,   
                                                          $courseNumber,  
                                                          'classlist.db',   
                                  $Apache::lonnet::perlvar{'lonUsersDir'});  
   
     # Always download the information if lastDownloadTime is set to  
     # Not downloaded, otherwise it is only downloaded if the file  
     # has been updated and has a more recent date stamp  
     if($lastDownloadTime ne 'Not downloaded' &&  
        $lastDownloadTime >= $modifiedTime && $modifiedTime >= 0) {  
         # Data is not gathered so return UpToDate as true.  This  
         # will be interpreted in ProcessClasslist  
         $classlist{'lastDownloadTime'}=time;  
         $classlist{'UpToDate'} = 'true';  
         return \%classlist;  
     }  
   
     %classlist=&Apache::lonnet::dump('classlist',$courseDomain, $courseNumber);  
     foreach(keys (%classlist)) {  
         if(/^(con_lost|error|no_such_host)/i) {  
     return;  
         }  
     }  
   
     foreach my $name (keys(%classlist)) {  
         if(defined($c) && ($c->aborted())) {  
             $classlist{'error'}='aborted';  
             return \%classlist;  
         }  
   
         my ($studentName,$studentDomain) = split(/\:/,$name);  
         # Download student environment data, specifically the full name and id.  
         my %studentInformation=&Apache::lonnet::get('environment',  
                                                     ['lastname','generation',  
                                                      'firstname','middlename',  
                                                      'id'],  
                                                     $studentDomain,  
                                                     $studentName);  
         $classlist{$name.':studentInformation'}=\%studentInformation;  
   
         if($c->aborted()) {  
             $classlist{'error'}='aborted';  
             return \%classlist;  
         }  
   
         #Section  
         my %section=&Apache::lonnet::dump('roles',$studentDomain,$studentName);  
         $classlist{$name.':sections'}=\%section;  
     }  
   
     $classlist{'UpToDate'} = 'false';  
     $classlist{'lastDownloadTime'}=time;  
   
     return \%classlist;  
 }  
   
 =pod  
   
 =item &DownloadCourseInformation()  
   
 Dump of all the course information for a single student.  The data can be  
 pruned by making use of dumps regular expression arguement.  This function  
 also takes a regular expression which it passes straight through to dump.    
 The data is no escaped, because it is done elsewhere.  It also  
 checks the timestamp of the students course database file and only downloads  
 if it has been modified since the last download.  
   
 =over 4  
   
 Input: $namedata, $courseID, $lastDownloadTime, $WhatIWant  
   
 $namedata: student name:domain  
   
 $courseID:  The id of the course  
   
 $lastDownloadTime:  This is the date stamp for when this information was  
 last gathered.  If it is set to Not downloaded, it will gather the data  
 again, though it currently does not remove the old data.  
   
 $WhatIWant:  Regular expression used to get selected data with dump  
   
 Output: \%courseData  
   
 \%courseData:  A hash pointer to the raw data from the students course  
 database.  
   
 =back  
   
 =cut  
   
 sub DownloadCourseInformation {  
     my ($namedata,$courseID,$lastDownloadTime,$WhatIWant)=@_;  
     my %courseData;  
     my ($name,$domain) = split(/\:/,$namedata);  
   
     my $modifiedTime = &Apache::lonnet::GetFileTimestamp($domain, $name,  
                                       $courseID.'.db',   
                                       $Apache::lonnet::perlvar{'lonUsersDir'});  
   
     if($lastDownloadTime ne 'Not downloaded' &&   
        $lastDownloadTime >= $modifiedTime && $modifiedTime >= 0) {  
         # Data is not gathered so return UpToDate as true.  This  
         # will be interpreted in ProcessClasslist  
         $courseData{$namedata.':lastDownloadTime'}=time;  
         $courseData{$namedata.':UpToDate'} = 'true';  
         return \%courseData;  
     }  
   
     # Download course data  
     if(!defined($WhatIWant)) {  
         # set the regular expression to everything by setting it to period  
         $WhatIWant = '.';  
     }  
     %courseData=&Apache::lonnet::dump($courseID, $domain, $name, $WhatIWant);  
     $courseData{'UpToDate'} = 'false';  
     $courseData{'lastDownloadTime'}=time;  
   
     my %newData;  
     foreach (keys(%courseData)) {  
         # need to have the keys to be prepended with the name:domain of the  
         # student to reduce data collision later.  
         $newData{$namedata.':'.$_} = $courseData{$_};  
     }  
   
     return \%newData;  
 }  
   
 # ----- END DOWNLOAD INFORMATION ---------------------------------------  
   
 =pod  
   
 =head1 PROCESSING FUNCTIONS  
   
 These functions process all the data for all the students.  Also, they  
 are the functions that access the cache database for writing the majority of  
 the time.  The downloading and caching were separated to reduce problems   
 with stopping downloading then can not tie hash to database later.  
   
 =cut  
   
 # ----- PROCESSING FUNCTIONS ---------------------------------------  
   
 ####################################################  ####################################################
 ####################################################  ####################################################
   
Line 277  assessment contents of each sequence in Line 80  assessment contents of each sequence in
   
 The returned structure is a hash reference.   The returned structure is a hash reference. 
   
 { title  => 'title',  { title => 'title',
   symb   => 'symb',    symb  => 'symb',
   source => '/s/o/u/r/c/e',    src   => '/s/o/u/r/c/e',
   type  => (container|assessment),    type  => (container|assessment),
   num_assess   => 2,               # only for container    num_assess   => 2,               # only for container
   parts        => [11,13,15],      # only for assessment    parts        => [11,13,15],      # only for assessment
Line 301  sub get_sequence_assessment_data { Line 104  sub get_sequence_assessment_data {
     my $fn=$ENV{'request.course.fn'};      my $fn=$ENV{'request.course.fn'};
     ##      ##
     ## use navmaps      ## use navmaps
     my $navmap = Apache::lonnavmaps::navmap->new($fn.".db",$fn."_parms.db",      my $navmap = Apache::lonnavmaps::navmap->new(Apache->request,$fn.".db",
                                                  1,0);                                                   $fn."_parms.db",1,0);
     if (!defined($navmap)) {      if (!defined($navmap)) {
         return 'Can not open Coursemap';          return 'Can not open Coursemap';
     }      }
     my $iterator = $navmap->getIterator(undef, undef, undef, 1);      my $iterator = $navmap->getIterator(undef, undef, undef, 1);
       my $curRes = $iterator->next(); # Top level sequence
     ##      ##
     ## Prime the pump       ## Prime the pump 
     ##       ## 
Line 333  sub get_sequence_assessment_data { Line 137  sub get_sequence_assessment_data {
     # We need to keep track of which sequences contain homework problems      # We need to keep track of which sequences contain homework problems
     #       # 
     my $previous;      my $previous;
     my $curRes = $iterator->next(); # BEGIN_MAP      $curRes = $iterator->next(); # BEGIN_MAP
     $curRes = $iterator->next(); # The first item in the top level map.      $curRes = $iterator->next(); # The first item in the top level map.
     while (scalar(@Nested_Sequences)) {      while (scalar(@Nested_Sequences)) {
         $previous = $curRes;          $previous = $curRes;
Line 383  sub get_sequence_assessment_data { Line 187  sub get_sequence_assessment_data {
     return ($top,\@Sequences,\@Assessments);      return ($top,\@Sequences,\@Assessments);
 }  }
   
 #################################################  
 #################################################  
   
 =pod  
   
 =item &ProcessTopResourceMap()  
   
 Trace through the "big hash" created in rat/lonuserstate.pm::loadmap.    
 Basically, this function organizes a subset of the data and stores it in  
 cached data.  The data stored is the problems, sequences, sequence titles,  
 parts of problems, and their ordering.  Column width information is also   
 partially handled here on a per sequence basis.  
   
 =over 4  
   
 Input: $cache, $c  
   
 $cache:  A pointer to a hash to store the information  
   
 $c:  The connection class used to determine if an abort has been sent to the   
 browser  
   
 Output: A string that contains an error message or "OK" if everything went   
 smoothly.  
   
 =back  
   
 =cut  
   
 sub ProcessTopResourceMap {  
     my ($cache,$c)=@_;  
     my %hash;  
     my $fn=$ENV{'request.course.fn'};  
     if(-e "$fn.db") {  
  my $tieTries=0;  
  while($tieTries < 3) {  
             if($c->aborted()) {  
                 return;  
             }  
     if(tie(%hash,'GDBM_File',"$fn.db",&GDBM_READER(),0640)) {  
  last;  
     }  
     $tieTries++;  
     sleep 1;  
  }  
  if($tieTries >= 3) {  
             return 'Coursemap undefined.';  
         }  
     } else {  
         return 'Can not open Coursemap.';  
     }  
   
     my $oldkeys;  
     delete $cache->{'OptionResponses'};  
     if(defined($cache->{'ResourceKeys'})) {  
         $oldkeys = $cache->{'ResourceKeys'};  
         foreach (split(':::', $cache->{'ResourceKeys'})) {  
             delete $cache->{$_};  
         }  
         delete $cache->{'ResourceKeys'};  
     }  
   
     # Initialize state machine.  Set information pointing to top level map.  
     my (@sequences, @currentResource, @finishResource);  
     my ($currentSequence, $currentResourceID, $lastResourceID);  
   
     $currentResourceID=$hash{'ids_'.  
       &Apache::lonnet::clutter($ENV{'request.course.uri'})};  
     push(@currentResource, $currentResourceID);  
     $lastResourceID=-1;  
     $currentSequence=-1;  
     my $topLevelSequenceNumber = $currentSequence;  
   
     my %sequenceRecord;  
     my %allkeys;  
     while(1) {  
         if($c->aborted()) {  
             last;  
         }  
  # HANDLE NEW SEQUENCE!  
  #if page || sequence  
  if(defined($hash{'map_pc_'.$hash{'src_'.$currentResourceID}}) &&  
            !defined($sequenceRecord{$currentResourceID})) {  
             $sequenceRecord{$currentResourceID}++;  
     push(@sequences, $currentSequence);  
     push(@currentResource, $currentResourceID);  
     push(@finishResource, $lastResourceID);  
   
     $currentSequence=$hash{'map_pc_'.$hash{'src_'.$currentResourceID}};  
   
             # Mark sequence as containing problems.  If it doesn't, then  
             # it will be removed when processing for this sequence is  
             # complete.  This allows the problems in a sequence  
             # to be outputed before problems in the subsequences  
             if(!defined($cache->{'orderedSequences'})) {  
                 $cache->{'orderedSequences'}=$currentSequence;  
             } else {  
                 $cache->{'orderedSequences'}.=':'.$currentSequence;  
             }  
             $allkeys{'orderedSequences'}++;  
   
     $lastResourceID=$hash{'map_finish_'.  
   $hash{'src_'.$currentResourceID}};  
     $currentResourceID=$hash{'map_start_'.  
      $hash{'src_'.$currentResourceID}};  
   
     if(!($currentResourceID) || !($lastResourceID)) {  
  $currentSequence=pop(@sequences);  
  $currentResourceID=pop(@currentResource);  
  $lastResourceID=pop(@finishResource);  
  if($currentSequence eq $topLevelSequenceNumber) {  
     last;  
  }  
     }  
             next;  
  }  
   
  # Handle gradable resources: exams, problems, etc  
  $currentResourceID=~/(\d+)\.(\d+)/;  
         my $partA=$1;  
         my $partB=$2;  
  if($hash{'src_'.$currentResourceID}=~  
    /\.(problem|exam|quiz|assess|survey|form)$/ &&  
    $partA eq $currentSequence &&   
            !defined($sequenceRecord{$currentSequence.':'.  
                                     $currentResourceID})) {  
             $sequenceRecord{$currentSequence.':'.$currentResourceID}++;  
     my $Problem = &Apache::lonnet::symbclean(  
   &Apache::lonnet::declutter($hash{'map_id_'.$partA}).  
   '___'.$partB.'___'.  
   &Apache::lonnet::declutter($hash{'src_'.  
  $currentResourceID}));  
   
     $cache->{$currentResourceID.':problem'}=$Problem;  
             $allkeys{$currentResourceID.':problem'}++;  
     if(!defined($cache->{$currentSequence.':problems'})) {  
  $cache->{$currentSequence.':problems'}=$currentResourceID;  
     } else {  
  $cache->{$currentSequence.':problems'}.=  
     ':'.$currentResourceID;  
     }  
             $allkeys{$currentSequence.':problems'}++;  
   
     my $meta=$hash{'src_'.$currentResourceID};  
 #            $cache->{$currentResourceID.':title'}=  
 #                &Apache::lonnet::metdata($meta,'title');  
             $cache->{$currentResourceID.':title'}=  
                 $hash{'title_'.$currentResourceID};  
             $allkeys{$currentResourceID.':title'}++;  
             $cache->{$currentResourceID.':source'}=  
                 $hash{'src_'.$currentResourceID};  
             $allkeys{$currentResourceID.':source'}++;  
   
             # Get Parts for problem  
             my %beenHere;  
             foreach (split(/\,/,&Apache::lonnet::metadata($meta,'packages'))) {  
                 if(/^\w+response_\d+.*/) {  
                     my (undef, $partId, $responseId) = split(/_/,$_);  
                     if($beenHere{'p:'.$partId} ==  0) {  
                         $beenHere{'p:'.$partId}++;  
                         if(!defined($cache->{$currentSequence.':'.  
                                             $currentResourceID.':parts'})) {  
                             $cache->{$currentSequence.':'.$currentResourceID.  
                                      ':parts'}=$partId;  
                         } else {  
                             $cache->{$currentSequence.':'.$currentResourceID.  
                                      ':parts'}.=':'.$partId;  
                         }  
                         $allkeys{$currentSequence.':'.$currentResourceID.  
                                   ':parts'}++;  
                     }  
                     if($beenHere{'r:'.$partId.':'.$responseId} == 0) {  
                         $beenHere{'r:'.$partId.':'.$responseId}++;  
                         if(!defined($cache->{$currentSequence.':'.  
                                              $currentResourceID.':'.$partId.  
                                              ':responseIDs'})) {  
                             $cache->{$currentSequence.':'.$currentResourceID.  
                                      ':'.$partId.':responseIDs'}=$responseId;  
                         } else {  
                             $cache->{$currentSequence.':'.$currentResourceID.  
                                      ':'.$partId.':responseIDs'}.=':'.  
                                                                   $responseId;  
                         }  
                         $allkeys{$currentSequence.':'.$currentResourceID.':'.  
                                      $partId.':responseIDs'}++;  
                     }  
                     if(/^optionresponse/ &&   
                        $beenHere{'o:'.$partId.':'.$currentResourceID} == 0) {  
                         $beenHere{'o:'.$partId.$currentResourceID}++;  
                         if(defined($cache->{'OptionResponses'})) {  
                             $cache->{'OptionResponses'}.= ':::'.  
                                 $currentSequence.':'.$currentResourceID.':'.  
                                 $partId.':'.$responseId;  
                         } else {  
                             $cache->{'OptionResponses'}= $currentSequence.':'.  
                                 $currentResourceID.':'.  
                                 $partId.':'.$responseId;  
                         }  
                         $allkeys{'OptionResponses'}++;  
                     }  
                 }  
             }  
         }  
   
  # if resource == finish resource, then it is the end of a sequence/page  
  if($currentResourceID eq $lastResourceID) {  
     # pop off last resource of sequence  
     $currentResourceID=pop(@currentResource);  
     $lastResourceID=pop(@finishResource);  
   
     if(defined($cache->{$currentSequence.':problems'})) {  
  # Capture sequence information here  
  $cache->{$currentSequence.':title'}=  
     $hash{'title_'.$currentResourceID};  
                 $allkeys{$currentSequence.':title'}++;  
                 $cache->{$currentSequence.':source'}=  
                     $hash{'src_'.$currentResourceID};  
                 $allkeys{$currentSequence.':source'}++;  
   
                 my $totalProblems=0;  
                 foreach my $currentProblem (split(/\:/,  
                                                $cache->{$currentSequence.  
                                                ':problems'})) {  
                     foreach (split(/\:/,$cache->{$currentSequence.':'.  
                                                    $currentProblem.  
                                                    ':parts'})) {  
                         $totalProblems++;  
                     }  
                 }  
  my @titleLength=split(//,$cache->{$currentSequence.  
                                                     ':title'});  
                 # $extra is 5 for problems correct and 3 for space  
                 # between problems correct and problem output  
                 my $extra = 8;  
  if(($totalProblems + $extra) > (scalar @titleLength)) {  
     $cache->{$currentSequence.':columnWidth'}=  
                         $totalProblems + $extra;  
  } else {  
     $cache->{$currentSequence.':columnWidth'}=  
                         (scalar @titleLength);  
  }  
                 $allkeys{$currentSequence.':columnWidth'}++;  
     } else {  
                 # Remove sequence from list, if it contains no problems to  
                 # display.  
                 $cache->{'orderedSequences'}=~s/$currentSequence//;  
                 $cache->{'orderedSequences'}=~s/::/:/g;  
                 $cache->{'orderedSequences'}=~s/^:|:$//g;  
             }  
   
     $currentSequence=pop(@sequences);  
     if($currentSequence eq $topLevelSequenceNumber) {  
  last;  
     }  
         }  
   
  # MOVE!!!  
  # move to next resource  
  unless(defined($hash{'to_'.$currentResourceID})) {  
     # big problem, need to handle.  Next is probably wrong  
             my $errorMessage = 'Big problem in ';  
             $errorMessage .= 'loncoursedata::ProcessTopLevelMap.';  
             $errorMessage .= "  bighash to_$currentResourceID not defined!";  
             &Apache::lonnet::logthis($errorMessage);  
     if (!defined($currentResourceID)) {last;}  
  }  
  my @nextResources=();  
  foreach (split(/\,/,$hash{'to_'.$currentResourceID})) {  
             if(!defined($sequenceRecord{$currentSequence.':'.  
                                         $hash{'goesto_'.$_}})) {  
                 push(@nextResources, $hash{'goesto_'.$_});  
             }  
  }  
  push(@currentResource, @nextResources);  
  # Set the next resource to be processed  
  $currentResourceID=pop(@currentResource);  
     }  
   
     my @theKeys = keys(%allkeys);  
     my $newkeys = join(':::', @theKeys);  
     $cache->{'ResourceKeys'} = join(':::', $newkeys);  
     if($newkeys ne $oldkeys) {  
         $cache->{'ResourceUpdated'} = 'true';  
     } else {  
         $cache->{'ResourceUpdated'} = 'false';  
     }  
   
     unless (untie(%hash)) {  
         &Apache::lonnet::logthis("<font color=blue>WARNING: ".  
                                  "Could not untie coursemap $fn (browse)".  
                                  ".</font>");   
     }  
   
     return 'OK';  
 }  
   
 =pod  
   
 =item &ProcessClasslist()  
   
 Taking the class list dumped from &DownloadClasslist(), all the   
 students and their non-class information is processed using the   
 &ProcessStudentInformation() function.  A date stamp is also recorded for  
 when the data was processed.  
   
 Takes data downloaded for a student and breaks it up into managable pieces and   
 stored in cache data.  The username, domain, class related date, PID,   
 full name, and section are all processed here.  
   
 =over 4  
   
 Input: $cache, $classlist, $courseID, $ChartDB, $c  
   
 $cache: A hash pointer to store the data  
   
 $classlist:  The hash of data collected about a student from   
 &DownloadClasslist().  The hash contains a list of students, a pointer   
 to a hash of student information for each student, and each students section   
 number.  
   
 $courseID:  The course ID  
   
 $ChartDB:  The name of the cache database file.  
   
 $c:  The connection class used to determine if an abort has been sent to the   
 browser  
   
 Output: @names  
   
 @names:  An array of students whose information has been processed, and are to   
 be considered in an arbitrary order.  The entries in @names are of the form  
 username:domain.  
   
 The values in $cache are as follows:  
   
  *NOTE: for the following $name implies username:domain  
  $name.':error'                  only defined if an error occured.  Value  
                                  contains the error message  
  $name.':lastDownloadTime'       unconverted time of the last update of a  
                                  student\'s course data  
  $name.'updateTime'              coverted time of the last update of a   
                                  student\'s course data  
  $name.':username'               username of a student  
  $name.':domain'                 domain of a student  
  $name.':fullname'               full name of a student  
  $name.':id'                     PID of a student  
  $name.':Status'                 active/expired status of a student  
  $name.':section'                section of a student  
   
 =back  
   
 =cut  
   
 sub ProcessClasslist {  
     my ($cache,$classlist,$courseID,$c)=@_;  
     my @names=();  
   
     $cache->{'ClasslistTimeStamp'}=$classlist->{'lastDownloadTime'};  
     if($classlist->{'UpToDate'} eq 'true') {  
         return split(/:::/,$cache->{'NamesOfStudents'});;  
     }  
   
     foreach my $name (keys(%$classlist)) {  
         if($name =~ /\:section/ || $name =~ /\:studentInformation/ ||  
            $name eq '' || $name eq 'UpToDate' || $name eq 'lastDownloadTime') {  
             next;  
         }  
         if($c->aborted()) {  
             return ();  
         }  
         my $studentInformation = $classlist->{$name.':studentInformation'};  
         my $date = $classlist->{$name};  
         my ($studentName,$studentDomain) = split(/\:/,$name);  
   
         $cache->{$name.':username'}=$studentName;  
         $cache->{$name.':domain'}=$studentDomain;  
         # Initialize timestamp for student  
         if(!defined($cache->{$name.':lastDownloadTime'})) {  
             $cache->{$name.':lastDownloadTime'}='Not downloaded';  
             $cache->{$name.':updateTime'}=' Not updated';  
         }  
   
         my $error = 0;  
         foreach(keys(%$studentInformation)) {  
             if(/^(con_lost|error|no_such_host)/i) {  
                 $cache->{$name.':error'}=  
                     'Could not download student environment data.';  
                 $cache->{$name.':fullname'}='';  
                 $cache->{$name.':id'}='';  
                 $error = 1;  
             }  
         }  
         next if($error);  
         push(@names,$name);  
         $cache->{$name.':fullname'}=&ProcessFullName(  
                                           $studentInformation->{'lastname'},  
                                           $studentInformation->{'generation'},  
                                           $studentInformation->{'firstname'},  
                                           $studentInformation->{'middlename'});  
         $cache->{$name.':id'}=$studentInformation->{'id'};  
   
         my ($end, $start)=split(':',$date);  
         $courseID=~s/\_/\//g;  
         $courseID=~s/^(\w)/\/$1/;  
   
         my $sec='';  
         my $sectionData = $classlist->{$name.':sections'};  
         foreach my $key (keys (%$sectionData)) {  
             my $value = $sectionData->{$key};  
             if ($key=~/^$courseID(?:\/)*(\w+)*\_st$/) {  
                 my $tempsection=$1;  
                 if($key eq $courseID.'_st') {  
                     $tempsection='';  
                 }  
                 my (undef,$roleend,$rolestart)=split(/\_/,$value);  
                 if($roleend eq $end && $rolestart eq $start) {  
                     $sec = $tempsection;  
                     last;  
                 }  
             }  
         }  
   
         my $status='Expired';  
         if(((!$end) || time < $end) && ((!$start) || (time > $start))) {  
             $status='Active';  
         }  
         $cache->{$name.':Status'}=$status;  
         $cache->{$name.':section'}=$sec;  
   
         if($sec eq '' || !defined($sec) || $sec eq ' ') {  
             $sec = 'none';  
         }  
         if(defined($cache->{'sectionList'})) {  
             if($cache->{'sectionList'} !~ /(^$sec:|^$sec$|:$sec$|:$sec:)/) {  
                 $cache->{'sectionList'} .= ':'.$sec;  
             }  
         } else {  
             $cache->{'sectionList'} = $sec;  
         }  
     }  
   
     $cache->{'ClasslistTimestamp'}=time;  
     $cache->{'NamesOfStudents'}=join(':::',@names);  
   
     return @names;  
 }  
   
 =pod  
   
 =item &ProcessStudentData()  
   
 Takes the course data downloaded for a student in   
 &DownloadCourseInformation() and breaks it up into key value pairs  
 to be stored in the cached data.  The keys are comprised of the   
 $username:$domain:$keyFromCourseDatabase.  The student username:domain is  
 stored away signifying that the students information has been downloaded and   
 can be reused from cached data.  
   
 =over 4  
   
 Input: $cache, $courseData, $name  
   
 $cache: A hash pointer to store data  
   
 $courseData:  A hash pointer that points to the course data downloaded for a   
 student.  
   
 $name:  username:domain  
   
 Output: None  
   
 *NOTE:  There is no output, but an error message is stored away in the cache   
 data.  This is checked in &FormatStudentData().  The key username:domain:error   
 will only exist if an error occured.  The error is an error from   
 &DownloadCourseInformation().  
   
 =back  
   
 =cut  
   
 sub ProcessStudentData {  
     my ($cache,$courseData,$name)=@_;  
   
     if(!&CheckDateStampError($courseData, $cache, $name)) {  
         return;  
     }  
   
     # This little delete thing, should not be here.  Move some other  
     # time though.  
     if(defined($cache->{$name.':keys'})) {  
  foreach (split(':::', $cache->{$name.':keys'})) {  
     delete $cache->{$name.':'.$_};  
  }  
         delete $cache->{$name.':keys'};  
     }  
   
     my %courseKeys;  
     # user name:domain was prepended earlier in DownloadCourseInformation  
     foreach (keys %$courseData) {  
  my $currentKey = $_;  
  $currentKey =~ s/^$name//;  
  $courseKeys{$currentKey}++;  
         $cache->{$_}=$courseData->{$_};  
     }  
   
     $cache->{$name.':keys'} = join(':::', keys(%courseKeys));  
   
     return;  
 }  
   
 =pod  
   
 =item &ExtractStudentData()  
   
 HISTORY: This function originally existed in every statistics module,  
 and performed different tasks, the had some overlap.  Due to the need  
 for the data from the different modules, they were combined into  
 a single function.  
   
 This function now extracts all the necessary course data for a student  
 from what was downloaded from their homeserver.  There is some extra  
 time overhead compared to the ProcessStudentInformation function, but  
 it would have had to occurred at some point anyways.  This is now  
 typically called while downloading the data it will process.  It is  
 the brother function to ProcessStudentInformation.  
   
 =over 4  
   
 Input: $input, $output, $data, $name  
   
 $input: A hash that contains the input data to be processed  
   
 $output: A hash to contain the processed data  
   
 $data: A hash containing the information on what is to be  
 processed and how (basically).  
   
 $name:  username:domain  
   
 The input is slightly different here, but is quite simple.  
 It is currently used where the $input, $output, and $data  
 can and are often the same hashes, but they do not need  
 to be.  
   
 Output: None  
   
 *NOTE:  There is no output, but an error message is stored away in the cache   
 data.  This is checked in &FormatStudentData().  The key username:domain:error   
 will only exist if an error occured.  The error is an error from   
 &DownloadCourseInformation().  
   
 =back  
   
 =cut  
   
 sub ExtractStudentData {  
     my ($input, $output, $data, $name)=@_;  
   
     if(!&CheckDateStampError($input, $data, $name)) {  
         return;  
     }  
   
     # This little delete thing, should not be here.  Move some other  
     # time though.  
     my %allkeys;  
     if(defined($output->{$name.':keys'})) {  
  foreach (split(':::', $output->{$name.':keys'})) {  
     delete $output->{$name.':'.$_};  
  }  
         delete $output->{$name.':keys'};  
     }  
   
     my ($username,$domain)=split(':',$name);  
   
     my $Version;  
     my $problemsCorrect = 0;  
     my $totalProblems   = 0;  
     my $problemsSolved  = 0;  
     my $numberOfParts   = 0;  
     my $totalAwarded    = 0;  
     foreach my $sequence (split(':', $data->{'orderedSequences'})) {  
         foreach my $problemID (split(':', $data->{$sequence.':problems'})) {  
             my $problem = $data->{$problemID.':problem'};  
             my $LatestVersion = $input->{$name.':version:'.$problem};  
   
             # Output dashes for all the parts of this problem if there  
             # is no version information about the current problem.  
             $output->{$name.':'.$problemID.':NoVersion'} = 'false';  
             $allkeys{$name.':'.$problemID.':NoVersion'}++;  
             if(!$LatestVersion) {  
                 foreach my $part (split(/\:/,$data->{$sequence.':'.  
                                                       $problemID.  
                                                       ':parts'})) {  
                     $output->{$name.':'.$problemID.':'.$part.':tries'} = 0;  
                     $output->{$name.':'.$problemID.':'.$part.':awarded'} = 0;  
                     $output->{$name.':'.$problemID.':'.$part.':code'} = ' ';  
     $allkeys{$name.':'.$problemID.':'.$part.':tries'}++;  
     $allkeys{$name.':'.$problemID.':'.$part.':awarded'}++;  
     $allkeys{$name.':'.$problemID.':'.$part.':code'}++;  
                     $totalProblems++;  
                 }  
                 $output->{$name.':'.$problemID.':NoVersion'} = 'true';  
                 next;  
             }  
   
             my %partData=undef;  
             # Initialize part data, display skips correctly  
             # Skip refers to when a student made no submissions on that  
             # part/problem.  
             foreach my $part (split(/\:/,$data->{$sequence.':'.  
                                                  $problemID.  
                                                  ':parts'})) {  
                 $partData{$part.':tries'}=0;  
                 $partData{$part.':code'}=' ';  
                 $partData{$part.':awarded'}=0;  
                 $partData{$part.':timestamp'}=0;  
                 foreach my $response (split(':', $data->{$sequence.':'.  
                                                          $problemID.':'.  
                                                          $part.':responseIDs'})) {  
                     $partData{$part.':'.$response.':submission'}='';  
                 }  
             }  
   
             # Looping through all the versions of each part, starting with the  
             # oldest version.  Basically, it gets the most recent   
             # set of grade data for each part.  
             my @submissions = ();  
     for(my $Version=1; $Version<=$LatestVersion; $Version++) {  
                 foreach my $part (split(/\:/,$data->{$sequence.':'.  
                                                      $problemID.  
                                                      ':parts'})) {  
   
                     if(!defined($input->{"$name:$Version:$problem".  
                                          ":resource.$part.solved"})) {  
                         # No grade for this submission, so skip  
                         next;  
                     }  
   
                     my $tries=0;  
                     my $code=' ';  
                     my $awarded=0;  
   
                     $tries = $input->{$name.':'.$Version.':'.$problem.  
                                       ':resource.'.$part.'.tries'};  
                     $awarded = $input->{$name.':'.$Version.':'.$problem.  
                                         ':resource.'.$part.'.awarded'};  
   
                     $partData{$part.':awarded'}=($awarded) ? $awarded : 0;  
                     $partData{$part.':tries'}=($tries) ? $tries : 0;  
   
                     $partData{$part.':timestamp'}=$input->{$name.':'.$Version.':'.  
                                                            $problem.  
                                                            ':timestamp'};  
                     if(!$input->{$name.':'.$Version.':'.$problem.':resource.'.$part.  
                                  '.previous'}) {  
                         foreach my $response (split(':',  
                                                    $data->{$sequence.':'.  
                                                            $problemID.':'.  
                                                            $part.':responseIDs'})) {  
                             @submissions=($input->{$name.':'.$Version.':'.  
                                                    $problem.  
                                                    ':resource.'.$part.'.'.  
                                                    $response.'.submission'},  
                                           @submissions);  
                         }  
                     }  
   
                     my $val = $input->{$name.':'.$Version.':'.$problem.  
                                        ':resource.'.$part.'.solved'};  
                     if    ($val eq 'correct_by_student')   {$code = '*';}   
                     elsif ($val eq 'correct_by_override')  {$code = '+';}  
                     elsif ($val eq 'incorrect_attempted')  {$code = '.';}   
                     elsif ($val eq 'incorrect_by_override'){$code = '-';}  
                     elsif ($val eq 'excused')              {$code = 'x';}  
                     elsif ($val eq 'ungraded_attempted')   {$code = '#';}  
                     else                                   {$code = ' ';}  
                     $partData{$part.':code'}=$code;  
                 }  
             }  
   
             foreach my $part (split(/\:/,$data->{$sequence.':'.$problemID.  
                                                  ':parts'})) {  
                 $output->{$name.':'.$problemID.':'.$part.':wrong'} =   
                     $partData{$part.':tries'};  
  $allkeys{$name.':'.$problemID.':'.$part.':wrong'}++;  
   
                 if($partData{$part.':code'} eq '*') {  
                     $output->{$name.':'.$problemID.':'.$part.':wrong'}--;  
                     $problemsCorrect++;  
                 } elsif($partData{$part.':code'} eq '+') {  
                     $output->{$name.':'.$problemID.':'.$part.':wrong'}--;  
                     $problemsCorrect++;  
                 }  
   
                 $output->{$name.':'.$problemID.':'.$part.':tries'} =   
                     $partData{$part.':tries'};  
                 $output->{$name.':'.$problemID.':'.$part.':code'} =  
                     $partData{$part.':code'};  
                 $output->{$name.':'.$problemID.':'.$part.':awarded'} =  
                     $partData{$part.':awarded'};  
  $allkeys{$name.':'.$problemID.':'.$part.':tries'}++;  
  $allkeys{$name.':'.$problemID.':'.$part.':code'}++;  
  $allkeys{$name.':'.$problemID.':'.$part.':awarded'}++;  
   
                 $totalAwarded += $partData{$part.':awarded'};  
                 $output->{$name.':'.$problemID.':'.$part.':timestamp'} =  
                     $partData{$part.':timestamp'};  
  $allkeys{$name.':'.$problemID.':'.$part.':timestamp'}++;  
   
                 foreach my $response (split(':', $data->{$sequence.':'.  
                                                          $problemID.':'.  
                                                          $part.':responseIDs'})) {  
                     $output->{$name.':'.$problemID.':'.$part.':'.$response.  
                               ':submission'}=join(':::',@submissions);  
     $allkeys{$name.':'.$problemID.':'.$part.':'.$response.  
      ':submission'}++;  
                 }  
   
                 if($partData{$part.':code'} ne 'x') {  
                     $totalProblems++;  
                 }  
             }  
         }  
   
         $output->{$name.':'.$sequence.':problemsCorrect'} = $problemsCorrect;  
  $allkeys{$name.':'.$sequence.':problemsCorrect'}++;  
         $problemsSolved += $problemsCorrect;  
  $problemsCorrect=0;  
     }  
   
     $output->{$name.':problemsSolved'} = $problemsSolved;  
     $output->{$name.':totalProblems'} = $totalProblems;  
     $output->{$name.':totalAwarded'} = $totalAwarded;  
     $allkeys{$name.':problemsSolved'}++;  
     $allkeys{$name.':totalProblems'}++;  
     $allkeys{$name.':totalAwarded'}++;  
   
     $output->{$name.':keys'} = join(':::', keys(%allkeys));  
   
     return;  
 }  
   
 sub LoadDiscussion {  sub LoadDiscussion {
     my ($courseID)=@_;      my ($courseID)=@_;
     my %Discuss=();      my %Discuss=();
Line 1149  sub LoadDiscussion { Line 211  sub LoadDiscussion {
     return \%Discuss;      return \%Discuss;
 }  }
   
 # ----- END PROCESSING FUNCTIONS ---------------------------------------  
   
 =pod  
   
 =head1 HELPER FUNCTIONS  
   
 These are just a couple of functions do various odd and end   
 jobs.  There was also a couple of bulk functions added.  These are  
 &DownloadStudentCourseData(), &DownloadStudentCourseDataSeparate(), and  
 &CheckForResidualDownload().  These functions now act as the interface  
 for downloading student course data.  The statistical modules should  
 no longer make the calls to dump and download and process etc.  They  
 make calls to these bulk functions to get their data.  
   
 =cut  
   
 # ----- HELPER FUNCTIONS -----------------------------------------------  
   
 sub CheckDateStampError {  
     my ($courseData, $cache, $name)=@_;  
     if($courseData->{$name.':UpToDate'} eq 'true') {  
         $cache->{$name.':lastDownloadTime'} =   
             $courseData->{$name.':lastDownloadTime'};  
         if($courseData->{$name.':lastDownloadTime'} eq 'Not downloaded') {  
             $cache->{$name.':updateTime'} = ' Not updated';  
         } else {  
             $cache->{$name.':updateTime'}=  
                 localtime($courseData->{$name.':lastDownloadTime'});  
         }  
         return 0;  
     }  
   
     $cache->{$name.':lastDownloadTime'}=$courseData->{$name.':lastDownloadTime'};  
     if($courseData->{$name.':lastDownloadTime'} eq 'Not downloaded') {  
         $cache->{$name.':updateTime'} = ' Not updated';  
     } else {  
         $cache->{$name.':updateTime'}=  
             localtime($courseData->{$name.':lastDownloadTime'});  
     }  
   
     if(defined($courseData->{$name.':error'})) {  
         $cache->{$name.':error'}=$courseData->{$name.':error'};  
         return 0;  
     }  
   
     return 1;  
 }  
   
 =pod  =pod
   
 =item &ProcessFullName()  =item &ProcessFullName()
Line 1232  sub ProcessFullName { Line 246  sub ProcessFullName {
     return $Str;      return $Str;
 }  }
   
 =pod  
   
 =item &TestCacheData()  
   
 Determine if the cache database can be accessed with a tie.  It waits up to  
 ten seconds before returning failure.  This function exists to help with  
 the problems with stopping the data download.  When an abort occurs and the  
 user quickly presses a form button and httpd child is created.  This  
 child needs to wait for the other to finish (hopefully within ten seconds).  
   
 =over 4  
   
 Input: $ChartDB  
   
 $ChartDB: The name of the cache database to be opened  
   
 Output: -1, 0, 1  
   
 -1: Could not tie database  
  0: Use cached data  
  1: New cache database created, use that.  
   
 =back  
   
 =cut  
   
 sub TestCacheData {  
     my ($ChartDB,$isRecalculate,$totalDelay)=@_;  
     my $isCached=-1;  
     my %testData;  
     my $tieTries=0;  
   
     if(!defined($totalDelay)) {  
         $totalDelay = 10;  
     }  
   
     if ((-e "$ChartDB") && (!$isRecalculate)) {  
  $isCached = 1;  
     } else {  
  $isCached = 0;  
     }  
   
     while($tieTries < $totalDelay) {  
         my $result=0;  
         if($isCached) {  
             $result=tie(%testData,'GDBM_File',$ChartDB,&GDBM_READER(),0640);  
         } else {  
             $result=tie(%testData,'GDBM_File',$ChartDB,&GDBM_NEWDB(),0640);  
         }  
         if($result) {  
             last;  
         }  
         $tieTries++;  
         sleep 1;  
     }  
     if($tieTries >= $totalDelay) {  
         return -1;  
     }  
   
     untie(%testData);  
   
     return $isCached;  
 }  
   
 sub DownloadStudentCourseData {  
     my ($students,$checkDate,$cacheDB,$extract,$status,$courseID,$r,$c)=@_;  
   
     my $title = 'LON-CAPA Statistics';  
     my $heading = 'Download and Process Course Data';  
     my $studentCount = scalar(@$students);  
   
     my $WhatIWant;  
     $WhatIWant = '(^version:|';  
     $WhatIWant .= '^\d+:.+?:(resource\.\d+\.';  
     $WhatIWant .= '(solved|tries|previous|awarded|(\d+\.submission))\s*$';#'  
     $WhatIWant .= '|timestamp)';  
     $WhatIWant .= ')';  
 #    $WhatIWant = '.';  
   
     my %prog_state;  
     if($status eq 'true') {  
         %prog_state=&Apache::lonhtmlcommon::Create_PrgWin($r, $title,  
        $heading,($#$students)+1);  
     }  
   
     foreach (@$students) {  
         my %cache;  
   
         if($c->aborted()) { return 'Aborted'; }  
   
         if($status eq 'true') {  
             &Apache::lonhtmlcommon::Increment_PrgWin($r,\%prog_state,  
   'last student '.$_);  
         }  
   
         my $downloadTime='Not downloaded';  
         my $needUpdate = 'false';  
         if($checkDate eq 'true'  &&   
            tie(%cache,'GDBM_File',$cacheDB,&GDBM_READER(),0640)) {  
             $downloadTime = $cache{$_.':lastDownloadTime'};  
             $needUpdate = $cache{'ResourceUpdated'};  
             untie(%cache);  
         }  
   
         if($c->aborted()) { return 'Aborted'; }  
   
         if($needUpdate eq 'true') {  
             $downloadTime = 'Not downloaded';  
  }  
  my $courseData =   
     &DownloadCourseInformation($_, $courseID, $downloadTime,   
        $WhatIWant);  
  if(tie(%cache,'GDBM_File',$cacheDB,&GDBM_WRCREAT(),0640)) {  
     foreach my $key (keys(%$courseData)) {  
  if($key =~ /^(con_lost|error|no_such_host)/i) {  
     $courseData->{$_.':error'} = 'No course data for '.$_;  
     last;  
  }  
     }  
     if($extract eq 'true') {  
  &ExtractStudentData($courseData, \%cache, \%cache, $_);  
     } else {  
  &ProcessStudentData(\%cache, $courseData, $_);  
     }  
     untie(%cache);  
  } else {  
     next;  
  }  
     }  
     if($status eq 'true') { &Apache::lonhtmlcommon::Close_PrgWin($r,\%prog_state); }  
   
     return 'OK';  
 }  
   
 sub DownloadStudentCourseDataSeparate {  
     my ($students,$checkDate,$cacheDB,$extract,$status,$courseID,$r,$c)=@_;  
     my $residualFile = $Apache::lonnet::tmpdir.$courseID.'DownloadFile.db';  
     my $title = 'LON-CAPA Statistics';  
     my $heading = 'Download Course Data';  
   
     my $WhatIWant;  
     $WhatIWant = '(^version:|';  
     $WhatIWant .= '^\d+:.+?:(resource\.\d+\.';  
     $WhatIWant .= '(solved|tries|previous|awarded|(\d+\.submission))\s*$';#'  
     $WhatIWant .= '|timestamp)';  
     $WhatIWant .= ')';  
   
     &CheckForResidualDownload($cacheDB, 'true', 'true', $courseID, $r, $c);  
   
     my $studentCount = scalar(@$students);  
     my %prog_state;  
     if($status eq 'true') {  
         %prog_state=&Apache::lonhtmlcommon::Create_PrgWin($r, $title,  
      $heading,($#$students)+1);  
     }  
     my $displayString='';  
     foreach (@$students) {  
         if($c->aborted()) {  
             return 'Aborted';  
         }  
   
         if($status eq 'true') {  
             &Apache::lonhtmlcommon::Increment_PrgWin($r,\%prog_state,  
   'last student '.$_);  
         }  
   
         my %cache;  
         my $downloadTime='Not downloaded';  
         my $needUpdate = 'false';  
         if($checkDate eq 'true'  &&   
            tie(%cache,'GDBM_File',$cacheDB,&GDBM_READER(),0640)) {  
             $downloadTime = $cache{$_.':lastDownloadTime'};  
             $needUpdate = $cache{'ResourceUpdated'};  
             untie(%cache);  
         }  
   
         if($c->aborted()) {  
             return 'Aborted';  
         }  
   
         if($needUpdate eq 'true') {  
             $downloadTime = 'Not downloaded';  
  }  
   
         my $error = 0;  
         my $courseData =   
             &DownloadCourseInformation($_, $courseID, $downloadTime,  
                                        $WhatIWant);  
         my %downloadData;  
         unless(tie(%downloadData,'GDBM_File',$residualFile,  
                    &GDBM_WRCREAT(),0640)) {  
             return 'Failed to tie temporary download hash.';  
         }  
         foreach my $key (keys(%$courseData)) {  
             $downloadData{$key} = $courseData->{$key};  
             if($key =~ /^(con_lost|error|no_such_host)/i) {  
                 $error = 1;  
                 last;  
             }  
         }  
         if($error) {  
             foreach my $deleteKey (keys(%$courseData)) {  
                 delete $downloadData{$deleteKey};  
             }  
             $downloadData{$_.':error'} = 'No course data for '.$_;  
         }  
         untie(%downloadData);  
     }  
     if($status eq 'true') { &Apache::lonhtmlcommon::Close_PrgWin($r,  
   \%prog_state); }  
   
     return &CheckForResidualDownload($cacheDB, 'true', 'true',   
                                      $courseID, $r, $c);  
 }  
   
 sub CheckForResidualDownload {  
     my ($cacheDB,$extract,$status,$courseID,$r,$c)=@_;  
   
     my $residualFile = $Apache::lonnet::tmpdir.$courseID.'DownloadFile.db';  
     if(!-e $residualFile) {  
         return 'OK';  
     }  
   
     my %downloadData;  
     my %cache;  
     unless(tie(%downloadData,'GDBM_File',$residualFile,&GDBM_READER(),0640)) {  
         return 'Can not tie database for check for residual download: tempDB';  
     }  
     unless(tie(%cache,'GDBM_File',$cacheDB,&GDBM_WRCREAT(),0640)) {  
         untie(%downloadData);  
         return 'Can not tie database for check for residual download: cacheDB';  
     }  
   
     my @students=();  
     my %checkStudent;  
     my $key;  
     while(($key, undef) = each %downloadData) {  
         my @temp = split(':', $key);  
         my $student = $temp[0].':'.$temp[1];  
         if(!defined($checkStudent{$student})) {  
             $checkStudent{$student}++;  
             push(@students, $student);  
         }  
     }  
   
     my $heading = 'Process Course Data';  
     my $title = 'LON-CAPA Statistics';  
     my $studentCount = scalar(@students);  
     my %prog_state;  
     if($status eq 'true') {  
         %prog_state=&Apache::lonhtmlcommon::Create_PrgWin($r, $title,  
       $heading,$#students+1);  
     }  
   
     my $count=1;  
     foreach my $name (@students) {  
         last if($c->aborted());  
   
         if($status eq 'true') {  
     &Apache::lonhtmlcommon::Increment_PrgWin($r,\%prog_state,  
      'last student '.$name);  
         }  
   
         if($extract eq 'true') {  
             &ExtractStudentData(\%downloadData, \%cache, \%cache, $name);  
         } else {  
             &ProcessStudentData(\%cache, \%downloadData, $name);  
         }  
         $count++;  
     }  
   
     if($status eq 'true') { &Apache::lonhtmlcommon::Close_PrgWin($r,  
    \%prog_state); }  
   
     untie(%cache);  
     untie(%downloadData);  
   
     if(!$c->aborted()) {  
         my @files = ($residualFile);  
         unlink(@files);  
     }  
   
     return 'OK';  
 }  
   
   
 ################################################  ################################################
 ################################################  ################################################
   
Line 1677  my $parameters_table; Line 405  my $parameters_table;
   
 =pod  =pod
   
 =item &setup_table_names()  
   
 input: course id  
   
 output: none  
   
 Sets the package variables for the MySQL table names:  
   
 =over 4  
   
 =item $symb_table  
   
 =item $part_table  
   
 =item $student_table  
   
 =item $updatetime_table  
   
 =item $performance_table  
   
 =item $parameters_table  
   
 =back  
   
 =cut  
   
 ################################################  
 ################################################  
 sub setup_table_names {  
     my $courseid = shift;  
     if (! defined($courseid)) {  
         $courseid = $ENV{'request.course.id'};  
     }  
     #  
     # Set up database names  
     my $base_id = $courseid;  
     $symb_table        = $base_id.'_'.'symb';  
     $part_table        = $base_id.'_'.'part';  
     $student_table     = $base_id.'_'.'student';  
     $updatetime_table  = $base_id.'_'.'updatetime';  
     $performance_table = $base_id.'_'.'performance';  
     $parameters_table  = $base_id.'_'.'parameters';  
     return;  
 }  
   
 ################################################  
 ################################################  
   
 =pod  
   
 =item &init_dbs()  =item &init_dbs()
   
 Input: course id  Input: course id
Line 1926  Output: undef on error, $part string on Line 604  Output: undef on error, $part string on
 ################################################  ################################################
 ################################################  ################################################
   
   my $have_read_part_table = 0;
 my %ids_by_part;  my %ids_by_part;
 my %parts_by_id;  my %parts_by_id;
   
 sub get_part_id {  sub get_part_id {
     my ($part) = @_;      my ($part) = @_;
       $part = 0 if (! defined($part));
       if (! $have_read_part_table) {
           my @Result = &Apache::lonmysql::get_rows($part_table);
           foreach (@Result) {
               $ids_by_part{$_->[1]}=$_->[0];
           }
           $have_read_part_table = 1;
       }
     if (! exists($ids_by_part{$part})) {      if (! exists($ids_by_part{$part})) {
         &Apache::lonmysql::store_row($part_table,[undef,$part]);          &Apache::lonmysql::store_row($part_table,[undef,$part]);
         undef(%ids_by_part);          undef(%ids_by_part);
Line 1983  Output: undef on error, $symb on success Line 670  Output: undef on error, $symb on success
 ################################################  ################################################
 ################################################  ################################################
   
   my $have_read_symb_table = 0;
 my %ids_by_symb;  my %ids_by_symb;
 my %symbs_by_id;  my %symbs_by_id;
   
 sub get_symb_id {  sub get_symb_id {
     my ($symb) = @_;      my ($symb) = @_;
       if (! $have_read_symb_table) {
           my @Result = &Apache::lonmysql::get_rows($symb_table);
           foreach (@Result) {
               $ids_by_symb{$_->[1]}=$_->[0];
           }
           $have_read_symb_table = 1;
       }
     if (! exists($ids_by_symb{$symb})) {      if (! exists($ids_by_symb{$symb})) {
         &Apache::lonmysql::store_row($symb_table,[undef,$symb]);          &Apache::lonmysql::store_row($symb_table,[undef,$symb]);
         undef(%ids_by_symb);          undef(%ids_by_symb);
Line 2040  Output: undef on error, string $student Line 735  Output: undef on error, string $student
 ################################################  ################################################
 ################################################  ################################################
   
   my $have_read_student_table = 0;
 my %ids_by_student;  my %ids_by_student;
 my %students_by_id;  my %students_by_id;
   
 sub get_student_id {  sub get_student_id {
     my ($sname,$sdom) = @_;      my ($sname,$sdom) = @_;
     my $student = $sname.':'.$sdom;      my $student = $sname.':'.$sdom;
       if (! $have_read_student_table) {
           my @Result = &Apache::lonmysql::get_rows($student_table);
           foreach (@Result) {
               $ids_by_student{$_->[1]}=$_->[0];
           }
           $have_read_student_table = 1;
       }
     if (! exists($ids_by_student{$student})) {      if (! exists($ids_by_student{$student})) {
         &Apache::lonmysql::store_row($student_table,[undef,$student]);          &Apache::lonmysql::store_row($student_table,[undef,$student]);
         undef(%ids_by_student);          undef(%ids_by_student);
Line 2146  sub update_student_data { Line 849  sub update_student_data {
     my $rows_stored;      my $rows_stored;
     my $store_parameters_command  = 'INSERT INTO '.$parameters_table.      my $store_parameters_command  = 'INSERT INTO '.$parameters_table.
         ' VALUES '."\n";          ' VALUES '."\n";
       my $num_parameters = 0;
     my $store_performance_command = 'INSERT INTO '.$performance_table.      my $store_performance_command = 'INSERT INTO '.$performance_table.
         ' VALUES '."\n";          ' VALUES '."\n";
     return 'error' if (! defined($dbh));      return 'error' if (! defined($dbh));
Line 2155  sub update_student_data { Line 859  sub update_student_data {
         my $symb_id = &get_symb_id($current_symb);          my $symb_id = &get_symb_id($current_symb);
         #          #
         # Load data into the tables          # Load data into the tables
         while (my ($parameter,$value) = each (%$param_hash)) {          foreach my $parameter (keys(%$param_hash)) {
               my $value = $param_hash->{$parameter};
             my $newstring;              my $newstring;
             if ($parameter !~ /(timestamp|resource\.(.*)\.(solved|tries|awarded|award|awarddetail|previous))/) {              if ($parameter !~ /(timestamp|resource\.(.*)\.(solved|tries|awarded|award|awarddetail|previous|weight))/) {
                 $newstring = "('".join("','",                  $newstring = "('".join("','",
                                        $symb_id,$student_id,                                         $symb_id,$student_id,
                                        $parameter,$value)."'),\n";                                         $parameter,$value)."'),\n";
                   $num_parameters ++;
                 if ($newstring !~ /''/) {                  if ($newstring !~ /''/) {
                     $store_parameters_command .= $newstring;                      $store_parameters_command .= $newstring;
                     $rows_stored++;                      $rows_stored++;
Line 2200  sub update_student_data { Line 906  sub update_student_data {
     chop $store_performance_command;      chop $store_performance_command;
     chop $store_performance_command;      chop $store_performance_command;
     my $start = Time::HiRes::time;      my $start = Time::HiRes::time;
     $dbh->do($store_parameters_command);      $dbh->do($store_parameters_command) if ($num_parameters>0);
     if ($dbh->err()) {      if ($dbh->err()) {
         &Apache::lonnet::logthis(' bigass insert error:'.$dbh->errstr());          &Apache::lonnet::logthis(' bigass insert error:'.$dbh->errstr());
         &Apache::lonnet::logthis('command = '.$store_performance_command);          &Apache::lonnet::logthis('command = '.$store_parameters_command);
         $returnstatus = 'error: unable to insert parameters into database';          $returnstatus = 'error: unable to insert parameters into database';
         return $returnstatus,\%student_data;          return $returnstatus,\%student_data;
     }      }
     $dbh->do($store_performance_command);      $dbh->do($store_performance_command);
     if ($dbh->err()) {      if ($dbh->err()) {
         &Apache::lonnet::logthis(' bigass insert error:'.$dbh->errstr());          &Apache::lonnet::logthis(' bigass insert error:'.$dbh->errstr());
         &Apache::lonnet::logthis('command = '.$store_parameters_command);          &Apache::lonnet::logthis('command = '.$store_performance_command);
         $returnstatus = 'error: unable to insert performance into database';          $returnstatus = 'error: unable to insert performance into database';
         return $returnstatus,\%student_data;          return $returnstatus,\%student_data;
     }      }
Line 2247  sub ensure_current_data { Line 953  sub ensure_current_data {
     my ($sname,$sdom,$courseid) = @_;      my ($sname,$sdom,$courseid) = @_;
     my $status = 'okay';   # return value      my $status = 'okay';   # return value
     #      #
       $courseid = $ENV{'request.course.id'} if (! defined($courseid));
       # 
       # Clean out package variables
     &setup_table_names($courseid);      &setup_table_names($courseid);
     #      #
     # if the tables do not exist, make them      # if the tables do not exist, make them
Line 2322  interesting, especially if you play with Line 1031  interesting, especially if you play with
 sub get_student_data_from_performance_cache {  sub get_student_data_from_performance_cache {
     my ($sname,$sdom,$symb,$courseid)=@_;      my ($sname,$sdom,$symb,$courseid)=@_;
     my $student = $sname.':'.$sdom if (defined($sname) && defined($sdom));      my $student = $sname.':'.$sdom if (defined($sname) && defined($sdom));
     &setup_table_names();      &setup_table_names($courseid);
     #      #
     # Return hash      # Return hash
     my $studentdata;      my $studentdata;
Line 2413  an empty list is returned. Line 1122  an empty list is returned.
 ################################################  ################################################
 sub get_current_state {  sub get_current_state {
     my ($sname,$sdom,$symb,$courseid,$forcedownload)=@_;      my ($sname,$sdom,$symb,$courseid,$forcedownload)=@_;
     if ($current_course ne $courseid) {  
         # Clear out variables  
         undef(%ids_by_part);  
         undef(%parts_by_id);  
         undef(%ids_by_symb);  
         undef(%symbs_by_id);  
         undef(%ids_by_student);  
         undef(%students_by_id);  
         $current_course = $courseid;  
     }  
     return () if (! defined($sname) || ! defined($sdom));  
     #      #
     $courseid = $ENV{'request.course.id'} if (! defined($courseid));      $courseid = $ENV{'request.course.id'} if (! defined($courseid));
     #      #
       return () if (! defined($sname) || ! defined($sdom));
       #
     my ($status,$data) = &ensure_current_data($sname,$sdom,$courseid);      my ($status,$data) = &ensure_current_data($sname,$sdom,$courseid);
     #      #
     if (defined($data)) {      if (defined($data)) {
Line 2446  sub get_current_state { Line 1146  sub get_current_state {
 }  }
   
 ################################################  ################################################
   ################################################
   
   =pod
   
   =item &get_problem_statistics()
   
   Gather data on a given problem.  The database is assumed to be 
   populated and all local caching variables are assumed to be set
   properly.  This means you need to call &ensure_current_data for
   the students you are concerned with prior to calling this routine.
   
   Inputs: $students, $symb, $part, $courseid
   
   =cut
   
   ################################################
   ################################################
   sub get_problem_statistics {
       my ($students,$symb,$part,$courseid) = @_;
       return if (! defined($symb) || ! defined($part));
       $courseid = $ENV{'request.course.id'} if (! defined($courseid));
       #
       my $symb_id = &get_symb_id($symb);
       my $part_id = &get_part_id($part);
       my $stats_table = $courseid.'_problem_stats';
       #
       &Apache::lonnet::logthis('symb id = '.$symb_id);
       &Apache::lonnet::logthis('part id = '.$part_id);
   
       my $dbh = &Apache::lonmysql::get_dbh();
       return undef if (! defined($dbh));
       &Apache::lonnet::logthis('dbh is defined');
       #
       # A) Number of Students attempting problem
       # B) Total number of tries of students attempting problem
       # C) Mod (largest number of tries for solving the problem)
       # D) Mean (average number of tries for solving the problem)
       # E) Number of students to solve the problem
       # F) Number of students to solve the problem by override
       # G) Number of students unable to solve the problem
       # H) Degree of difficulty : 1-(E+F)/B
       # I) Standard deviation of number of tries
       # J) Skew of tries: sqrt(sum(Xi-D)^3)/A
       #
       $dbh->do('DROP TABLE '.$stats_table);  # May return an error
       my $request = 
           'CREATE TEMPORARY TABLE '.$stats_table.
               ' SELECT student_id,solved,award,tries FROM '.$performance_table.
                   ' WHERE symb_id='.$symb_id.' AND part_id='.$part_id;
   #    &Apache::lonnet::logthis($request);
       $dbh->do($request);
       my ($num,$tries,$mod,$mean,$STD) = &execute_SQL_request
           ($dbh,
            'SELECT COUNT(*),SUM(tries),MAX(tries),AVG(tries),STD(tries) FROM '.
            $stats_table);
       my ($Solved) = &execute_SQL_request($dbh,'SELECT COUNT(tries) FROM '.
                                           $stats_table.
                                           " WHERE solved='correct_by_student'");
       my ($solved) = &execute_SQL_request($dbh,'SELECT COUNT(tries) FROM '.
                                           $stats_table.
                                           " WHERE solved='correct_by_override'");
       $num    = 0 if (! defined($num));
       $tries  = 0 if (! defined($tries));
       $mod    = 0 if (! defined($mod));
       $STD    = 0 if (! defined($STD));
       $Solved = 0 if (! defined($Solved));
       $solved = 0 if (! defined($solved));
       #
       my $DegOfDiff = 'nan';
       $DegOfDiff = 1-($Solved + $solved)/$tries if ($tries>0);
   
       my $SKEW = 'nan';
       if ($num > 0) {
           ($SKEW) = &execute_SQL_request($dbh,'SELECT SQRT(SUM('.
                                        'POWER(tries - '.$STD.',3)'.
                                        '))/'.$num.' FROM '.$stats_table);
       }
       #
       $dbh->do('DROP TABLE '.$stats_table);  # May return an error
       return ($num,$tries,$mod,$mean,$Solved,$solved,$DegOfDiff,$STD,$SKEW);
   }
   
   sub execute_SQL_request {
       my ($dbh,$request)=@_;
   #    &Apache::lonnet::logthis($request);
       my $sth = $dbh->prepare($request);
       $sth->execute();
       my $row = $sth->fetchrow_arrayref();
       if (ref($row) eq 'ARRAY' && scalar(@$row)>0) {
           return @$row;
       }
       return ();
   }
   
   
   ################################################
   ################################################
   
   =pod
   
   =item &setup_table_names()
   
   input: course id
   
   output: none
   
   Cleans up the package variables for local caching.
   
   =cut
   
   ################################################
   ################################################
   sub setup_table_names {
       my ($courseid) = @_;
       if (! defined($courseid)) {
           $courseid = $ENV{'request.course.id'};
       }
       #
       if (! defined($current_course) || $current_course ne $courseid) {
           # Clear out variables
           $have_read_part_table = 0;
           undef(%ids_by_part);
           undef(%parts_by_id);
           $have_read_symb_table = 0;
           undef(%ids_by_symb);
           undef(%symbs_by_id);
           $have_read_student_table = 0;
           undef(%ids_by_student);
           undef(%students_by_id);
           #
           $current_course = $courseid;
       }
       #
       # Set up database names
       my $base_id = $courseid;
       $symb_table        = $base_id.'_'.'symb';
       $part_table        = $base_id.'_'.'part';
       $student_table     = $base_id.'_'.'student';
       $updatetime_table  = $base_id.'_'.'updatetime';
       $performance_table = $base_id.'_'.'performance';
       $parameters_table  = $base_id.'_'.'parameters';
       return;
   }
   
   ################################################
 ################################################  ################################################
   
 =pod  =pod
Removed from v.1.60  
changed lines
  Added in v.1.61

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