File:  [LON-CAPA] / loncom / interface / loncoursedata.pm
Revision 1.32: download - view: text, annotated - select for diffs
Tue Sep 17 15:34:42 2002 UTC (21 years, 8 months ago) by matthew
Branches: MAIN
CVS tags: HEAD
POD added to &ProcessClasslist describing the fields in the hash.

    1: # The LearningOnline Network with CAPA
    2: # (Publication Handler
    3: #
    4: # $Id: loncoursedata.pm,v 1.32 2002/09/17 15:34:42 matthew Exp $
    5: #
    6: # Copyright Michigan State University Board of Trustees
    7: #
    8: # This file is part of the LearningOnline Network with CAPA (LON-CAPA).
    9: #
   10: # LON-CAPA is free software; you can redistribute it and/or modify
   11: # it under the terms of the GNU General Public License as published by
   12: # the Free Software Foundation; either version 2 of the License, or
   13: # (at your option) any later version.
   14: #
   15: # LON-CAPA is distributed in the hope that it will be useful,
   16: # but WITHOUT ANY WARRANTY; without even the implied warranty of
   17: # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
   18: # GNU General Public License for more details.
   19: #
   20: # You should have received a copy of the GNU General Public License
   21: # along with LON-CAPA; if not, write to the Free Software
   22: # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
   23: #
   24: # /home/httpd/html/adm/gpl.txt
   25: #
   26: # http://www.lon-capa.org/
   27: #
   28: ###
   29: 
   30: =pod
   31: 
   32: =head1 NAME
   33: 
   34: loncoursedata
   35: 
   36: =head1 SYNOPSIS
   37: 
   38: Set of functions that download and process student and course information.
   39: 
   40: =head1 PACKAGES USED
   41: 
   42:  Apache::Constants qw(:common :http)
   43:  Apache::lonnet()
   44:  Apache::lonhtmlcommon
   45:  HTML::TokeParser
   46:  GDBM_File
   47: 
   48: =cut
   49: 
   50: package Apache::loncoursedata;
   51: 
   52: use strict;
   53: use Apache::Constants qw(:common :http);
   54: use Apache::lonnet();
   55: use Apache::lonhtmlcommon;
   56: use HTML::TokeParser;
   57: use GDBM_File;
   58: 
   59: =pod
   60: 
   61: =head1 DOWNLOAD INFORMATION
   62: 
   63: This section contains all the functions that get data from other servers 
   64: and/or itself.
   65: 
   66: =cut
   67: 
   68: # ----- DOWNLOAD INFORMATION -------------------------------------------
   69: 
   70: =pod
   71: 
   72: =item &DownloadClasslist()
   73: 
   74: Collects lastname, generation, middlename, firstname, PID, and section for each
   75: student from their environment database.  The section data is also download, though
   76: it is in a rough format, and is processed later.  The list of students is built from
   77: collecting a classlist for the course that is to be displayed.  Once the classlist
   78: has been downloaded, its date stamp is recorded.  Unless the datestamp for the
   79: class database is reset or is modified, this data will not be downloaded again.  
   80: Also, there was talk about putting the fullname and section
   81: and perhaps other pieces of data into the classlist file.  This would
   82: reduce the number of different file accesses and reduce the amount of 
   83: processing on this side.
   84: 
   85: =over 4
   86: 
   87: Input: $courseID, $lastDownloadTime, $c
   88: 
   89: $courseID:  The id of the course
   90: 
   91: $lastDownloadTime:  This is the date stamp for when this information was
   92: last gathered.  If it is set to Not downloaded, it will gather the data
   93: again, though it currently does not remove the old data.
   94: 
   95: $c: The connection class that can determine if the browser has aborted.  It
   96: is used to short circuit this function so that it does not continue to 
   97: get information when there is no need.
   98: 
   99: Output: \%classlist
  100: 
  101: \%classlist: A pointer to a hash containing the following data:
  102: 
  103: -A list of student name:domain (as keys) (known below as $name)
  104: 
  105: -A hash pointer for each student containing lastname, generation, firstname,
  106: middlename, and PID : Key is $name.studentInformation
  107: 
  108: -A hash pointer to each students section data : Key is $name.section
  109: 
  110: -If there was an error in dump, it will be returned in the hash.  See
  111: the error codes for dump in lonnet.  Also, an error key will be 
  112: generated if an abort occurs.
  113: 
  114: =back
  115: 
  116: =cut
  117: 
  118: sub DownloadClasslist {
  119:     my ($courseID, $lastDownloadTime, $c)=@_;
  120:     my ($courseDomain,$courseNumber)=split(/\_/,$courseID);
  121:     my %classlist;
  122: 
  123:     my $modifiedTime = &Apache::lonnet::GetFileTimestamp($courseDomain, $courseNumber,
  124:                                                          'classlist.db', 
  125:                                                          $Apache::lonnet::perlvar{'lonUsersDir'});
  126: 
  127:     # Always download the information if lastDownloadTime is set to
  128:     # Not downloaded, otherwise it is only downloaded if the file
  129:     # has been updated and has a more recent date stamp
  130:     if($lastDownloadTime ne 'Not downloaded' &&
  131:        $lastDownloadTime >= $modifiedTime && $modifiedTime >= 0) {
  132:         # Data is not gathered so return UpToDate as true.  This
  133:         # will be interpreted in ProcessClasslist
  134:         $classlist{'lastDownloadTime'}=time;
  135:         $classlist{'UpToDate'} = 'true';
  136:         return \%classlist;
  137:     }
  138: 
  139:     %classlist=&Apache::lonnet::dump('classlist',$courseDomain, $courseNumber);
  140:     foreach(keys (%classlist)) {
  141:         if(/^(con_lost|error|no_such_host)/i) {
  142:             return \%classlist;
  143:         }
  144:     }
  145: 
  146:     foreach my $name (keys(%classlist)) {
  147:         if(defined($c) && ($c->aborted())) {
  148:             $classlist{'error'}='aborted';
  149:             return \%classlist;
  150:         }
  151: 
  152:         my ($studentName,$studentDomain) = split(/\:/,$name);
  153:         # Download student environment data, specifically the full name and id.
  154:         my %studentInformation=&Apache::lonnet::get('environment',
  155:                                                     ['lastname','generation',
  156:                                                      'firstname','middlename',
  157:                                                      'id'],
  158:                                                     $studentDomain,
  159:                                                     $studentName);
  160:         $classlist{$name.':studentInformation'}=\%studentInformation;
  161: 
  162:         if($c->aborted()) {
  163:             $classlist{'error'}='aborted';
  164:             return \%classlist;
  165:         }
  166: 
  167:         #Section
  168:         my %section=&Apache::lonnet::dump('roles',$studentDomain,$studentName);
  169:         $classlist{$name.':sections'}=\%section;
  170:     }
  171: 
  172:     $classlist{'UpToDate'} = 'false';
  173:     $classlist{'lastDownloadTime'}=time;
  174: 
  175:     return \%classlist;
  176: }
  177: 
  178: =pod
  179: 
  180: =item &DownloadCourseInformation()
  181: 
  182: Dump of all the course information for a single student.  The data can be
  183: pruned by making use of dumps regular expression arguement.  This function
  184: also takes a regular expression which it passes straight through to dump.  
  185: The data is no escaped, because it is done elsewhere.  It also
  186: checks the timestamp of the students course database file and only downloads
  187: if it has been modified since the last download.
  188: 
  189: =over 4
  190: 
  191: Input: $namedata, $courseID, $lastDownloadTime, $WhatIWant
  192: 
  193: $namedata: student name:domain
  194: 
  195: $courseID:  The id of the course
  196: 
  197: $lastDownloadTime:  This is the date stamp for when this information was
  198: last gathered.  If it is set to Not downloaded, it will gather the data
  199: again, though it currently does not remove the old data.
  200: 
  201: $WhatIWant:  Regular expression used to get selected data with dump
  202: 
  203: Output: \%courseData
  204: 
  205: \%courseData:  A hash pointer to the raw data from the students course
  206: database.
  207: 
  208: =back
  209: 
  210: =cut
  211: 
  212: sub DownloadCourseInformation {
  213:     my ($namedata,$courseID,$lastDownloadTime,$WhatIWant)=@_;
  214:     my %courseData;
  215:     my ($name,$domain) = split(/\:/,$namedata);
  216: 
  217:     my $modifiedTime = &Apache::lonnet::GetFileTimestamp($domain, $name,
  218:                                       $courseID.'.db', 
  219:                                       $Apache::lonnet::perlvar{'lonUsersDir'});
  220: 
  221:     if($lastDownloadTime >= $modifiedTime && $modifiedTime >= 0) {
  222:         # Data is not gathered so return UpToDate as true.  This
  223:         # will be interpreted in ProcessClasslist
  224:         $courseData{$namedata.':lastDownloadTime'}=time;
  225:         $courseData{$namedata.':UpToDate'} = 'true';
  226:         return \%courseData;
  227:     }
  228: 
  229:     # Download course data
  230:     if(!defined($WhatIWant)) {
  231:         # set the regular expression to everything by setting it to period
  232:         $WhatIWant = '.';
  233:     }
  234:     %courseData=&Apache::lonnet::dump($courseID, $domain, $name, $WhatIWant);
  235:     $courseData{'UpToDate'} = 'false';
  236:     $courseData{'lastDownloadTime'}=time;
  237: 
  238:     my %newData;
  239:     foreach (keys(%courseData)) {
  240:         # need to have the keys to be prepended with the name:domain of the
  241:         # student to reduce data collision later.
  242:         $newData{$namedata.':'.$_} = $courseData{$_};
  243:     }
  244: 
  245:     return \%newData;
  246: }
  247: 
  248: # ----- END DOWNLOAD INFORMATION ---------------------------------------
  249: 
  250: =pod
  251: 
  252: =head1 PROCESSING FUNCTIONS
  253: 
  254: These functions process all the data for all the students.  Also, they
  255: are the functions that access the cache database for writing the majority of
  256: the time.  The downloading and caching were separated to reduce problems 
  257: with stopping downloading then can not tie hash to database later.
  258: 
  259: =cut
  260: 
  261: # ----- PROCESSING FUNCTIONS ---------------------------------------
  262: 
  263: =pod
  264: 
  265: =item &ProcessTopResourceMap()
  266: 
  267: Trace through the "big hash" created in rat/lonuserstate.pm::loadmap.  
  268: Basically, this function organizes a subset of the data and stores it in
  269: cached data.  The data stored is the problems, sequences, sequence titles,
  270: parts of problems, and their ordering.  Column width information is also 
  271: partially handled here on a per sequence basis.
  272: 
  273: =over 4
  274: 
  275: Input: $cache, $c
  276: 
  277: $cache:  A pointer to a hash to store the information
  278: 
  279: $c:  The connection class used to determine if an abort has been sent to the 
  280: browser
  281: 
  282: Output: A string that contains an error message or "OK" if everything went 
  283: smoothly.
  284: 
  285: =back
  286: 
  287: =cut
  288: 
  289: sub ProcessTopResourceMap {
  290:     my ($cache,$c)=@_;
  291:     my %hash;
  292:     my $fn=$ENV{'request.course.fn'};
  293:     if(-e "$fn.db") {
  294: 	my $tieTries=0;
  295: 	while($tieTries < 3) {
  296:             if($c->aborted()) {
  297:                 return;
  298:             }
  299: 	    if(tie(%hash,'GDBM_File',"$fn.db",&GDBM_READER(),0640)) {
  300: 		last;
  301: 	    }
  302: 	    $tieTries++;
  303: 	    sleep 1;
  304: 	}
  305: 	if($tieTries >= 3) {
  306:             return 'Coursemap undefined.';
  307:         }
  308:     } else {
  309:         return 'Can not open Coursemap.';
  310:     }
  311: 
  312:     my $oldkeys;
  313:     if(defined($cache->{'ResourceKeys'})) {
  314:         $oldkeys = $cache->{'ResourceKeys'};
  315:         foreach (split(':::', $cache->{'ResourceKeys'})) {
  316:             delete $cache->{$_};
  317:         }
  318:         delete $cache->{'ResourceKeys'};
  319:     }
  320: 
  321:     # Initialize state machine.  Set information pointing to top level map.
  322:     my (@sequences, @currentResource, @finishResource);
  323:     my ($currentSequence, $currentResourceID, $lastResourceID);
  324: 
  325:     $currentResourceID=$hash{'ids_'.
  326:       &Apache::lonnet::clutter($ENV{'request.course.uri'})};
  327:     push(@currentResource, $currentResourceID);
  328:     $lastResourceID=-1;
  329:     $currentSequence=-1;
  330:     my $topLevelSequenceNumber = $currentSequence;
  331: 
  332:     my %sequenceRecord;
  333:     my %allkeys;
  334:     while(1) {
  335:         if($c->aborted()) {
  336:             last;
  337:         }
  338: 	# HANDLE NEW SEQUENCE!
  339: 	#if page || sequence
  340: 	if(defined($hash{'map_pc_'.$hash{'src_'.$currentResourceID}}) &&
  341:            !defined($sequenceRecord{$currentResourceID})) {
  342:             $sequenceRecord{$currentResourceID}++;
  343: 	    push(@sequences, $currentSequence);
  344: 	    push(@currentResource, $currentResourceID);
  345: 	    push(@finishResource, $lastResourceID);
  346: 
  347: 	    $currentSequence=$hash{'map_pc_'.$hash{'src_'.$currentResourceID}};
  348: 
  349:             # Mark sequence as containing problems.  If it doesn't, then
  350:             # it will be removed when processing for this sequence is
  351:             # complete.  This allows the problems in a sequence
  352:             # to be outputed before problems in the subsequences
  353:             if(!defined($cache->{'orderedSequences'})) {
  354:                 $cache->{'orderedSequences'}=$currentSequence;
  355:             } else {
  356:                 $cache->{'orderedSequences'}.=':'.$currentSequence;
  357:             }
  358:             $allkeys{'orderedSequences'}++;
  359: 
  360: 	    $lastResourceID=$hash{'map_finish_'.
  361: 				  $hash{'src_'.$currentResourceID}};
  362: 	    $currentResourceID=$hash{'map_start_'.
  363: 				     $hash{'src_'.$currentResourceID}};
  364: 
  365: 	    if(!($currentResourceID) || !($lastResourceID)) {
  366: 		$currentSequence=pop(@sequences);
  367: 		$currentResourceID=pop(@currentResource);
  368: 		$lastResourceID=pop(@finishResource);
  369: 		if($currentSequence eq $topLevelSequenceNumber) {
  370: 		    last;
  371: 		}
  372: 	    }
  373:             next;
  374: 	}
  375: 
  376: 	# Handle gradable resources: exams, problems, etc
  377: 	$currentResourceID=~/(\d+)\.(\d+)/;
  378:         my $partA=$1;
  379:         my $partB=$2;
  380: 	if($hash{'src_'.$currentResourceID}=~
  381: 	   /\.(problem|exam|quiz|assess|survey|form)$/ &&
  382: 	   $partA eq $currentSequence && 
  383:            !defined($sequenceRecord{$currentSequence.':'.
  384:                                     $currentResourceID})) {
  385:             $sequenceRecord{$currentSequence.':'.$currentResourceID}++;
  386: 	    my $Problem = &Apache::lonnet::symbclean(
  387: 			  &Apache::lonnet::declutter($hash{'map_id_'.$partA}).
  388: 			  '___'.$partB.'___'.
  389: 			  &Apache::lonnet::declutter($hash{'src_'.
  390: 							 $currentResourceID}));
  391: 
  392: 	    $cache->{$currentResourceID.':problem'}=$Problem;
  393:             $allkeys{$currentResourceID.':problem'}++;
  394: 	    if(!defined($cache->{$currentSequence.':problems'})) {
  395: 		$cache->{$currentSequence.':problems'}=$currentResourceID;
  396: 	    } else {
  397: 		$cache->{$currentSequence.':problems'}.=
  398: 		    ':'.$currentResourceID;
  399: 	    }
  400:             $allkeys{$currentSequence.':problems'}++;
  401: 
  402: 	    my $meta=$hash{'src_'.$currentResourceID};
  403: #            $cache->{$currentResourceID.':title'}=
  404: #                &Apache::lonnet::metdata($meta,'title');
  405:             $cache->{$currentResourceID.':title'}=
  406:                 $hash{'title_'.$currentResourceID};
  407:             $allkeys{$currentResourceID.':title'}++;
  408:             $cache->{$currentResourceID.':source'}=
  409:                 $hash{'src_'.$currentResourceID};
  410:             $allkeys{$currentResourceID.':source'}++;
  411: 
  412:             # Get Parts for problem
  413:             my %beenHere;
  414:             foreach (split(/\,/,&Apache::lonnet::metadata($meta,'packages'))) {
  415:                 if(/^\w+response_\d+.*/) {
  416:                     my (undef, $partId, $responseId) = split(/_/,$_);
  417:                     if($beenHere{'p:'.$partId} ==  0) {
  418:                         $beenHere{'p:'.$partId}++;
  419:                         if(!defined($cache->{$currentSequence.':'.
  420:                                             $currentResourceID.':parts'})) {
  421:                             $cache->{$currentSequence.':'.$currentResourceID.
  422:                                      ':parts'}=$partId;
  423:                         } else {
  424:                             $cache->{$currentSequence.':'.$currentResourceID.
  425:                                      ':parts'}.=':'.$partId;
  426:                         }
  427:                         $allkeys{$currentSequence.':'.$currentResourceID.
  428:                                   ':parts'}++;
  429:                     }
  430:                     if($beenHere{'r:'.$partId.':'.$responseId} == 0) {
  431:                         $beenHere{'r:'.$partId.':'.$responseId}++;
  432:                         if(!defined($cache->{$currentSequence.':'.
  433:                                              $currentResourceID.':'.$partId.
  434:                                              ':responseIDs'})) {
  435:                             $cache->{$currentSequence.':'.$currentResourceID.
  436:                                      ':'.$partId.':responseIDs'}=$responseId;
  437:                         } else {
  438:                             $cache->{$currentSequence.':'.$currentResourceID.
  439:                                      ':'.$partId.':responseIDs'}.=':'.
  440:                                                                   $responseId;
  441:                         }
  442:                         $allkeys{$currentSequence.':'.$currentResourceID.':'.
  443:                                      $partId.':responseIDs'}++;
  444:                     }
  445:                     if(/^optionresponse/ && 
  446:                        $beenHere{'o:'.$partId.':'.$currentResourceID} == 0) {
  447:                         $beenHere{'o:'.$partId.$currentResourceID}++;
  448:                         if(defined($cache->{'OptionResponses'})) {
  449:                             $cache->{'OptionResponses'}.= ':::'.
  450:                                 $currentSequence.':'.$currentResourceID.':'.
  451:                                 $partId.':'.$responseId;
  452:                         } else {
  453:                             $cache->{'OptionResponses'}= $currentSequence.':'.
  454:                                 $currentResourceID.':'.
  455:                                 $partId.':'.$responseId;
  456:                         }
  457:                         $allkeys{'OptionResponses'}++;
  458:                     }
  459:                 }
  460:             }
  461:         }
  462: 
  463: 	# if resource == finish resource, then it is the end of a sequence/page
  464: 	if($currentResourceID eq $lastResourceID) {
  465: 	    # pop off last resource of sequence
  466: 	    $currentResourceID=pop(@currentResource);
  467: 	    $lastResourceID=pop(@finishResource);
  468: 
  469: 	    if(defined($cache->{$currentSequence.':problems'})) {
  470: 		# Capture sequence information here
  471: 		$cache->{$currentSequence.':title'}=
  472: 		    $hash{'title_'.$currentResourceID};
  473:                 $allkeys{$currentSequence.':title'}++;
  474:                 $cache->{$currentSequence.':source'}=
  475:                     $hash{'src_'.$currentResourceID};
  476:                 $allkeys{$currentSequence.':source'}++;
  477: 
  478:                 my $totalProblems=0;
  479:                 foreach my $currentProblem (split(/\:/,
  480:                                                $cache->{$currentSequence.
  481:                                                ':problems'})) {
  482:                     foreach (split(/\:/,$cache->{$currentSequence.':'.
  483:                                                    $currentProblem.
  484:                                                    ':parts'})) {
  485:                         $totalProblems++;
  486:                     }
  487:                 }
  488: 		my @titleLength=split(//,$cache->{$currentSequence.
  489:                                                     ':title'});
  490:                 # $extra is 3 for problems correct and 3 for space
  491:                 # between problems correct and problem output
  492:                 my $extra = 6;
  493: 		if(($totalProblems + $extra) > (scalar @titleLength)) {
  494: 		    $cache->{$currentSequence.':columnWidth'}=
  495:                         $totalProblems + $extra;
  496: 		} else {
  497: 		    $cache->{$currentSequence.':columnWidth'}=
  498:                         (scalar @titleLength);
  499: 		}
  500:                 $allkeys{$currentSequence.':columnWidth'}++;
  501: 	    } else {
  502:                 # Remove sequence from list, if it contains no problems to
  503:                 # display.
  504:                 $cache->{'orderedSequences'}=~s/$currentSequence//;
  505:                 $cache->{'orderedSequences'}=~s/::/:/g;
  506:                 $cache->{'orderedSequences'}=~s/^:|:$//g;
  507:             }
  508: 
  509: 	    $currentSequence=pop(@sequences);
  510: 	    if($currentSequence eq $topLevelSequenceNumber) {
  511: 		last;
  512: 	    }
  513:         }
  514: 
  515: 	# MOVE!!!
  516: 	# move to next resource
  517: 	unless(defined($hash{'to_'.$currentResourceID})) {
  518: 	    # big problem, need to handle.  Next is probably wrong
  519:             my $errorMessage = 'Big problem in ';
  520:             $errorMessage .= 'loncoursedata::ProcessTopLevelMap.';
  521:             $errorMessage .= '  bighash to_$currentResourceID not defined!';
  522:             &Apache::lonnet::logthis($errorMessage);
  523: 	    last;
  524: 	}
  525: 	my @nextResources=();
  526: 	foreach (split(/\,/,$hash{'to_'.$currentResourceID})) {
  527:             if(!defined($sequenceRecord{$currentSequence.':'.
  528:                                         $hash{'goesto_'.$_}})) {
  529:                 push(@nextResources, $hash{'goesto_'.$_});
  530:             }
  531: 	}
  532: 	push(@currentResource, @nextResources);
  533: 	# Set the next resource to be processed
  534: 	$currentResourceID=pop(@currentResource);
  535:     }
  536: 
  537:     my @theKeys = keys(%allkeys);
  538:     my $newkeys = join(':::', @theKeys);
  539:     $cache->{'ResourceKeys'} = join(':::', $newkeys);
  540:     if($newkeys ne $oldkeys) {
  541:         $cache->{'ResourceUpdated'} = 'true';
  542:     } else {
  543:         $cache->{'ResourceUpdated'} = 'false';
  544:     }
  545: 
  546:     unless (untie(%hash)) {
  547:         &Apache::lonnet::logthis("<font color=blue>WARNING: ".
  548:                                  "Could not untie coursemap $fn (browse)".
  549:                                  ".</font>"); 
  550:     }
  551: 
  552:     return 'OK';
  553: }
  554: 
  555: =pod
  556: 
  557: =item &ProcessClasslist()
  558: 
  559: Taking the class list dumped from &DownloadClasslist(), all the 
  560: students and their non-class information is processed using the 
  561: &ProcessStudentInformation() function.  A date stamp is also recorded for
  562: when the data was processed.
  563: 
  564: Takes data downloaded for a student and breaks it up into managable pieces and 
  565: stored in cache data.  The username, domain, class related date, PID, 
  566: full name, and section are all processed here.
  567: 
  568: =over 4
  569: 
  570: Input: $cache, $classlist, $courseID, $ChartDB, $c
  571: 
  572: $cache: A hash pointer to store the data
  573: 
  574: $classlist:  The hash of data collected about a student from 
  575: &DownloadClasslist().  The hash contains a list of students, a pointer 
  576: to a hash of student information for each student, and each students section 
  577: number.
  578: 
  579: $courseID:  The course ID
  580: 
  581: $ChartDB:  The name of the cache database file.
  582: 
  583: $c:  The connection class used to determine if an abort has been sent to the 
  584: browser
  585: 
  586: Output: @names
  587: 
  588: @names:  An array of students whose information has been processed, and are to 
  589: be considered in an arbitrary order.  The entries in @names are of the form
  590: username:domain.
  591: 
  592: The values in $cache are as follows:
  593: 
  594:  *NOTE: for the following $name implies username:domain
  595:  $name.':error'                  only defined if an error occured.  Value
  596:                                  contains the error message
  597:  $name.':lastDownloadTime'       unconverted time of the last update of a
  598:                                  student\'s course data
  599:  $name.'updateTime'              coverted time of the last update of a 
  600:                                  student\'s course data
  601:  $name.':username'               username of a student
  602:  $name.':domain'                 domain of a student
  603:  $name.':fullname'               full name of a student
  604:  $name.':id'                     PID of a student
  605:  $name.':Status'                 active/expired status of a student
  606:  $name.':section'                section of a student
  607: 
  608: =back
  609: 
  610: =cut
  611: 
  612: sub ProcessClasslist {
  613:     my ($cache,$classlist,$courseID,$c)=@_;
  614:     my @names=();
  615: 
  616:     $cache->{'ClasslistTimeStamp'}=$classlist->{'lastDownloadTime'};
  617:     if($classlist->{'UpToDate'} eq 'true') {
  618:         return split(/:::/,$cache->{'NamesOfStudents'});;
  619:     }
  620: 
  621:     foreach my $name (keys(%$classlist)) {
  622:         if($name =~ /\:section/ || $name =~ /\:studentInformation/ ||
  623:            $name eq '' || $name eq 'UpToDate' || $name eq 'lastDownloadTime') {
  624:             next;
  625:         }
  626:         if($c->aborted()) {
  627:             return ();
  628:         }
  629:         my $studentInformation = $classlist->{$name.':studentInformation'};
  630:         my $date = $classlist->{$name};
  631:         my ($studentName,$studentDomain) = split(/\:/,$name);
  632: 
  633:         $cache->{$name.':username'}=$studentName;
  634:         $cache->{$name.':domain'}=$studentDomain;
  635:         # Initialize timestamp for student
  636:         if(!defined($cache->{$name.':lastDownloadTime'})) {
  637:             $cache->{$name.':lastDownloadTime'}='Not downloaded';
  638:             $cache->{$name.':updateTime'}=' Not updated';
  639:         }
  640: 
  641:         my $error = 0;
  642:         foreach(keys(%$studentInformation)) {
  643:             if(/^(con_lost|error|no_such_host)/i) {
  644:                 $cache->{$name.':error'}=
  645:                     'Could not download student environment data.';
  646:                 $cache->{$name.':fullname'}='';
  647:                 $cache->{$name.':id'}='';
  648:                 $error = 1;
  649:             }
  650:         }
  651:         next if($error);
  652:         push(@names,$name);
  653:         $cache->{$name.':fullname'}=&ProcessFullName(
  654:                                           $studentInformation->{'lastname'},
  655:                                           $studentInformation->{'generation'},
  656:                                           $studentInformation->{'firstname'},
  657:                                           $studentInformation->{'middlename'});
  658:         $cache->{$name.':id'}=$studentInformation->{'id'};
  659: 
  660:         my ($end, $start)=split(':',$date);
  661:         $courseID=~s/\_/\//g;
  662:         $courseID=~s/^(\w)/\/$1/;
  663: 
  664:         my $sec='';
  665:         my $sectionData = $classlist->{$name.':sections'};
  666:         foreach my $key (keys (%$sectionData)) {
  667:             my $value = $sectionData->{$key};
  668:             if ($key=~/^$courseID(?:\/)*(\w+)*\_st$/) {
  669:                 my $tempsection=$1;
  670:                 if($key eq $courseID.'_st') {
  671:                     $tempsection='';
  672:                 }
  673:                 my (undef,$roleend,$rolestart)=split(/\_/,$value);
  674:                 if($roleend eq $end && $rolestart eq $start) {
  675:                     $sec = $tempsection;
  676:                     last;
  677:                 }
  678:             }
  679:         }
  680: 
  681:         my $status='Expired';
  682:         if(((!$end) || time < $end) && ((!$start) || (time > $start))) {
  683:             $status='Active';
  684:         }
  685:         $cache->{$name.':Status'}=$status;
  686:         $cache->{$name.':section'}=$sec;
  687: 
  688:         if($sec eq '' || !defined($sec) || $sec eq ' ') {
  689:             $sec = 'none';
  690:         }
  691:         if(defined($cache->{'sectionList'})) {
  692:             if($cache->{'sectionList'} !~ /(^$sec:|^$sec$|:$sec$|:$sec:)/) {
  693:                 $cache->{'sectionList'} .= ':'.$sec;
  694:             }
  695:         } else {
  696:             $cache->{'sectionList'} = $sec;
  697:         }
  698:     }
  699: 
  700:     $cache->{'ClasslistTimestamp'}=time;
  701:     $cache->{'NamesOfStudents'}=join(':::',@names);
  702: 
  703:     return @names;
  704: }
  705: 
  706: =pod
  707: 
  708: =item &ProcessStudentData()
  709: 
  710: Takes the course data downloaded for a student in 
  711: &DownloadCourseInformation() and breaks it up into key value pairs
  712: to be stored in the cached data.  The keys are comprised of the 
  713: $username:$domain:$keyFromCourseDatabase.  The student username:domain is
  714: stored away signifying that the students information has been downloaded and 
  715: can be reused from cached data.
  716: 
  717: =over 4
  718: 
  719: Input: $cache, $courseData, $name
  720: 
  721: $cache: A hash pointer to store data
  722: 
  723: $courseData:  A hash pointer that points to the course data downloaded for a 
  724: student.
  725: 
  726: $name:  username:domain
  727: 
  728: Output: None
  729: 
  730: *NOTE:  There is no output, but an error message is stored away in the cache 
  731: data.  This is checked in &FormatStudentData().  The key username:domain:error 
  732: will only exist if an error occured.  The error is an error from 
  733: &DownloadCourseInformation().
  734: 
  735: =back
  736: 
  737: =cut
  738: 
  739: sub ProcessStudentData {
  740:     my ($cache,$courseData,$name)=@_;
  741: 
  742:     if(!&CheckDateStampError($courseData, $cache, $name)) {
  743:         return;
  744:     }
  745: 
  746:     # This little delete thing, should not be here.  Move some other
  747:     # time though.
  748:     if(defined($cache->{$name.':keys'})) {
  749: 	foreach (split(':::', $cache->{$name.':keys'})) {
  750: 	    delete $cache->{$name.':'.$_};
  751: 	}
  752:         delete $cache->{$name.':keys'};
  753:     }
  754: 
  755:     my %courseKeys;
  756:     # user name:domain was prepended earlier in DownloadCourseInformation
  757:     foreach (keys %$courseData) {
  758: 	my $currentKey = $_;
  759: 	$currentKey =~ s/^$name//;
  760: 	$courseKeys{$currentKey}++;
  761:         $cache->{$_}=$courseData->{$_};
  762:     }
  763: 
  764:     $cache->{$name.':keys'} = join(':::', keys(%courseKeys));
  765: 
  766:     return;
  767: }
  768: 
  769: =pod
  770: 
  771: =item &ExtractStudentData()
  772: 
  773: HISTORY: This function originally existed in every statistics module,
  774: and performed different tasks, the had some overlap.  Due to the need
  775: for the data from the different modules, they were combined into
  776: a single function.
  777: 
  778: This function now extracts all the necessary course data for a student
  779: from what was downloaded from their homeserver.  There is some extra
  780: time overhead compared to the ProcessStudentInformation function, but
  781: it would have had to occurred at some point anyways.  This is now
  782: typically called while downloading the data it will process.  It is
  783: the brother function to ProcessStudentInformation.
  784: 
  785: =over 4
  786: 
  787: Input: $input, $output, $data, $name
  788: 
  789: $input: A hash that contains the input data to be processed
  790: 
  791: $output: A hash to contain the processed data
  792: 
  793: $data: A hash containing the information on what is to be
  794: processed and how (basically).
  795: 
  796: $name:  username:domain
  797: 
  798: The input is slightly different here, but is quite simple.
  799: It is currently used where the $input, $output, and $data
  800: can and are often the same hashes, but they do not need
  801: to be.
  802: 
  803: Output: None
  804: 
  805: *NOTE:  There is no output, but an error message is stored away in the cache 
  806: data.  This is checked in &FormatStudentData().  The key username:domain:error 
  807: will only exist if an error occured.  The error is an error from 
  808: &DownloadCourseInformation().
  809: 
  810: =back
  811: 
  812: =cut
  813: 
  814: sub ExtractStudentData {
  815:     my ($input, $output, $data, $name)=@_;
  816: 
  817:     if(!&CheckDateStampError($input, $data, $name)) {
  818:         return;
  819:     }
  820: 
  821:     # This little delete thing, should not be here.  Move some other
  822:     # time though.
  823:     my %allkeys;
  824:     if(defined($output->{$name.':keys'})) {
  825: 	foreach (split(':::', $output->{$name.':keys'})) {
  826: 	    delete $output->{$name.':'.$_};
  827: 	}
  828:         delete $output->{$name.':keys'};
  829:     }
  830: 
  831:     my ($username,$domain)=split(':',$name);
  832: 
  833:     my $Version;
  834:     my $problemsCorrect = 0;
  835:     my $totalProblems   = 0;
  836:     my $problemsSolved  = 0;
  837:     my $numberOfParts   = 0;
  838:     my $totalAwarded    = 0;
  839:     foreach my $sequence (split(':', $data->{'orderedSequences'})) {
  840:         foreach my $problemID (split(':', $data->{$sequence.':problems'})) {
  841:             my $problem = $data->{$problemID.':problem'};
  842:             my $LatestVersion = $input->{$name.':version:'.$problem};
  843: 
  844:             # Output dashes for all the parts of this problem if there
  845:             # is no version information about the current problem.
  846:             $output->{$name.':'.$problemID.':NoVersion'} = 'false';
  847:             $allkeys{$name.':'.$problemID.':NoVersion'}++;
  848:             if(!$LatestVersion) {
  849:                 foreach my $part (split(/\:/,$data->{$sequence.':'.
  850:                                                       $problemID.
  851:                                                       ':parts'})) {
  852:                     $output->{$name.':'.$problemID.':'.$part.':tries'} = 0;
  853:                     $output->{$name.':'.$problemID.':'.$part.':awarded'} = 0;
  854:                     $output->{$name.':'.$problemID.':'.$part.':code'} = ' ';
  855: 		    $allkeys{$name.':'.$problemID.':'.$part.':tries'}++;
  856: 		    $allkeys{$name.':'.$problemID.':'.$part.':awarded'}++;
  857: 		    $allkeys{$name.':'.$problemID.':'.$part.':code'}++;
  858:                     $totalProblems++;
  859:                 }
  860:                 $output->{$name.':'.$problemID.':NoVersion'} = 'true';
  861:                 next;
  862:             }
  863: 
  864:             my %partData=undef;
  865:             # Initialize part data, display skips correctly
  866:             # Skip refers to when a student made no submissions on that
  867:             # part/problem.
  868:             foreach my $part (split(/\:/,$data->{$sequence.':'.
  869:                                                  $problemID.
  870:                                                  ':parts'})) {
  871:                 $partData{$part.':tries'}=0;
  872:                 $partData{$part.':code'}=' ';
  873:                 $partData{$part.':awarded'}=0;
  874:                 $partData{$part.':timestamp'}=0;
  875:                 foreach my $response (split(':', $data->{$sequence.':'.
  876:                                                          $problemID.':'.
  877:                                                          $part.':responseIDs'})) {
  878:                     $partData{$part.':'.$response.':submission'}='';
  879:                 }
  880:             }
  881: 
  882:             # Looping through all the versions of each part, starting with the
  883:             # oldest version.  Basically, it gets the most recent 
  884:             # set of grade data for each part.
  885:             my @submissions = ();
  886: 	    for(my $Version=1; $Version<=$LatestVersion; $Version++) {
  887:                 foreach my $part (split(/\:/,$data->{$sequence.':'.
  888:                                                      $problemID.
  889:                                                      ':parts'})) {
  890: 
  891:                     if(!defined($input->{"$name:$Version:$problem".
  892:                                          ":resource.$part.solved"})) {
  893:                         # No grade for this submission, so skip
  894:                         next;
  895:                     }
  896: 
  897:                     my $tries=0;
  898:                     my $code=' ';
  899:                     my $awarded=0;
  900: 
  901:                     $tries = $input->{$name.':'.$Version.':'.$problem.
  902:                                       ':resource.'.$part.'.tries'};
  903:                     $awarded = $input->{$name.':'.$Version.':'.$problem.
  904:                                         ':resource.'.$part.'.awarded'};
  905: 
  906:                     $partData{$part.':awarded'}=($awarded) ? $awarded : 0;
  907:                     $partData{$part.':tries'}=($tries) ? $tries : 0;
  908: 
  909:                     $partData{$part.':timestamp'}=$input->{$name.':'.$Version.':'.
  910:                                                            $problem.
  911:                                                            ':timestamp'};
  912:                     if(!$input->{$name.':'.$Version.':'.$problem.':resource.'.$part.
  913:                                  '.previous'}) {
  914:                         foreach my $response (split(':',
  915:                                                    $data->{$sequence.':'.
  916:                                                            $problemID.':'.
  917:                                                            $part.':responseIDs'})) {
  918:                             @submissions=($input->{$name.':'.$Version.':'.
  919:                                                    $problem.
  920:                                                    ':resource.'.$part.'.'.
  921:                                                    $response.'.submission'},
  922:                                           @submissions);
  923:                         }
  924:                     }
  925: 
  926:                     my $val = $input->{$name.':'.$Version.':'.$problem.
  927:                                        ':resource.'.$part.'.solved'};
  928:                     if    ($val eq 'correct_by_student')   {$code = '*';} 
  929:                     elsif ($val eq 'correct_by_override')  {$code = '+';}
  930:                     elsif ($val eq 'incorrect_attempted')  {$code = '.';} 
  931:                     elsif ($val eq 'incorrect_by_override'){$code = '-';}
  932:                     elsif ($val eq 'excused')              {$code = 'x';}
  933:                     elsif ($val eq 'ungraded_attempted')   {$code = '#';}
  934:                     else                                   {$code = ' ';}
  935:                     $partData{$part.':code'}=$code;
  936:                 }
  937:             }
  938: 
  939:             foreach my $part (split(/\:/,$data->{$sequence.':'.$problemID.
  940:                                                  ':parts'})) {
  941:                 $output->{$name.':'.$problemID.':'.$part.':wrong'} = 
  942:                     $partData{$part.':tries'};
  943: 		$allkeys{$name.':'.$problemID.':'.$part.':wrong'}++;
  944: 
  945:                 if($partData{$part.':code'} eq '*') {
  946:                     $output->{$name.':'.$problemID.':'.$part.':wrong'}--;
  947:                     $problemsCorrect++;
  948:                 } elsif($partData{$part.':code'} eq '+') {
  949:                     $output->{$name.':'.$problemID.':'.$part.':wrong'}--;
  950:                     $problemsCorrect++;
  951:                 }
  952: 
  953:                 $output->{$name.':'.$problemID.':'.$part.':tries'} = 
  954:                     $partData{$part.':tries'};
  955:                 $output->{$name.':'.$problemID.':'.$part.':code'} =
  956:                     $partData{$part.':code'};
  957:                 $output->{$name.':'.$problemID.':'.$part.':awarded'} =
  958:                     $partData{$part.':awarded'};
  959: 		$allkeys{$name.':'.$problemID.':'.$part.':tries'}++;
  960: 		$allkeys{$name.':'.$problemID.':'.$part.':code'}++;
  961: 		$allkeys{$name.':'.$problemID.':'.$part.':awarded'}++;
  962: 
  963:                 $totalAwarded += $partData{$part.':awarded'};
  964:                 $output->{$name.':'.$problemID.':'.$part.':timestamp'} =
  965:                     $partData{$part.':timestamp'};
  966: 		$allkeys{$name.':'.$problemID.':'.$part.':timestamp'}++;
  967: 
  968:                 foreach my $response (split(':', $data->{$sequence.':'.
  969:                                                          $problemID.':'.
  970:                                                          $part.':responseIDs'})) {
  971:                     $output->{$name.':'.$problemID.':'.$part.':'.$response.
  972:                               ':submission'}=join(':::',@submissions);
  973: 		    $allkeys{$name.':'.$problemID.':'.$part.':'.$response.
  974: 			     ':submission'}++;
  975:                 }
  976: 
  977:                 if($partData{$part.':code'} ne 'x') {
  978:                     $totalProblems++;
  979:                 }
  980:             }
  981:         }
  982: 
  983:         $output->{$name.':'.$sequence.':problemsCorrect'} = $problemsCorrect;
  984: 	$allkeys{$name.':'.$sequence.':problemsCorrect'}++;
  985:         $problemsSolved += $problemsCorrect;
  986: 	$problemsCorrect=0;
  987:     }
  988: 
  989:     $output->{$name.':problemsSolved'} = $problemsSolved;
  990:     $output->{$name.':totalProblems'} = $totalProblems;
  991:     $output->{$name.':totalAwarded'} = $totalAwarded;
  992:     $allkeys{$name.':problemsSolved'}++;
  993:     $allkeys{$name.':totalProblems'}++;
  994:     $allkeys{$name.':totalAwarded'}++;
  995: 
  996:     $output->{$name.':keys'} = join(':::', keys(%allkeys));
  997: 
  998:     return;
  999: }
 1000: 
 1001: sub LoadDiscussion {
 1002:     my ($courseID)=@_;
 1003:     my %Discuss=();
 1004:     my %contrib=&Apache::lonnet::dump(
 1005:                 $courseID,
 1006:                 $ENV{'course.'.$courseID.'.domain'},
 1007:                 $ENV{'course.'.$courseID.'.num'});
 1008: 				 
 1009:     #my %contrib=&DownloadCourseInformation($name, $courseID, 0);
 1010: 
 1011:     foreach my $temp(keys %contrib) {
 1012: 	if ($temp=~/^version/) {
 1013: 	    my $ver=$contrib{$temp};
 1014: 	    my ($dummy,$prb)=split(':',$temp);
 1015: 	    for (my $idx=1; $idx<=$ver; $idx++ ) {
 1016: 		my $name=$contrib{"$idx:$prb:sendername"};
 1017: 		$Discuss{"$name:$prb"}=$idx;	
 1018: 	    }
 1019: 	}
 1020:     }       
 1021: 
 1022:     return \%Discuss;
 1023: }
 1024: 
 1025: # ----- END PROCESSING FUNCTIONS ---------------------------------------
 1026: 
 1027: =pod
 1028: 
 1029: =head1 HELPER FUNCTIONS
 1030: 
 1031: These are just a couple of functions do various odd and end 
 1032: jobs.  There was also a couple of bulk functions added.  These are
 1033: &DownloadStudentCourseData(), &DownloadStudentCourseDataSeparate(), and
 1034: &CheckForResidualDownload().  These functions now act as the interface
 1035: for downloading student course data.  The statistical modules should
 1036: no longer make the calls to dump and download and process etc.  They
 1037: make calls to these bulk functions to get their data.
 1038: 
 1039: =cut
 1040: 
 1041: # ----- HELPER FUNCTIONS -----------------------------------------------
 1042: 
 1043: sub CheckDateStampError {
 1044:     my ($courseData, $cache, $name)=@_;
 1045:     if($courseData->{$name.':UpToDate'} eq 'true') {
 1046:         $cache->{$name.':lastDownloadTime'} = 
 1047:             $courseData->{$name.':lastDownloadTime'};
 1048:         if($courseData->{$name.':lastDownloadTime'} eq 'Not downloaded') {
 1049:             $cache->{$name.':updateTime'} = ' Not updated';
 1050:         } else {
 1051:             $cache->{$name.':updateTime'}=
 1052:                 localtime($courseData->{$name.':lastDownloadTime'});
 1053:         }
 1054:         return 0;
 1055:     }
 1056: 
 1057:     $cache->{$name.':lastDownloadTime'}=$courseData->{$name.':lastDownloadTime'};
 1058:     if($courseData->{$name.':lastDownloadTime'} eq 'Not downloaded') {
 1059:         $cache->{$name.':updateTime'} = ' Not updated';
 1060:     } else {
 1061:         $cache->{$name.':updateTime'}=
 1062:             localtime($courseData->{$name.':lastDownloadTime'});
 1063:     }
 1064: 
 1065:     if(defined($courseData->{$name.':error'})) {
 1066:         $cache->{$name.':error'}=$courseData->{$name.':error'};
 1067:         return 0;
 1068:     }
 1069: 
 1070:     return 1;
 1071: }
 1072: 
 1073: =pod
 1074: 
 1075: =item &ProcessFullName()
 1076: 
 1077: Takes lastname, generation, firstname, and middlename (or some partial
 1078: set of this data) and returns the full name version as a string.  Format
 1079: is Lastname generation, firstname middlename or a subset of this.
 1080: 
 1081: =cut
 1082: 
 1083: sub ProcessFullName {
 1084:     my ($lastname, $generation, $firstname, $middlename)=@_;
 1085:     my $Str = '';
 1086: 
 1087:     if($lastname ne '') {
 1088: 	$Str .= $lastname.' ';
 1089: 	if($generation ne '') {
 1090: 	    $Str .= $generation;
 1091: 	} else {
 1092: 	    chop($Str);
 1093: 	}
 1094: 	$Str .= ', ';
 1095: 	if($firstname ne '') {
 1096: 	    $Str .= $firstname.' ';
 1097: 	}
 1098: 	if($middlename ne '') {
 1099: 	    $Str .= $middlename;
 1100: 	} else {
 1101: 	    chop($Str);
 1102: 	    if($firstname eq '') {
 1103: 		chop($Str);
 1104: 	    }
 1105: 	}
 1106:     } else {
 1107: 	if($firstname ne '') {
 1108: 	    $Str .= $firstname.' ';
 1109: 	}
 1110: 	if($middlename ne '') {
 1111: 	    $Str .= $middlename.' ';
 1112: 	}
 1113: 	if($generation ne '') {
 1114: 	    $Str .= $generation;
 1115: 	} else {
 1116: 	    chop($Str);
 1117: 	}
 1118:     }
 1119: 
 1120:     return $Str;
 1121: }
 1122: 
 1123: =pod
 1124: 
 1125: =item &TestCacheData()
 1126: 
 1127: Determine if the cache database can be accessed with a tie.  It waits up to
 1128: ten seconds before returning failure.  This function exists to help with
 1129: the problems with stopping the data download.  When an abort occurs and the
 1130: user quickly presses a form button and httpd child is created.  This
 1131: child needs to wait for the other to finish (hopefully within ten seconds).
 1132: 
 1133: =over 4
 1134: 
 1135: Input: $ChartDB
 1136: 
 1137: $ChartDB: The name of the cache database to be opened
 1138: 
 1139: Output: -1, 0, 1
 1140: 
 1141: -1: Could not tie database
 1142:  0: Use cached data
 1143:  1: New cache database created, use that.
 1144: 
 1145: =back
 1146: 
 1147: =cut
 1148: 
 1149: sub TestCacheData {
 1150:     my ($ChartDB,$isRecalculate,$totalDelay)=@_;
 1151:     my $isCached=-1;
 1152:     my %testData;
 1153:     my $tieTries=0;
 1154: 
 1155:     if(!defined($totalDelay)) {
 1156:         $totalDelay = 10;
 1157:     }
 1158: 
 1159:     if ((-e "$ChartDB") && (!$isRecalculate)) {
 1160: 	$isCached = 1;
 1161:     } else {
 1162: 	$isCached = 0;
 1163:     }
 1164: 
 1165:     while($tieTries < $totalDelay) {
 1166:         my $result=0;
 1167:         if($isCached) {
 1168:             $result=tie(%testData,'GDBM_File',$ChartDB,&GDBM_READER(),0640);
 1169:         } else {
 1170:             $result=tie(%testData,'GDBM_File',$ChartDB,&GDBM_NEWDB(),0640);
 1171:         }
 1172:         if($result) {
 1173:             last;
 1174:         }
 1175:         $tieTries++;
 1176:         sleep 1;
 1177:     }
 1178:     if($tieTries >= $totalDelay) {
 1179:         return -1;
 1180:     }
 1181: 
 1182:     untie(%testData);
 1183: 
 1184:     return $isCached;
 1185: }
 1186: 
 1187: sub DownloadStudentCourseData {
 1188:     my ($students,$checkDate,$cacheDB,$extract,$status,$courseID,$r,$c)=@_;
 1189: 
 1190:     my $title = 'LON-CAPA Statistics';
 1191:     my $heading = 'Download and Process Course Data';
 1192:     my $studentCount = scalar(@$students);
 1193: 
 1194:     my $WhatIWant;
 1195:     $WhatIWant = '(^version:|';
 1196:     $WhatIWant .= '^\d+:.+?:(resource\.\d+\.';
 1197:     $WhatIWant .= '(solved|tries|previous|awarded|(\d+\.submission))\s*$';
 1198:     $WhatIWant .= '|timestamp)';
 1199:     $WhatIWant .= ')';
 1200: #    $WhatIWant = '.';
 1201: 
 1202:     if($status eq 'true') {
 1203:         &Apache::lonhtmlcommon::Create_PrgWin($r, $title, $heading);
 1204:     }
 1205: 
 1206:     my $displayString;
 1207:     my $count=0;
 1208:     foreach (@$students) {
 1209:         my %cache;
 1210: 
 1211:         if($c->aborted()) { return 'Aborted'; }
 1212: 
 1213:         if($status eq 'true') {
 1214:             $count++;
 1215:             my $displayString = $count.'/'.$studentCount.': '.$_;
 1216:             &Apache::lonhtmlcommon::Update_PrgWin($displayString, $r);
 1217:         }
 1218: 
 1219:         my $downloadTime='Not downloaded';
 1220:         my $needUpdate = 'false';
 1221:         if($checkDate eq 'true'  && 
 1222:            tie(%cache,'GDBM_File',$cacheDB,&GDBM_READER(),0640)) {
 1223:             $downloadTime = $cache{$_.':lastDownloadTime'};
 1224:             $needUpdate = $cache{'ResourceUpdated'};
 1225:             untie(%cache);
 1226:         }
 1227: 
 1228:         if($c->aborted()) { return 'Aborted'; }
 1229: 
 1230:         if($needUpdate eq 'true') {
 1231:             $downloadTime = 'Not downloaded';
 1232: 	}
 1233: 	my $courseData = 
 1234: 	    &DownloadCourseInformation($_, $courseID, $downloadTime, 
 1235: 				       $WhatIWant);
 1236: 	if(tie(%cache,'GDBM_File',$cacheDB,&GDBM_WRCREAT(),0640)) {
 1237: 	    foreach my $key (keys(%$courseData)) {
 1238: 		if($key =~ /^(con_lost|error|no_such_host)/i) {
 1239: 		    $courseData->{$_.':error'} = 'No course data for '.$_;
 1240: 		    last;
 1241: 		}
 1242: 	    }
 1243: 	    if($extract eq 'true') {
 1244: 		&ExtractStudentData($courseData, \%cache, \%cache, $_);
 1245: 	    } else {
 1246: 		&ProcessStudentData(\%cache, $courseData, $_);
 1247: 	    }
 1248: 	    untie(%cache);
 1249: 	} else {
 1250: 	    next;
 1251: 	}
 1252:     }
 1253:     if($status eq 'true') { &Apache::lonhtmlcommon::Close_PrgWin($r); }
 1254: 
 1255:     return 'OK';
 1256: }
 1257: 
 1258: sub DownloadStudentCourseDataSeparate {
 1259:     my ($students,$checkDate,$cacheDB,$extract,$status,$courseID,$r,$c)=@_;
 1260:     my $residualFile = '/home/httpd/perl/tmp/'.$courseID.'DownloadFile.db';
 1261:     my $title = 'LON-CAPA Statistics';
 1262:     my $heading = 'Download Course Data';
 1263: 
 1264:     my $WhatIWant;
 1265:     $WhatIWant = '(^version:|';
 1266:     $WhatIWant .= '^\d+:.+?:(resource\.\d+\.';
 1267:     $WhatIWant .= '(solved|tries|previous|awarded|(\d+\.submission))\s*$';
 1268:     $WhatIWant .= '|timestamp)';
 1269:     $WhatIWant .= ')';
 1270: 
 1271:     &CheckForResidualDownload($cacheDB, 'true', 'true', $courseID, $r, $c);
 1272: 
 1273:     my $studentCount = scalar(@$students);
 1274:     if($status eq 'true') {
 1275:         &Apache::lonhtmlcommon::Create_PrgWin($r, $title, $heading);
 1276:     }
 1277:     my $count=0;
 1278:     my $displayString='';
 1279:     foreach (@$students) {
 1280:         if($c->aborted()) {
 1281:             return 'Aborted';
 1282:         }
 1283: 
 1284:         if($status eq 'true') {
 1285:             $count++;
 1286:             $displayString = $count.'/'.$studentCount.': '.$_;
 1287:             &Apache::lonhtmlcommon::Update_PrgWin($displayString, $r);
 1288:         }
 1289: 
 1290:         my %cache;
 1291:         my $downloadTime='Not downloaded';
 1292:         my $needUpdate = 'false';
 1293:         if($checkDate eq 'true'  && 
 1294:            tie(%cache,'GDBM_File',$cacheDB,&GDBM_READER(),0640)) {
 1295:             $downloadTime = $cache{$_.':lastDownloadTime'};
 1296:             $needUpdate = $cache{'ResourceUpdated'};
 1297:             untie(%cache);
 1298:         }
 1299: 
 1300:         if($c->aborted()) {
 1301:             return 'Aborted';
 1302:         }
 1303: 
 1304:         if($needUpdate eq 'true') {
 1305:             $downloadTime = 'Not downloaded';
 1306: 	}
 1307: 
 1308:         my $error = 0;
 1309:         my $courseData = 
 1310:             &DownloadCourseInformation($_, $courseID, $downloadTime,
 1311:                                        $WhatIWant);
 1312:         my %downloadData;
 1313:         unless(tie(%downloadData,'GDBM_File',$residualFile,
 1314:                    &GDBM_WRCREAT(),0640)) {
 1315:             return 'Failed to tie temporary download hash.';
 1316:         }
 1317:         foreach my $key (keys(%$courseData)) {
 1318:             $downloadData{$key} = $courseData->{$key};
 1319:             if($key =~ /^(con_lost|error|no_such_host)/i) {
 1320:                 $error = 1;
 1321:                 last;
 1322:             }
 1323:         }
 1324:         if($error) {
 1325:             foreach my $deleteKey (keys(%$courseData)) {
 1326:                 delete $downloadData{$deleteKey};
 1327:             }
 1328:             $downloadData{$_.':error'} = 'No course data for '.$_;
 1329:         }
 1330:         untie(%downloadData);
 1331:     }
 1332:     if($status eq 'true') { &Apache::lonhtmlcommon::Close_PrgWin($r); }
 1333: 
 1334:     return &CheckForResidualDownload($cacheDB, 'true', 'true', 
 1335:                                      $courseID, $r, $c);
 1336: }
 1337: 
 1338: sub CheckForResidualDownload {
 1339:     my ($cacheDB,$extract,$status,$courseID,$r,$c)=@_;
 1340: 
 1341:     my $residualFile = '/home/httpd/perl/tmp/'.$courseID.'DownloadFile.db';
 1342:     if(!-e $residualFile) {
 1343:         return 'OK';
 1344:     }
 1345: 
 1346:     my %downloadData;
 1347:     my %cache;
 1348:     unless(tie(%downloadData,'GDBM_File',$residualFile,&GDBM_READER(),0640)) {
 1349:         return 'Can not tie database for check for residual download: tempDB';
 1350:     }
 1351:     unless(tie(%cache,'GDBM_File',$cacheDB,&GDBM_WRCREAT(),0640)) {
 1352:         untie(%downloadData);
 1353:         return 'Can not tie database for check for residual download: cacheDB';
 1354:     }
 1355: 
 1356:     my @students=();
 1357:     my %checkStudent;
 1358:     my $key;
 1359:     while(($key, undef) = each %downloadData) {
 1360:         my @temp = split(':', $key);
 1361:         my $student = $temp[0].':'.$temp[1];
 1362:         if(!defined($checkStudent{$student})) {
 1363:             $checkStudent{$student}++;
 1364:             push(@students, $student);
 1365:         }
 1366:     }
 1367: 
 1368:     my $heading = 'Process Course Data';
 1369:     my $title = 'LON-CAPA Statistics';
 1370:     my $studentCount = scalar(@students);
 1371:     if($status eq 'true') {
 1372:         &Apache::lonhtmlcommon::Create_PrgWin($r, $title, $heading);
 1373:     }
 1374: 
 1375:     my $count=1;
 1376:     foreach my $name (@students) {
 1377:         last if($c->aborted());
 1378: 
 1379:         if($status eq 'true') {
 1380:             my $displayString = $count.'/'.$studentCount.': '.$name;
 1381:             &Apache::lonhtmlcommon::Update_PrgWin($displayString, $r);
 1382:         }
 1383: 
 1384:         if($extract eq 'true') {
 1385:             &ExtractStudentData(\%downloadData, \%cache, \%cache, $name);
 1386:         } else {
 1387:             &ProcessStudentData(\%cache, \%downloadData, $name);
 1388:         }
 1389:         $count++;
 1390:     }
 1391: 
 1392:     if($status eq 'true') { &Apache::lonhtmlcommon::Close_PrgWin($r); }
 1393: 
 1394:     untie(%cache);
 1395:     untie(%downloadData);
 1396: 
 1397:     if(!$c->aborted()) {
 1398:         my @files = ($residualFile);
 1399:         unlink(@files);
 1400:     }
 1401: 
 1402:     return 'OK';
 1403: }
 1404: 
 1405: # ----- END HELPER FUNCTIONS --------------------------------------------
 1406: 
 1407: 1;
 1408: __END__

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