File:  [LON-CAPA] / loncom / interface / loncoursedata.pm
Revision 1.31: download - view: text, annotated - select for diffs
Sat Sep 14 18:57:59 2002 UTC (21 years, 9 months ago) by www
Branches: MAIN
CVS tags: HEAD
Should call 'clutter' (which adds /res/ if necessary) instead of adding
it by hand.

    1: # The LearningOnline Network with CAPA
    2: # (Publication Handler
    3: #
    4: # $Id: loncoursedata.pm,v 1.31 2002/09/14 18:57:59 www 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.
  590: 
  591: =back
  592: 
  593: =cut
  594: 
  595: sub ProcessClasslist {
  596:     my ($cache,$classlist,$courseID,$c)=@_;
  597:     my @names=();
  598: 
  599:     $cache->{'ClasslistTimeStamp'}=$classlist->{'lastDownloadTime'};
  600:     if($classlist->{'UpToDate'} eq 'true') {
  601:         return split(/:::/,$cache->{'NamesOfStudents'});;
  602:     }
  603: 
  604:     foreach my $name (keys(%$classlist)) {
  605:         if($name =~ /\:section/ || $name =~ /\:studentInformation/ ||
  606:            $name eq '' || $name eq 'UpToDate' || $name eq 'lastDownloadTime') {
  607:             next;
  608:         }
  609:         if($c->aborted()) {
  610:             return ();
  611:         }
  612:         my $studentInformation = $classlist->{$name.':studentInformation'},
  613:         my $sectionData = $classlist->{$name.':sections'},
  614:         my $date = $classlist->{$name},
  615:         my ($studentName,$studentDomain) = split(/\:/,$name);
  616: 
  617:         $cache->{$name.':username'}=$studentName;
  618:         $cache->{$name.':domain'}=$studentDomain;
  619:         # Initialize timestamp for student
  620:         if(!defined($cache->{$name.':lastDownloadTime'})) {
  621:             $cache->{$name.':lastDownloadTime'}='Not downloaded';
  622:             $cache->{$name.':updateTime'}=' Not updated';
  623:         }
  624: 
  625:         my $error = 0;
  626:         foreach(keys(%$studentInformation)) {
  627:             if(/^(con_lost|error|no_such_host)/i) {
  628:                 $cache->{$name.':error'}=
  629:                     'Could not download student environment data.';
  630:                 $cache->{$name.':fullname'}='';
  631:                 $cache->{$name.':id'}='';
  632:                 $error = 1;
  633:             }
  634:         }
  635:         next if($error);
  636:         push(@names,$name);
  637:         $cache->{$name.':fullname'}=&ProcessFullName(
  638:                                           $studentInformation->{'lastname'},
  639:                                           $studentInformation->{'generation'},
  640:                                           $studentInformation->{'firstname'},
  641:                                           $studentInformation->{'middlename'});
  642:         $cache->{$name.':id'}=$studentInformation->{'id'};
  643: 
  644:         my ($end, $start)=split(':',$date);
  645:         $courseID=~s/\_/\//g;
  646:         $courseID=~s/^(\w)/\/$1/;
  647: 
  648:         my $sec='';
  649:         foreach my $key (keys (%$sectionData)) {
  650:             my $value = $sectionData->{$key};
  651:             if ($key=~/^$courseID(?:\/)*(\w+)*\_st$/) {
  652:                 my $tempsection=$1;
  653:                 if($key eq $courseID.'_st') {
  654:                     $tempsection='';
  655:                 }
  656:                 my ($dummy,$roleend,$rolestart)=split(/\_/,$value);
  657:                 if($roleend eq $end && $rolestart eq $start) {
  658:                     $sec = $tempsection;
  659:                     last;
  660:                 }
  661:             }
  662:         }
  663: 
  664:         my $status='Expired';
  665:         if(((!$end) || time < $end) && ((!$start) || (time > $start))) {
  666:             $status='Active';
  667:         }
  668:         $cache->{$name.':Status'}=$status;
  669:         $cache->{$name.':section'}=$sec;
  670: 
  671:         if($sec eq '' || !defined($sec) || $sec eq ' ') {
  672:             $sec = 'none';
  673:         }
  674:         if(defined($cache->{'sectionList'})) {
  675:             if($cache->{'sectionList'} !~ /(^$sec:|^$sec$|:$sec$|:$sec:)/) {
  676:                 $cache->{'sectionList'} .= ':'.$sec;
  677:             }
  678:         } else {
  679:             $cache->{'sectionList'} = $sec;
  680:         }
  681:     }
  682: 
  683:     $cache->{'ClasslistTimestamp'}=time;
  684:     $cache->{'NamesOfStudents'}=join(':::',@names);
  685: 
  686:     return @names;
  687: }
  688: 
  689: =pod
  690: 
  691: =item &ProcessStudentData()
  692: 
  693: Takes the course data downloaded for a student in 
  694: &DownloadCourseInformation() and breaks it up into key value pairs
  695: to be stored in the cached data.  The keys are comprised of the 
  696: $username:$domain:$keyFromCourseDatabase.  The student username:domain is
  697: stored away signifying that the students information has been downloaded and 
  698: can be reused from cached data.
  699: 
  700: =over 4
  701: 
  702: Input: $cache, $courseData, $name
  703: 
  704: $cache: A hash pointer to store data
  705: 
  706: $courseData:  A hash pointer that points to the course data downloaded for a 
  707: student.
  708: 
  709: $name:  username:domain
  710: 
  711: Output: None
  712: 
  713: *NOTE:  There is no output, but an error message is stored away in the cache 
  714: data.  This is checked in &FormatStudentData().  The key username:domain:error 
  715: will only exist if an error occured.  The error is an error from 
  716: &DownloadCourseInformation().
  717: 
  718: =back
  719: 
  720: =cut
  721: 
  722: sub ProcessStudentData {
  723:     my ($cache,$courseData,$name)=@_;
  724: 
  725:     if(!&CheckDateStampError($courseData, $cache, $name)) {
  726:         return;
  727:     }
  728: 
  729:     # This little delete thing, should not be here.  Move some other
  730:     # time though.
  731:     if(defined($cache->{$name.':keys'})) {
  732: 	foreach (split(':::', $cache->{$name.':keys'})) {
  733: 	    delete $cache->{$name.':'.$_};
  734: 	}
  735:         delete $cache->{$name.':keys'};
  736:     }
  737: 
  738:     my %courseKeys;
  739:     # user name:domain was prepended earlier in DownloadCourseInformation
  740:     foreach (keys %$courseData) {
  741: 	my $currentKey = $_;
  742: 	$currentKey =~ s/^$name//;
  743: 	$courseKeys{$currentKey}++;
  744:         $cache->{$_}=$courseData->{$_};
  745:     }
  746: 
  747:     $cache->{$name.':keys'} = join(':::', keys(%courseKeys));
  748: 
  749:     return;
  750: }
  751: 
  752: =pod
  753: 
  754: =item &ExtractStudentData()
  755: 
  756: HISTORY: This function originally existed in every statistics module,
  757: and performed different tasks, the had some overlap.  Due to the need
  758: for the data from the different modules, they were combined into
  759: a single function.
  760: 
  761: This function now extracts all the necessary course data for a student
  762: from what was downloaded from their homeserver.  There is some extra
  763: time overhead compared to the ProcessStudentInformation function, but
  764: it would have had to occurred at some point anyways.  This is now
  765: typically called while downloading the data it will process.  It is
  766: the brother function to ProcessStudentInformation.
  767: 
  768: =over 4
  769: 
  770: Input: $input, $output, $data, $name
  771: 
  772: $input: A hash that contains the input data to be processed
  773: 
  774: $output: A hash to contain the processed data
  775: 
  776: $data: A hash containing the information on what is to be
  777: processed and how (basically).
  778: 
  779: $name:  username:domain
  780: 
  781: The input is slightly different here, but is quite simple.
  782: It is currently used where the $input, $output, and $data
  783: can and are often the same hashes, but they do not need
  784: to be.
  785: 
  786: Output: None
  787: 
  788: *NOTE:  There is no output, but an error message is stored away in the cache 
  789: data.  This is checked in &FormatStudentData().  The key username:domain:error 
  790: will only exist if an error occured.  The error is an error from 
  791: &DownloadCourseInformation().
  792: 
  793: =back
  794: 
  795: =cut
  796: 
  797: sub ExtractStudentData {
  798:     my ($input, $output, $data, $name)=@_;
  799: 
  800:     if(!&CheckDateStampError($input, $data, $name)) {
  801:         return;
  802:     }
  803: 
  804:     # This little delete thing, should not be here.  Move some other
  805:     # time though.
  806:     my %allkeys;
  807:     if(defined($output->{$name.':keys'})) {
  808: 	foreach (split(':::', $output->{$name.':keys'})) {
  809: 	    delete $output->{$name.':'.$_};
  810: 	}
  811:         delete $output->{$name.':keys'};
  812:     }
  813: 
  814:     my ($username,$domain)=split(':',$name);
  815: 
  816:     my $Version;
  817:     my $problemsCorrect = 0;
  818:     my $totalProblems   = 0;
  819:     my $problemsSolved  = 0;
  820:     my $numberOfParts   = 0;
  821:     my $totalAwarded    = 0;
  822:     foreach my $sequence (split(':', $data->{'orderedSequences'})) {
  823:         foreach my $problemID (split(':', $data->{$sequence.':problems'})) {
  824:             my $problem = $data->{$problemID.':problem'};
  825:             my $LatestVersion = $input->{$name.':version:'.$problem};
  826: 
  827:             # Output dashes for all the parts of this problem if there
  828:             # is no version information about the current problem.
  829:             $output->{$name.':'.$problemID.':NoVersion'} = 'false';
  830:             $allkeys{$name.':'.$problemID.':NoVersion'}++;
  831:             if(!$LatestVersion) {
  832:                 foreach my $part (split(/\:/,$data->{$sequence.':'.
  833:                                                       $problemID.
  834:                                                       ':parts'})) {
  835:                     $output->{$name.':'.$problemID.':'.$part.':tries'} = 0;
  836:                     $output->{$name.':'.$problemID.':'.$part.':awarded'} = 0;
  837:                     $output->{$name.':'.$problemID.':'.$part.':code'} = ' ';
  838: 		    $allkeys{$name.':'.$problemID.':'.$part.':tries'}++;
  839: 		    $allkeys{$name.':'.$problemID.':'.$part.':awarded'}++;
  840: 		    $allkeys{$name.':'.$problemID.':'.$part.':code'}++;
  841:                     $totalProblems++;
  842:                 }
  843:                 $output->{$name.':'.$problemID.':NoVersion'} = 'true';
  844:                 next;
  845:             }
  846: 
  847:             my %partData=undef;
  848:             # Initialize part data, display skips correctly
  849:             # Skip refers to when a student made no submissions on that
  850:             # part/problem.
  851:             foreach my $part (split(/\:/,$data->{$sequence.':'.
  852:                                                  $problemID.
  853:                                                  ':parts'})) {
  854:                 $partData{$part.':tries'}=0;
  855:                 $partData{$part.':code'}=' ';
  856:                 $partData{$part.':awarded'}=0;
  857:                 $partData{$part.':timestamp'}=0;
  858:                 foreach my $response (split(':', $data->{$sequence.':'.
  859:                                                          $problemID.':'.
  860:                                                          $part.':responseIDs'})) {
  861:                     $partData{$part.':'.$response.':submission'}='';
  862:                 }
  863:             }
  864: 
  865:             # Looping through all the versions of each part, starting with the
  866:             # oldest version.  Basically, it gets the most recent 
  867:             # set of grade data for each part.
  868:             my @submissions = ();
  869: 	    for(my $Version=1; $Version<=$LatestVersion; $Version++) {
  870:                 foreach my $part (split(/\:/,$data->{$sequence.':'.
  871:                                                      $problemID.
  872:                                                      ':parts'})) {
  873: 
  874:                     if(!defined($input->{"$name:$Version:$problem".
  875:                                          ":resource.$part.solved"})) {
  876:                         # No grade for this submission, so skip
  877:                         next;
  878:                     }
  879: 
  880:                     my $tries=0;
  881:                     my $code=' ';
  882:                     my $awarded=0;
  883: 
  884:                     $tries = $input->{$name.':'.$Version.':'.$problem.
  885:                                       ':resource.'.$part.'.tries'};
  886:                     $awarded = $input->{$name.':'.$Version.':'.$problem.
  887:                                         ':resource.'.$part.'.awarded'};
  888: 
  889:                     $partData{$part.':awarded'}=($awarded) ? $awarded : 0;
  890:                     $partData{$part.':tries'}=($tries) ? $tries : 0;
  891: 
  892:                     $partData{$part.':timestamp'}=$input->{$name.':'.$Version.':'.
  893:                                                            $problem.
  894:                                                            ':timestamp'};
  895:                     if(!$input->{$name.':'.$Version.':'.$problem.':resource.'.$part.
  896:                                  '.previous'}) {
  897:                         foreach my $response (split(':',
  898:                                                    $data->{$sequence.':'.
  899:                                                            $problemID.':'.
  900:                                                            $part.':responseIDs'})) {
  901:                             @submissions=($input->{$name.':'.$Version.':'.
  902:                                                    $problem.
  903:                                                    ':resource.'.$part.'.'.
  904:                                                    $response.'.submission'},
  905:                                           @submissions);
  906:                         }
  907:                     }
  908: 
  909:                     my $val = $input->{$name.':'.$Version.':'.$problem.
  910:                                        ':resource.'.$part.'.solved'};
  911:                     if    ($val eq 'correct_by_student')   {$code = '*';} 
  912:                     elsif ($val eq 'correct_by_override')  {$code = '+';}
  913:                     elsif ($val eq 'incorrect_attempted')  {$code = '.';} 
  914:                     elsif ($val eq 'incorrect_by_override'){$code = '-';}
  915:                     elsif ($val eq 'excused')              {$code = 'x';}
  916:                     elsif ($val eq 'ungraded_attempted')   {$code = '#';}
  917:                     else                                   {$code = ' ';}
  918:                     $partData{$part.':code'}=$code;
  919:                 }
  920:             }
  921: 
  922:             foreach my $part (split(/\:/,$data->{$sequence.':'.$problemID.
  923:                                                  ':parts'})) {
  924:                 $output->{$name.':'.$problemID.':'.$part.':wrong'} = 
  925:                     $partData{$part.':tries'};
  926: 		$allkeys{$name.':'.$problemID.':'.$part.':wrong'}++;
  927: 
  928:                 if($partData{$part.':code'} eq '*') {
  929:                     $output->{$name.':'.$problemID.':'.$part.':wrong'}--;
  930:                     $problemsCorrect++;
  931:                 } elsif($partData{$part.':code'} eq '+') {
  932:                     $output->{$name.':'.$problemID.':'.$part.':wrong'}--;
  933:                     $problemsCorrect++;
  934:                 }
  935: 
  936:                 $output->{$name.':'.$problemID.':'.$part.':tries'} = 
  937:                     $partData{$part.':tries'};
  938:                 $output->{$name.':'.$problemID.':'.$part.':code'} =
  939:                     $partData{$part.':code'};
  940:                 $output->{$name.':'.$problemID.':'.$part.':awarded'} =
  941:                     $partData{$part.':awarded'};
  942: 		$allkeys{$name.':'.$problemID.':'.$part.':tries'}++;
  943: 		$allkeys{$name.':'.$problemID.':'.$part.':code'}++;
  944: 		$allkeys{$name.':'.$problemID.':'.$part.':awarded'}++;
  945: 
  946:                 $totalAwarded += $partData{$part.':awarded'};
  947:                 $output->{$name.':'.$problemID.':'.$part.':timestamp'} =
  948:                     $partData{$part.':timestamp'};
  949: 		$allkeys{$name.':'.$problemID.':'.$part.':timestamp'}++;
  950: 
  951:                 foreach my $response (split(':', $data->{$sequence.':'.
  952:                                                          $problemID.':'.
  953:                                                          $part.':responseIDs'})) {
  954:                     $output->{$name.':'.$problemID.':'.$part.':'.$response.
  955:                               ':submission'}=join(':::',@submissions);
  956: 		    $allkeys{$name.':'.$problemID.':'.$part.':'.$response.
  957: 			     ':submission'}++;
  958:                 }
  959: 
  960:                 if($partData{$part.':code'} ne 'x') {
  961:                     $totalProblems++;
  962:                 }
  963:             }
  964:         }
  965: 
  966:         $output->{$name.':'.$sequence.':problemsCorrect'} = $problemsCorrect;
  967: 	$allkeys{$name.':'.$sequence.':problemsCorrect'}++;
  968:         $problemsSolved += $problemsCorrect;
  969: 	$problemsCorrect=0;
  970:     }
  971: 
  972:     $output->{$name.':problemsSolved'} = $problemsSolved;
  973:     $output->{$name.':totalProblems'} = $totalProblems;
  974:     $output->{$name.':totalAwarded'} = $totalAwarded;
  975:     $allkeys{$name.':problemsSolved'}++;
  976:     $allkeys{$name.':totalProblems'}++;
  977:     $allkeys{$name.':totalAwarded'}++;
  978: 
  979:     $output->{$name.':keys'} = join(':::', keys(%allkeys));
  980: 
  981:     return;
  982: }
  983: 
  984: sub LoadDiscussion {
  985:     my ($courseID)=@_;
  986:     my %Discuss=();
  987:     my %contrib=&Apache::lonnet::dump(
  988:                 $courseID,
  989:                 $ENV{'course.'.$courseID.'.domain'},
  990:                 $ENV{'course.'.$courseID.'.num'});
  991: 				 
  992:     #my %contrib=&DownloadCourseInformation($name, $courseID, 0);
  993: 
  994:     foreach my $temp(keys %contrib) {
  995: 	if ($temp=~/^version/) {
  996: 	    my $ver=$contrib{$temp};
  997: 	    my ($dummy,$prb)=split(':',$temp);
  998: 	    for (my $idx=1; $idx<=$ver; $idx++ ) {
  999: 		my $name=$contrib{"$idx:$prb:sendername"};
 1000: 		$Discuss{"$name:$prb"}=$idx;	
 1001: 	    }
 1002: 	}
 1003:     }       
 1004: 
 1005:     return \%Discuss;
 1006: }
 1007: 
 1008: # ----- END PROCESSING FUNCTIONS ---------------------------------------
 1009: 
 1010: =pod
 1011: 
 1012: =head1 HELPER FUNCTIONS
 1013: 
 1014: These are just a couple of functions do various odd and end 
 1015: jobs.  There was also a couple of bulk functions added.  These are
 1016: &DownloadStudentCourseData(), &DownloadStudentCourseDataSeparate(), and
 1017: &CheckForResidualDownload().  These functions now act as the interface
 1018: for downloading student course data.  The statistical modules should
 1019: no longer make the calls to dump and download and process etc.  They
 1020: make calls to these bulk functions to get their data.
 1021: 
 1022: =cut
 1023: 
 1024: # ----- HELPER FUNCTIONS -----------------------------------------------
 1025: 
 1026: sub CheckDateStampError {
 1027:     my ($courseData, $cache, $name)=@_;
 1028:     if($courseData->{$name.':UpToDate'} eq 'true') {
 1029:         $cache->{$name.':lastDownloadTime'} = 
 1030:             $courseData->{$name.':lastDownloadTime'};
 1031:         if($courseData->{$name.':lastDownloadTime'} eq 'Not downloaded') {
 1032:             $cache->{$name.':updateTime'} = ' Not updated';
 1033:         } else {
 1034:             $cache->{$name.':updateTime'}=
 1035:                 localtime($courseData->{$name.':lastDownloadTime'});
 1036:         }
 1037:         return 0;
 1038:     }
 1039: 
 1040:     $cache->{$name.':lastDownloadTime'}=$courseData->{$name.':lastDownloadTime'};
 1041:     if($courseData->{$name.':lastDownloadTime'} eq 'Not downloaded') {
 1042:         $cache->{$name.':updateTime'} = ' Not updated';
 1043:     } else {
 1044:         $cache->{$name.':updateTime'}=
 1045:             localtime($courseData->{$name.':lastDownloadTime'});
 1046:     }
 1047: 
 1048:     if(defined($courseData->{$name.':error'})) {
 1049:         $cache->{$name.':error'}=$courseData->{$name.':error'};
 1050:         return 0;
 1051:     }
 1052: 
 1053:     return 1;
 1054: }
 1055: 
 1056: =pod
 1057: 
 1058: =item &ProcessFullName()
 1059: 
 1060: Takes lastname, generation, firstname, and middlename (or some partial
 1061: set of this data) and returns the full name version as a string.  Format
 1062: is Lastname generation, firstname middlename or a subset of this.
 1063: 
 1064: =cut
 1065: 
 1066: sub ProcessFullName {
 1067:     my ($lastname, $generation, $firstname, $middlename)=@_;
 1068:     my $Str = '';
 1069: 
 1070:     if($lastname ne '') {
 1071: 	$Str .= $lastname.' ';
 1072: 	if($generation ne '') {
 1073: 	    $Str .= $generation;
 1074: 	} else {
 1075: 	    chop($Str);
 1076: 	}
 1077: 	$Str .= ', ';
 1078: 	if($firstname ne '') {
 1079: 	    $Str .= $firstname.' ';
 1080: 	}
 1081: 	if($middlename ne '') {
 1082: 	    $Str .= $middlename;
 1083: 	} else {
 1084: 	    chop($Str);
 1085: 	    if($firstname eq '') {
 1086: 		chop($Str);
 1087: 	    }
 1088: 	}
 1089:     } else {
 1090: 	if($firstname ne '') {
 1091: 	    $Str .= $firstname.' ';
 1092: 	}
 1093: 	if($middlename ne '') {
 1094: 	    $Str .= $middlename.' ';
 1095: 	}
 1096: 	if($generation ne '') {
 1097: 	    $Str .= $generation;
 1098: 	} else {
 1099: 	    chop($Str);
 1100: 	}
 1101:     }
 1102: 
 1103:     return $Str;
 1104: }
 1105: 
 1106: =pod
 1107: 
 1108: =item &TestCacheData()
 1109: 
 1110: Determine if the cache database can be accessed with a tie.  It waits up to
 1111: ten seconds before returning failure.  This function exists to help with
 1112: the problems with stopping the data download.  When an abort occurs and the
 1113: user quickly presses a form button and httpd child is created.  This
 1114: child needs to wait for the other to finish (hopefully within ten seconds).
 1115: 
 1116: =over 4
 1117: 
 1118: Input: $ChartDB
 1119: 
 1120: $ChartDB: The name of the cache database to be opened
 1121: 
 1122: Output: -1, 0, 1
 1123: 
 1124: -1: Could not tie database
 1125:  0: Use cached data
 1126:  1: New cache database created, use that.
 1127: 
 1128: =back
 1129: 
 1130: =cut
 1131: 
 1132: sub TestCacheData {
 1133:     my ($ChartDB,$isRecalculate,$totalDelay)=@_;
 1134:     my $isCached=-1;
 1135:     my %testData;
 1136:     my $tieTries=0;
 1137: 
 1138:     if(!defined($totalDelay)) {
 1139:         $totalDelay = 10;
 1140:     }
 1141: 
 1142:     if ((-e "$ChartDB") && (!$isRecalculate)) {
 1143: 	$isCached = 1;
 1144:     } else {
 1145: 	$isCached = 0;
 1146:     }
 1147: 
 1148:     while($tieTries < $totalDelay) {
 1149:         my $result=0;
 1150:         if($isCached) {
 1151:             $result=tie(%testData,'GDBM_File',$ChartDB,&GDBM_READER(),0640);
 1152:         } else {
 1153:             $result=tie(%testData,'GDBM_File',$ChartDB,&GDBM_NEWDB(),0640);
 1154:         }
 1155:         if($result) {
 1156:             last;
 1157:         }
 1158:         $tieTries++;
 1159:         sleep 1;
 1160:     }
 1161:     if($tieTries >= $totalDelay) {
 1162:         return -1;
 1163:     }
 1164: 
 1165:     untie(%testData);
 1166: 
 1167:     return $isCached;
 1168: }
 1169: 
 1170: sub DownloadStudentCourseData {
 1171:     my ($students,$checkDate,$cacheDB,$extract,$status,$courseID,$r,$c)=@_;
 1172: 
 1173:     my $title = 'LON-CAPA Statistics';
 1174:     my $heading = 'Download and Process Course Data';
 1175:     my $studentCount = scalar(@$students);
 1176: 
 1177:     my $WhatIWant;
 1178:     $WhatIWant = '(^version:|';
 1179:     $WhatIWant .= '^\d+:.+?:(resource\.\d+\.';
 1180:     $WhatIWant .= '(solved|tries|previous|awarded|(\d+\.submission))\s*$';
 1181:     $WhatIWant .= '|timestamp)';
 1182:     $WhatIWant .= ')';
 1183: #    $WhatIWant = '.';
 1184: 
 1185:     if($status eq 'true') {
 1186:         &Apache::lonhtmlcommon::Create_PrgWin($r, $title, $heading);
 1187:     }
 1188: 
 1189:     my $displayString;
 1190:     my $count=0;
 1191:     foreach (@$students) {
 1192:         my %cache;
 1193: 
 1194:         if($c->aborted()) { return 'Aborted'; }
 1195: 
 1196:         if($status eq 'true') {
 1197:             $count++;
 1198:             my $displayString = $count.'/'.$studentCount.': '.$_;
 1199:             &Apache::lonhtmlcommon::Update_PrgWin($displayString, $r);
 1200:         }
 1201: 
 1202:         my $downloadTime='Not downloaded';
 1203:         my $needUpdate = 'false';
 1204:         if($checkDate eq 'true'  && 
 1205:            tie(%cache,'GDBM_File',$cacheDB,&GDBM_READER(),0640)) {
 1206:             $downloadTime = $cache{$_.':lastDownloadTime'};
 1207:             $needUpdate = $cache{'ResourceUpdated'};
 1208:             untie(%cache);
 1209:         }
 1210: 
 1211:         if($c->aborted()) { return 'Aborted'; }
 1212: 
 1213:         if($needUpdate eq 'true') {
 1214:             $downloadTime = 'Not downloaded';
 1215: 	}
 1216: 	my $courseData = 
 1217: 	    &DownloadCourseInformation($_, $courseID, $downloadTime, 
 1218: 				       $WhatIWant);
 1219: 	if(tie(%cache,'GDBM_File',$cacheDB,&GDBM_WRCREAT(),0640)) {
 1220: 	    foreach my $key (keys(%$courseData)) {
 1221: 		if($key =~ /^(con_lost|error|no_such_host)/i) {
 1222: 		    $courseData->{$_.':error'} = 'No course data for '.$_;
 1223: 		    last;
 1224: 		}
 1225: 	    }
 1226: 	    if($extract eq 'true') {
 1227: 		&ExtractStudentData($courseData, \%cache, \%cache, $_);
 1228: 	    } else {
 1229: 		&ProcessStudentData(\%cache, $courseData, $_);
 1230: 	    }
 1231: 	    untie(%cache);
 1232: 	} else {
 1233: 	    next;
 1234: 	}
 1235:     }
 1236:     if($status eq 'true') { &Apache::lonhtmlcommon::Close_PrgWin($r); }
 1237: 
 1238:     return 'OK';
 1239: }
 1240: 
 1241: sub DownloadStudentCourseDataSeparate {
 1242:     my ($students,$checkDate,$cacheDB,$extract,$status,$courseID,$r,$c)=@_;
 1243:     my $residualFile = '/home/httpd/perl/tmp/'.$courseID.'DownloadFile.db';
 1244:     my $title = 'LON-CAPA Statistics';
 1245:     my $heading = 'Download Course Data';
 1246: 
 1247:     my $WhatIWant;
 1248:     $WhatIWant = '(^version:|';
 1249:     $WhatIWant .= '^\d+:.+?:(resource\.\d+\.';
 1250:     $WhatIWant .= '(solved|tries|previous|awarded|(\d+\.submission))\s*$';
 1251:     $WhatIWant .= '|timestamp)';
 1252:     $WhatIWant .= ')';
 1253: 
 1254:     &CheckForResidualDownload($cacheDB, 'true', 'true', $courseID, $r, $c);
 1255: 
 1256:     my $studentCount = scalar(@$students);
 1257:     if($status eq 'true') {
 1258:         &Apache::lonhtmlcommon::Create_PrgWin($r, $title, $heading);
 1259:     }
 1260:     my $count=0;
 1261:     my $displayString='';
 1262:     foreach (@$students) {
 1263:         if($c->aborted()) {
 1264:             return 'Aborted';
 1265:         }
 1266: 
 1267:         if($status eq 'true') {
 1268:             $count++;
 1269:             $displayString = $count.'/'.$studentCount.': '.$_;
 1270:             &Apache::lonhtmlcommon::Update_PrgWin($displayString, $r);
 1271:         }
 1272: 
 1273:         my %cache;
 1274:         my $downloadTime='Not downloaded';
 1275:         my $needUpdate = 'false';
 1276:         if($checkDate eq 'true'  && 
 1277:            tie(%cache,'GDBM_File',$cacheDB,&GDBM_READER(),0640)) {
 1278:             $downloadTime = $cache{$_.':lastDownloadTime'};
 1279:             $needUpdate = $cache{'ResourceUpdated'};
 1280:             untie(%cache);
 1281:         }
 1282: 
 1283:         if($c->aborted()) {
 1284:             return 'Aborted';
 1285:         }
 1286: 
 1287:         if($needUpdate eq 'true') {
 1288:             $downloadTime = 'Not downloaded';
 1289: 	}
 1290: 
 1291:         my $error = 0;
 1292:         my $courseData = 
 1293:             &DownloadCourseInformation($_, $courseID, $downloadTime,
 1294:                                        $WhatIWant);
 1295:         my %downloadData;
 1296:         unless(tie(%downloadData,'GDBM_File',$residualFile,
 1297:                    &GDBM_WRCREAT(),0640)) {
 1298:             return 'Failed to tie temporary download hash.';
 1299:         }
 1300:         foreach my $key (keys(%$courseData)) {
 1301:             $downloadData{$key} = $courseData->{$key};
 1302:             if($key =~ /^(con_lost|error|no_such_host)/i) {
 1303:                 $error = 1;
 1304:                 last;
 1305:             }
 1306:         }
 1307:         if($error) {
 1308:             foreach my $deleteKey (keys(%$courseData)) {
 1309:                 delete $downloadData{$deleteKey};
 1310:             }
 1311:             $downloadData{$_.':error'} = 'No course data for '.$_;
 1312:         }
 1313:         untie(%downloadData);
 1314:     }
 1315:     if($status eq 'true') { &Apache::lonhtmlcommon::Close_PrgWin($r); }
 1316: 
 1317:     return &CheckForResidualDownload($cacheDB, 'true', 'true', 
 1318:                                      $courseID, $r, $c);
 1319: }
 1320: 
 1321: sub CheckForResidualDownload {
 1322:     my ($cacheDB,$extract,$status,$courseID,$r,$c)=@_;
 1323: 
 1324:     my $residualFile = '/home/httpd/perl/tmp/'.$courseID.'DownloadFile.db';
 1325:     if(!-e $residualFile) {
 1326:         return 'OK';
 1327:     }
 1328: 
 1329:     my %downloadData;
 1330:     my %cache;
 1331:     unless(tie(%downloadData,'GDBM_File',$residualFile,&GDBM_READER(),0640)) {
 1332:         return 'Can not tie database for check for residual download: tempDB';
 1333:     }
 1334:     unless(tie(%cache,'GDBM_File',$cacheDB,&GDBM_WRCREAT(),0640)) {
 1335:         untie(%downloadData);
 1336:         return 'Can not tie database for check for residual download: cacheDB';
 1337:     }
 1338: 
 1339:     my @students=();
 1340:     my %checkStudent;
 1341:     my $key;
 1342:     while(($key, undef) = each %downloadData) {
 1343:         my @temp = split(':', $key);
 1344:         my $student = $temp[0].':'.$temp[1];
 1345:         if(!defined($checkStudent{$student})) {
 1346:             $checkStudent{$student}++;
 1347:             push(@students, $student);
 1348:         }
 1349:     }
 1350: 
 1351:     my $heading = 'Process Course Data';
 1352:     my $title = 'LON-CAPA Statistics';
 1353:     my $studentCount = scalar(@students);
 1354:     if($status eq 'true') {
 1355:         &Apache::lonhtmlcommon::Create_PrgWin($r, $title, $heading);
 1356:     }
 1357: 
 1358:     my $count=1;
 1359:     foreach my $name (@students) {
 1360:         last if($c->aborted());
 1361: 
 1362:         if($status eq 'true') {
 1363:             my $displayString = $count.'/'.$studentCount.': '.$name;
 1364:             &Apache::lonhtmlcommon::Update_PrgWin($displayString, $r);
 1365:         }
 1366: 
 1367:         if($extract eq 'true') {
 1368:             &ExtractStudentData(\%downloadData, \%cache, \%cache, $name);
 1369:         } else {
 1370:             &ProcessStudentData(\%cache, \%downloadData, $name);
 1371:         }
 1372:         $count++;
 1373:     }
 1374: 
 1375:     if($status eq 'true') { &Apache::lonhtmlcommon::Close_PrgWin($r); }
 1376: 
 1377:     untie(%cache);
 1378:     untie(%downloadData);
 1379: 
 1380:     if(!$c->aborted()) {
 1381:         my @files = ($residualFile);
 1382:         unlink(@files);
 1383:     }
 1384: 
 1385:     return 'OK';
 1386: }
 1387: 
 1388: # ----- END HELPER FUNCTIONS --------------------------------------------
 1389: 
 1390: 1;
 1391: __END__

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