File:  [LON-CAPA] / loncom / interface / loncoursedata.pm
Revision 1.29: download - view: text, annotated - select for diffs
Tue Sep 3 02:22:40 2002 UTC (21 years, 9 months ago) by albertel
Branches: MAIN
CVS tags: HEAD
- perl 5.005 desn't like the original line

    1: # The LearningOnline Network with CAPA
    2: # (Publication Handler
    3: #
    4: # $Id: loncoursedata.pm,v 1.29 2002/09/03 02:22:40 albertel 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_/res/'.$ENV{'request.course.uri'}};
  326:     push(@currentResource, $currentResourceID);
  327:     $lastResourceID=-1;
  328:     $currentSequence=-1;
  329:     my $topLevelSequenceNumber = $currentSequence;
  330: 
  331:     my %sequenceRecord;
  332:     my %allkeys;
  333:     while(1) {
  334:         if($c->aborted()) {
  335:             last;
  336:         }
  337: 	# HANDLE NEW SEQUENCE!
  338: 	#if page || sequence
  339: 	if(defined($hash{'map_pc_'.$hash{'src_'.$currentResourceID}}) &&
  340:            !defined($sequenceRecord{$currentResourceID})) {
  341:             $sequenceRecord{$currentResourceID}++;
  342: 	    push(@sequences, $currentSequence);
  343: 	    push(@currentResource, $currentResourceID);
  344: 	    push(@finishResource, $lastResourceID);
  345: 
  346: 	    $currentSequence=$hash{'map_pc_'.$hash{'src_'.$currentResourceID}};
  347: 
  348:             # Mark sequence as containing problems.  If it doesn't, then
  349:             # it will be removed when processing for this sequence is
  350:             # complete.  This allows the problems in a sequence
  351:             # to be outputed before problems in the subsequences
  352:             if(!defined($cache->{'orderedSequences'})) {
  353:                 $cache->{'orderedSequences'}=$currentSequence;
  354:             } else {
  355:                 $cache->{'orderedSequences'}.=':'.$currentSequence;
  356:             }
  357:             $allkeys{'orderedSequences'}++;
  358: 
  359: 	    $lastResourceID=$hash{'map_finish_'.
  360: 				  $hash{'src_'.$currentResourceID}};
  361: 	    $currentResourceID=$hash{'map_start_'.
  362: 				     $hash{'src_'.$currentResourceID}};
  363: 
  364: 	    if(!($currentResourceID) || !($lastResourceID)) {
  365: 		$currentSequence=pop(@sequences);
  366: 		$currentResourceID=pop(@currentResource);
  367: 		$lastResourceID=pop(@finishResource);
  368: 		if($currentSequence eq $topLevelSequenceNumber) {
  369: 		    last;
  370: 		}
  371: 	    }
  372:             next;
  373: 	}
  374: 
  375: 	# Handle gradable resources: exams, problems, etc
  376: 	$currentResourceID=~/(\d+)\.(\d+)/;
  377:         my $partA=$1;
  378:         my $partB=$2;
  379: 	if($hash{'src_'.$currentResourceID}=~
  380: 	   /\.(problem|exam|quiz|assess|survey|form)$/ &&
  381: 	   $partA eq $currentSequence && 
  382:            !defined($sequenceRecord{$currentSequence.':'.
  383:                                     $currentResourceID})) {
  384:             $sequenceRecord{$currentSequence.':'.$currentResourceID}++;
  385: 	    my $Problem = &Apache::lonnet::symbclean(
  386: 			  &Apache::lonnet::declutter($hash{'map_id_'.$partA}).
  387: 			  '___'.$partB.'___'.
  388: 			  &Apache::lonnet::declutter($hash{'src_'.
  389: 							 $currentResourceID}));
  390: 
  391: 	    $cache->{$currentResourceID.':problem'}=$Problem;
  392:             $allkeys{$currentResourceID.':problem'}++;
  393: 	    if(!defined($cache->{$currentSequence.':problems'})) {
  394: 		$cache->{$currentSequence.':problems'}=$currentResourceID;
  395: 	    } else {
  396: 		$cache->{$currentSequence.':problems'}.=
  397: 		    ':'.$currentResourceID;
  398: 	    }
  399:             $allkeys{$currentSequence.':problems'}++;
  400: 
  401: 	    my $meta=$hash{'src_'.$currentResourceID};
  402: #            $cache->{$currentResourceID.':title'}=
  403: #                &Apache::lonnet::metdata($meta,'title');
  404:             $cache->{$currentResourceID.':title'}=
  405:                 $hash{'title_'.$currentResourceID};
  406:             $allkeys{$currentResourceID.':title'}++;
  407:             $cache->{$currentResourceID.':source'}=
  408:                 $hash{'src_'.$currentResourceID};
  409:             $allkeys{$currentResourceID.':source'}++;
  410: 
  411:             # Get Parts for problem
  412:             my %beenHere;
  413:             foreach (split(/\,/,&Apache::lonnet::metadata($meta,'packages'))) {
  414:                 if(/^\w+response_\d+.*/) {
  415:                     my (undef, $partId, $responseId) = split(/_/,$_);
  416:                     if($beenHere{'p:'.$partId} ==  0) {
  417:                         $beenHere{'p:'.$partId}++;
  418:                         if(!defined($cache->{$currentSequence.':'.
  419:                                             $currentResourceID.':parts'})) {
  420:                             $cache->{$currentSequence.':'.$currentResourceID.
  421:                                      ':parts'}=$partId;
  422:                         } else {
  423:                             $cache->{$currentSequence.':'.$currentResourceID.
  424:                                      ':parts'}.=':'.$partId;
  425:                         }
  426:                         $allkeys{$currentSequence.':'.$currentResourceID.
  427:                                   ':parts'}++;
  428:                     }
  429:                     if($beenHere{'r:'.$partId.':'.$responseId} == 0) {
  430:                         $beenHere{'r:'.$partId.':'.$responseId}++;
  431:                         if(!defined($cache->{$currentSequence.':'.
  432:                                              $currentResourceID.':'.$partId.
  433:                                              ':responseIDs'})) {
  434:                             $cache->{$currentSequence.':'.$currentResourceID.
  435:                                      ':'.$partId.':responseIDs'}=$responseId;
  436:                         } else {
  437:                             $cache->{$currentSequence.':'.$currentResourceID.
  438:                                      ':'.$partId.':responseIDs'}.=':'.
  439:                                                                   $responseId;
  440:                         }
  441:                         $allkeys{$currentSequence.':'.$currentResourceID.':'.
  442:                                      $partId.':responseIDs'}++;
  443:                     }
  444:                     if(/^optionresponse/ && 
  445:                        $beenHere{'o:'.$partId.':'.$currentResourceID} == 0) {
  446:                         $beenHere{'o:'.$partId.$currentResourceID}++;
  447:                         if(defined($cache->{'OptionResponses'})) {
  448:                             $cache->{'OptionResponses'}.= ':::'.
  449:                                 $currentSequence.':'.$currentResourceID.':'.
  450:                                 $partId.':'.$responseId;
  451:                         } else {
  452:                             $cache->{'OptionResponses'}= $currentSequence.':'.
  453:                                 $currentResourceID.':'.
  454:                                 $partId.':'.$responseId;
  455:                         }
  456:                         $allkeys{'OptionResponses'}++;
  457:                     }
  458:                 }
  459:             }
  460:         }
  461: 
  462: 	# if resource == finish resource, then it is the end of a sequence/page
  463: 	if($currentResourceID eq $lastResourceID) {
  464: 	    # pop off last resource of sequence
  465: 	    $currentResourceID=pop(@currentResource);
  466: 	    $lastResourceID=pop(@finishResource);
  467: 
  468: 	    if(defined($cache->{$currentSequence.':problems'})) {
  469: 		# Capture sequence information here
  470: 		$cache->{$currentSequence.':title'}=
  471: 		    $hash{'title_'.$currentResourceID};
  472:                 $allkeys{$currentSequence.':title'}++;
  473:                 $cache->{$currentSequence.':source'}=
  474:                     $hash{'src_'.$currentResourceID};
  475:                 $allkeys{$currentSequence.':source'}++;
  476: 
  477:                 my $totalProblems=0;
  478:                 foreach my $currentProblem (split(/\:/,
  479:                                                $cache->{$currentSequence.
  480:                                                ':problems'})) {
  481:                     foreach (split(/\:/,$cache->{$currentSequence.':'.
  482:                                                    $currentProblem.
  483:                                                    ':parts'})) {
  484:                         $totalProblems++;
  485:                     }
  486:                 }
  487: 		my @titleLength=split(//,$cache->{$currentSequence.
  488:                                                     ':title'});
  489:                 # $extra is 3 for problems correct and 3 for space
  490:                 # between problems correct and problem output
  491:                 my $extra = 6;
  492: 		if(($totalProblems + $extra) > (scalar @titleLength)) {
  493: 		    $cache->{$currentSequence.':columnWidth'}=
  494:                         $totalProblems + $extra;
  495: 		} else {
  496: 		    $cache->{$currentSequence.':columnWidth'}=
  497:                         (scalar @titleLength);
  498: 		}
  499:                 $allkeys{$currentSequence.':columnWidth'}++;
  500: 	    } else {
  501:                 # Remove sequence from list, if it contains no problems to
  502:                 # display.
  503:                 $cache->{'orderedSequences'}=~s/$currentSequence//;
  504:                 $cache->{'orderedSequences'}=~s/::/:/g;
  505:                 $cache->{'orderedSequences'}=~s/^:|:$//g;
  506:             }
  507: 
  508: 	    $currentSequence=pop(@sequences);
  509: 	    if($currentSequence eq $topLevelSequenceNumber) {
  510: 		last;
  511: 	    }
  512:         }
  513: 
  514: 	# MOVE!!!
  515: 	# move to next resource
  516: 	unless(defined($hash{'to_'.$currentResourceID})) {
  517: 	    # big problem, need to handle.  Next is probably wrong
  518:             my $errorMessage = 'Big problem in ';
  519:             $errorMessage .= 'loncoursedata::ProcessTopLevelMap.';
  520:             $errorMessage .= '  bighash to_$currentResourceID not defined!';
  521:             &Apache::lonnet::logthis($errorMessage);
  522: 	    last;
  523: 	}
  524: 	my @nextResources=();
  525: 	foreach (split(/\,/,$hash{'to_'.$currentResourceID})) {
  526:             if(!defined($sequenceRecord{$currentSequence.':'.
  527:                                         $hash{'goesto_'.$_}})) {
  528:                 push(@nextResources, $hash{'goesto_'.$_});
  529:             }
  530: 	}
  531: 	push(@currentResource, @nextResources);
  532: 	# Set the next resource to be processed
  533: 	$currentResourceID=pop(@currentResource);
  534:     }
  535: 
  536:     my @theKeys = keys(%allkeys);
  537:     my $newkeys = join(':::', @theKeys);
  538:     $cache->{'ResourceKeys'} = join(':::', $newkeys);
  539:     if($newkeys ne $oldkeys) {
  540:         $cache->{'ResourceUpdated'} = 'true';
  541:     } else {
  542:         $cache->{'ResourceUpdated'} = 'false';
  543:     }
  544: 
  545:     unless (untie(%hash)) {
  546:         &Apache::lonnet::logthis("<font color=blue>WARNING: ".
  547:                                  "Could not untie coursemap $fn (browse)".
  548:                                  ".</font>"); 
  549:     }
  550: 
  551:     return 'OK';
  552: }
  553: 
  554: =pod
  555: 
  556: =item &ProcessClasslist()
  557: 
  558: Taking the class list dumped from &DownloadClasslist(), all the 
  559: students and their non-class information is processed using the 
  560: &ProcessStudentInformation() function.  A date stamp is also recorded for
  561: when the data was processed.
  562: 
  563: Takes data downloaded for a student and breaks it up into managable pieces and 
  564: stored in cache data.  The username, domain, class related date, PID, 
  565: full name, and section are all processed here.
  566: 
  567: =over 4
  568: 
  569: Input: $cache, $classlist, $courseID, $ChartDB, $c
  570: 
  571: $cache: A hash pointer to store the data
  572: 
  573: $classlist:  The hash of data collected about a student from 
  574: &DownloadClasslist().  The hash contains a list of students, a pointer 
  575: to a hash of student information for each student, and each students section 
  576: number.
  577: 
  578: $courseID:  The course ID
  579: 
  580: $ChartDB:  The name of the cache database file.
  581: 
  582: $c:  The connection class used to determine if an abort has been sent to the 
  583: browser
  584: 
  585: Output: @names
  586: 
  587: @names:  An array of students whose information has been processed, and are to 
  588: be considered in an arbitrary order.
  589: 
  590: =back
  591: 
  592: =cut
  593: 
  594: sub ProcessClasslist {
  595:     my ($cache,$classlist,$courseID,$c)=@_;
  596:     my @names=();
  597: 
  598:     $cache->{'ClasslistTimeStamp'}=$classlist->{'lastDownloadTime'};
  599:     if($classlist->{'UpToDate'} eq 'true') {
  600:         return split(/:::/,$cache->{'NamesOfStudents'});;
  601:     }
  602: 
  603:     foreach my $name (keys(%$classlist)) {
  604:         if($name =~ /\:section/ || $name =~ /\:studentInformation/ ||
  605:            $name eq '' || $name eq 'UpToDate' || $name eq 'lastDownloadTime') {
  606:             next;
  607:         }
  608:         if($c->aborted()) {
  609:             return ();
  610:         }
  611:         my $studentInformation = $classlist->{$name.':studentInformation'},
  612:         my $sectionData = $classlist->{$name.':sections'},
  613:         my $date = $classlist->{$name},
  614:         my ($studentName,$studentDomain) = split(/\:/,$name);
  615: 
  616:         $cache->{$name.':username'}=$studentName;
  617:         $cache->{$name.':domain'}=$studentDomain;
  618:         # Initialize timestamp for student
  619:         if(!defined($cache->{$name.':lastDownloadTime'})) {
  620:             $cache->{$name.':lastDownloadTime'}='Not downloaded';
  621:             $cache->{$name.':updateTime'}=' Not updated';
  622:         }
  623: 
  624:         my $error = 0;
  625:         foreach(keys(%$studentInformation)) {
  626:             if(/^(con_lost|error|no_such_host)/i) {
  627:                 $cache->{$name.':error'}=
  628:                     'Could not download student environment data.';
  629:                 $cache->{$name.':fullname'}='';
  630:                 $cache->{$name.':id'}='';
  631:                 $error = 1;
  632:             }
  633:         }
  634:         next if($error);
  635:         push(@names,$name);
  636:         $cache->{$name.':fullname'}=&ProcessFullName(
  637:                                           $studentInformation->{'lastname'},
  638:                                           $studentInformation->{'generation'},
  639:                                           $studentInformation->{'firstname'},
  640:                                           $studentInformation->{'middlename'});
  641:         $cache->{$name.':id'}=$studentInformation->{'id'};
  642: 
  643:         my ($end, $start)=split(':',$date);
  644:         $courseID=~s/\_/\//g;
  645:         $courseID=~s/^(\w)/\/$1/;
  646: 
  647:         my $sec='';
  648:         foreach my $key (keys (%$sectionData)) {
  649:             my $value = $sectionData->{$key};
  650:             if ($key=~/^$courseID(?:\/)*(\w+)*\_st$/) {
  651:                 my $tempsection=$1;
  652:                 if($key eq $courseID.'_st') {
  653:                     $tempsection='';
  654:                 }
  655:                 my ($dummy,$roleend,$rolestart)=split(/\_/,$value);
  656:                 if($roleend eq $end && $rolestart eq $start) {
  657:                     $sec = $tempsection;
  658:                     last;
  659:                 }
  660:             }
  661:         }
  662: 
  663:         my $status='Expired';
  664:         if(((!$end) || time < $end) && ((!$start) || (time > $start))) {
  665:             $status='Active';
  666:         }
  667:         $cache->{$name.':Status'}=$status;
  668:         $cache->{$name.':section'}=$sec;
  669: 
  670:         if($sec eq '' || !defined($sec) || $sec eq ' ') {
  671:             $sec = 'none';
  672:         }
  673:         if(defined($cache->{'sectionList'})) {
  674:             if($cache->{'sectionList'} !~ /(^$sec:|^$sec$|:$sec$|:$sec:)/) {
  675:                 $cache->{'sectionList'} .= ':'.$sec;
  676:             }
  677:         } else {
  678:             $cache->{'sectionList'} = $sec;
  679:         }
  680:     }
  681: 
  682:     $cache->{'ClasslistTimestamp'}=time;
  683:     $cache->{'NamesOfStudents'}=join(':::',@names);
  684: 
  685:     return @names;
  686: }
  687: 
  688: =pod
  689: 
  690: =item &ProcessStudentData()
  691: 
  692: Takes the course data downloaded for a student in 
  693: &DownloadCourseInformation() and breaks it up into key value pairs
  694: to be stored in the cached data.  The keys are comprised of the 
  695: $username:$domain:$keyFromCourseDatabase.  The student username:domain is
  696: stored away signifying that the students information has been downloaded and 
  697: can be reused from cached data.
  698: 
  699: =over 4
  700: 
  701: Input: $cache, $courseData, $name
  702: 
  703: $cache: A hash pointer to store data
  704: 
  705: $courseData:  A hash pointer that points to the course data downloaded for a 
  706: student.
  707: 
  708: $name:  username:domain
  709: 
  710: Output: None
  711: 
  712: *NOTE:  There is no output, but an error message is stored away in the cache 
  713: data.  This is checked in &FormatStudentData().  The key username:domain:error 
  714: will only exist if an error occured.  The error is an error from 
  715: &DownloadCourseInformation().
  716: 
  717: =back
  718: 
  719: =cut
  720: 
  721: sub ProcessStudentData {
  722:     my ($cache,$courseData,$name)=@_;
  723: 
  724:     if(!&CheckDateStampError($courseData, $cache, $name)) {
  725:         return;
  726:     }
  727: 
  728:     # This little delete thing, should not be here.  Move some other
  729:     # time though.
  730:     if(defined($cache->{$name.':keys'})) {
  731: 	foreach (split(':::', $cache->{$name.':keys'})) {
  732: 	    delete $cache->{$name.':'.$_};
  733: 	}
  734:         delete $cache->{$name.':keys'};
  735:     }
  736: 
  737:     my %courseKeys;
  738:     # user name:domain was prepended earlier in DownloadCourseInformation
  739:     foreach (keys %$courseData) {
  740: 	my $currentKey = $_;
  741: 	$currentKey =~ s/^$name//;
  742: 	$courseKeys{$currentKey}++;
  743:         $cache->{$_}=$courseData->{$_};
  744:     }
  745: 
  746:     $cache->{$name.':keys'} = join(':::', keys(%courseKeys));
  747: 
  748:     return;
  749: }
  750: 
  751: =pod
  752: 
  753: =item &ExtractStudentData()
  754: 
  755: HISTORY: This function originally existed in every statistics module,
  756: and performed different tasks, the had some overlap.  Due to the need
  757: for the data from the different modules, they were combined into
  758: a single function.
  759: 
  760: This function now extracts all the necessary course data for a student
  761: from what was downloaded from their homeserver.  There is some extra
  762: time overhead compared to the ProcessStudentInformation function, but
  763: it would have had to occurred at some point anyways.  This is now
  764: typically called while downloading the data it will process.  It is
  765: the brother function to ProcessStudentInformation.
  766: 
  767: =over 4
  768: 
  769: Input: $input, $output, $data, $name
  770: 
  771: $input: A hash that contains the input data to be processed
  772: 
  773: $output: A hash to contain the processed data
  774: 
  775: $data: A hash containing the information on what is to be
  776: processed and how (basically).
  777: 
  778: $name:  username:domain
  779: 
  780: The input is slightly different here, but is quite simple.
  781: It is currently used where the $input, $output, and $data
  782: can and are often the same hashes, but they do not need
  783: to be.
  784: 
  785: Output: None
  786: 
  787: *NOTE:  There is no output, but an error message is stored away in the cache 
  788: data.  This is checked in &FormatStudentData().  The key username:domain:error 
  789: will only exist if an error occured.  The error is an error from 
  790: &DownloadCourseInformation().
  791: 
  792: =back
  793: 
  794: =cut
  795: 
  796: sub ExtractStudentData {
  797:     my ($input, $output, $data, $name)=@_;
  798: 
  799:     if(!&CheckDateStampError($input, $data, $name)) {
  800:         return;
  801:     }
  802: 
  803:     # This little delete thing, should not be here.  Move some other
  804:     # time though.
  805:     my %allkeys;
  806:     if(defined($output->{$name.':keys'})) {
  807: 	foreach (split(':::', $output->{$name.':keys'})) {
  808: 	    delete $output->{$name.':'.$_};
  809: 	}
  810:         delete $output->{$name.':keys'};
  811:     }
  812: 
  813:     my ($username,$domain)=split(':',$name);
  814: 
  815:     my $Version;
  816:     my $problemsCorrect = 0;
  817:     my $totalProblems   = 0;
  818:     my $problemsSolved  = 0;
  819:     my $numberOfParts   = 0;
  820:     my $totalAwarded    = 0;
  821:     foreach my $sequence (split(':', $data->{'orderedSequences'})) {
  822:         foreach my $problemID (split(':', $data->{$sequence.':problems'})) {
  823:             my $problem = $data->{$problemID.':problem'};
  824:             my $LatestVersion = $input->{$name.':version:'.$problem};
  825: 
  826:             # Output dashes for all the parts of this problem if there
  827:             # is no version information about the current problem.
  828:             $output->{$name.':'.$problemID.':NoVersion'} = 'false';
  829:             $allkeys{$name.':'.$problemID.':NoVersion'}++;
  830:             if(!$LatestVersion) {
  831:                 foreach my $part (split(/\:/,$data->{$sequence.':'.
  832:                                                       $problemID.
  833:                                                       ':parts'})) {
  834:                     $output->{$name.':'.$problemID.':'.$part.':tries'} = 0;
  835:                     $output->{$name.':'.$problemID.':'.$part.':awarded'} = 0;
  836:                     $output->{$name.':'.$problemID.':'.$part.':code'} = ' ';
  837: 		    $allkeys{$name.':'.$problemID.':'.$part.':tries'}++;
  838: 		    $allkeys{$name.':'.$problemID.':'.$part.':awarded'}++;
  839: 		    $allkeys{$name.':'.$problemID.':'.$part.':code'}++;
  840:                     $totalProblems++;
  841:                 }
  842:                 $output->{$name.':'.$problemID.':NoVersion'} = 'true';
  843:                 next;
  844:             }
  845: 
  846:             my %partData=undef;
  847:             # Initialize part data, display skips correctly
  848:             # Skip refers to when a student made no submissions on that
  849:             # part/problem.
  850:             foreach my $part (split(/\:/,$data->{$sequence.':'.
  851:                                                  $problemID.
  852:                                                  ':parts'})) {
  853:                 $partData{$part.':tries'}=0;
  854:                 $partData{$part.':code'}=' ';
  855:                 $partData{$part.':awarded'}=0;
  856:                 $partData{$part.':timestamp'}=0;
  857:                 foreach my $response (split(':', $data->{$sequence.':'.
  858:                                                          $problemID.':'.
  859:                                                          $part.':responseIDs'})) {
  860:                     $partData{$part.':'.$response.':submission'}='';
  861:                 }
  862:             }
  863: 
  864:             # Looping through all the versions of each part, starting with the
  865:             # oldest version.  Basically, it gets the most recent 
  866:             # set of grade data for each part.
  867:             my @submissions = ();
  868: 	    for(my $Version=1; $Version<=$LatestVersion; $Version++) {
  869:                 foreach my $part (split(/\:/,$data->{$sequence.':'.
  870:                                                      $problemID.
  871:                                                      ':parts'})) {
  872: 
  873:                     if(!defined($input->{"$name:$Version:$problem".
  874:                                          ":resource.$part.solved"})) {
  875:                         # No grade for this submission, so skip
  876:                         next;
  877:                     }
  878: 
  879:                     my $tries=0;
  880:                     my $code=' ';
  881:                     my $awarded=0;
  882: 
  883:                     $tries = $input->{$name.':'.$Version.':'.$problem.
  884:                                       ':resource.'.$part.'.tries'};
  885:                     $awarded = $input->{$name.':'.$Version.':'.$problem.
  886:                                         ':resource.'.$part.'.awarded'};
  887: 
  888:                     $partData{$part.':awarded'}=($awarded) ? $awarded : 0;
  889:                     $partData{$part.':tries'}=($tries) ? $tries : 0;
  890: 
  891:                     $partData{$part.':timestamp'}=$input->{$name.':'.$Version.':'.
  892:                                                            $problem.
  893:                                                            ':timestamp'};
  894:                     if(!$input->{$name.':'.$Version.':'.$problem.':resource.'.$part.
  895:                                  '.previous'}) {
  896:                         foreach my $response (split(':',
  897:                                                    $data->{$sequence.':'.
  898:                                                            $problemID.':'.
  899:                                                            $part.':responseIDs'})) {
  900:                             @submissions=($input->{$name.':'.$Version.':'.
  901:                                                    $problem.
  902:                                                    ':resource.'.$part.'.'.
  903:                                                    $response.'.submission'},
  904:                                           @submissions);
  905:                         }
  906:                     }
  907: 
  908:                     my $val = $input->{$name.':'.$Version.':'.$problem.
  909:                                        ':resource.'.$part.'.solved'};
  910:                     if    ($val eq 'correct_by_student')   {$code = '*';} 
  911:                     elsif ($val eq 'correct_by_override')  {$code = '+';}
  912:                     elsif ($val eq 'incorrect_attempted')  {$code = '.';} 
  913:                     elsif ($val eq 'incorrect_by_override'){$code = '-';}
  914:                     elsif ($val eq 'excused')              {$code = 'x';}
  915:                     elsif ($val eq 'ungraded_attempted')   {$code = '#';}
  916:                     else                                   {$code = ' ';}
  917:                     $partData{$part.':code'}=$code;
  918:                 }
  919:             }
  920: 
  921:             foreach my $part (split(/\:/,$data->{$sequence.':'.$problemID.
  922:                                                  ':parts'})) {
  923:                 $output->{$name.':'.$problemID.':'.$part.':wrong'} = 
  924:                     $partData{$part.':tries'};
  925: 		$allkeys{$name.':'.$problemID.':'.$part.':wrong'}++;
  926: 
  927:                 if($partData{$part.':code'} eq '*') {
  928:                     $output->{$name.':'.$problemID.':'.$part.':wrong'}--;
  929:                     $problemsCorrect++;
  930:                 } elsif($partData{$part.':code'} eq '+') {
  931:                     $output->{$name.':'.$problemID.':'.$part.':wrong'}--;
  932:                     $problemsCorrect++;
  933:                 }
  934: 
  935:                 $output->{$name.':'.$problemID.':'.$part.':tries'} = 
  936:                     $partData{$part.':tries'};
  937:                 $output->{$name.':'.$problemID.':'.$part.':code'} =
  938:                     $partData{$part.':code'};
  939:                 $output->{$name.':'.$problemID.':'.$part.':awarded'} =
  940:                     $partData{$part.':awarded'};
  941: 		$allkeys{$name.':'.$problemID.':'.$part.':tries'}++;
  942: 		$allkeys{$name.':'.$problemID.':'.$part.':code'}++;
  943: 		$allkeys{$name.':'.$problemID.':'.$part.':awarded'}++;
  944: 
  945:                 $totalAwarded += $partData{$part.':awarded'};
  946:                 $output->{$name.':'.$problemID.':'.$part.':timestamp'} =
  947:                     $partData{$part.':timestamp'};
  948: 		$allkeys{$name.':'.$problemID.':'.$part.':timestamp'}++;
  949: 
  950:                 foreach my $response (split(':', $data->{$sequence.':'.
  951:                                                          $problemID.':'.
  952:                                                          $part.':responseIDs'})) {
  953:                     $output->{$name.':'.$problemID.':'.$part.':'.$response.
  954:                               ':submission'}=join(':::',@submissions);
  955: 		    $allkeys{$name.':'.$problemID.':'.$part.':'.$response.
  956: 			     ':submission'}++;
  957:                 }
  958: 
  959:                 if($partData{$part.':code'} ne 'x') {
  960:                     $totalProblems++;
  961:                 }
  962:             }
  963:         }
  964: 
  965:         $output->{$name.':'.$sequence.':problemsCorrect'} = $problemsCorrect;
  966: 	$allkeys{$name.':'.$sequence.':problemsCorrect'}++;
  967:         $problemsSolved += $problemsCorrect;
  968: 	$problemsCorrect=0;
  969:     }
  970: 
  971:     $output->{$name.':problemsSolved'} = $problemsSolved;
  972:     $output->{$name.':totalProblems'} = $totalProblems;
  973:     $output->{$name.':totalAwarded'} = $totalAwarded;
  974:     $allkeys{$name.':problemsSolved'}++;
  975:     $allkeys{$name.':totalProblems'}++;
  976:     $allkeys{$name.':totalAwarded'}++;
  977: 
  978:     $output->{$name.':keys'} = join(':::', keys(%allkeys));
  979: 
  980:     return;
  981: }
  982: 
  983: sub LoadDiscussion {
  984:     my ($courseID)=@_;
  985:     my %Discuss=();
  986:     my %contrib=&Apache::lonnet::dump(
  987:                 $courseID,
  988:                 $ENV{'course.'.$courseID.'.domain'},
  989:                 $ENV{'course.'.$courseID.'.num'});
  990: 				 
  991:     #my %contrib=&DownloadCourseInformation($name, $courseID, 0);
  992: 
  993:     foreach my $temp(keys %contrib) {
  994: 	if ($temp=~/^version/) {
  995: 	    my $ver=$contrib{$temp};
  996: 	    my ($dummy,$prb)=split(':',$temp);
  997: 	    for (my $idx=1; $idx<=$ver; $idx++ ) {
  998: 		my $name=$contrib{"$idx:$prb:sendername"};
  999: 		$Discuss{"$name:$prb"}=$idx;	
 1000: 	    }
 1001: 	}
 1002:     }       
 1003: 
 1004:     return \%Discuss;
 1005: }
 1006: 
 1007: # ----- END PROCESSING FUNCTIONS ---------------------------------------
 1008: 
 1009: =pod
 1010: 
 1011: =head1 HELPER FUNCTIONS
 1012: 
 1013: These are just a couple of functions do various odd and end 
 1014: jobs.  There was also a couple of bulk functions added.  These are
 1015: &DownloadStudentCourseData(), &DownloadStudentCourseDataSeparate(), and
 1016: &CheckForResidualDownload().  These functions now act as the interface
 1017: for downloading student course data.  The statistical modules should
 1018: no longer make the calls to dump and download and process etc.  They
 1019: make calls to these bulk functions to get their data.
 1020: 
 1021: =cut
 1022: 
 1023: # ----- HELPER FUNCTIONS -----------------------------------------------
 1024: 
 1025: sub CheckDateStampError {
 1026:     my ($courseData, $cache, $name)=@_;
 1027:     if($courseData->{$name.':UpToDate'} eq 'true') {
 1028:         $cache->{$name.':lastDownloadTime'} = 
 1029:             $courseData->{$name.':lastDownloadTime'};
 1030:         if($courseData->{$name.':lastDownloadTime'} eq 'Not downloaded') {
 1031:             $cache->{$name.':updateTime'} = ' Not updated';
 1032:         } else {
 1033:             $cache->{$name.':updateTime'}=
 1034:                 localtime($courseData->{$name.':lastDownloadTime'});
 1035:         }
 1036:         return 0;
 1037:     }
 1038: 
 1039:     $cache->{$name.':lastDownloadTime'}=$courseData->{$name.':lastDownloadTime'};
 1040:     if($courseData->{$name.':lastDownloadTime'} eq 'Not downloaded') {
 1041:         $cache->{$name.':updateTime'} = ' Not updated';
 1042:     } else {
 1043:         $cache->{$name.':updateTime'}=
 1044:             localtime($courseData->{$name.':lastDownloadTime'});
 1045:     }
 1046: 
 1047:     if(defined($courseData->{$name.':error'})) {
 1048:         $cache->{$name.':error'}=$courseData->{$name.':error'};
 1049:         return 0;
 1050:     }
 1051: 
 1052:     return 1;
 1053: }
 1054: 
 1055: =pod
 1056: 
 1057: =item &ProcessFullName()
 1058: 
 1059: Takes lastname, generation, firstname, and middlename (or some partial
 1060: set of this data) and returns the full name version as a string.  Format
 1061: is Lastname generation, firstname middlename or a subset of this.
 1062: 
 1063: =cut
 1064: 
 1065: sub ProcessFullName {
 1066:     my ($lastname, $generation, $firstname, $middlename)=@_;
 1067:     my $Str = '';
 1068: 
 1069:     if($lastname ne '') {
 1070: 	$Str .= $lastname.' ';
 1071: 	if($generation ne '') {
 1072: 	    $Str .= $generation;
 1073: 	} else {
 1074: 	    chop($Str);
 1075: 	}
 1076: 	$Str .= ', ';
 1077: 	if($firstname ne '') {
 1078: 	    $Str .= $firstname.' ';
 1079: 	}
 1080: 	if($middlename ne '') {
 1081: 	    $Str .= $middlename;
 1082: 	} else {
 1083: 	    chop($Str);
 1084: 	    if($firstname eq '') {
 1085: 		chop($Str);
 1086: 	    }
 1087: 	}
 1088:     } else {
 1089: 	if($firstname ne '') {
 1090: 	    $Str .= $firstname.' ';
 1091: 	}
 1092: 	if($middlename ne '') {
 1093: 	    $Str .= $middlename.' ';
 1094: 	}
 1095: 	if($generation ne '') {
 1096: 	    $Str .= $generation;
 1097: 	} else {
 1098: 	    chop($Str);
 1099: 	}
 1100:     }
 1101: 
 1102:     return $Str;
 1103: }
 1104: 
 1105: =pod
 1106: 
 1107: =item &TestCacheData()
 1108: 
 1109: Determine if the cache database can be accessed with a tie.  It waits up to
 1110: ten seconds before returning failure.  This function exists to help with
 1111: the problems with stopping the data download.  When an abort occurs and the
 1112: user quickly presses a form button and httpd child is created.  This
 1113: child needs to wait for the other to finish (hopefully within ten seconds).
 1114: 
 1115: =over 4
 1116: 
 1117: Input: $ChartDB
 1118: 
 1119: $ChartDB: The name of the cache database to be opened
 1120: 
 1121: Output: -1, 0, 1
 1122: 
 1123: -1: Could not tie database
 1124:  0: Use cached data
 1125:  1: New cache database created, use that.
 1126: 
 1127: =back
 1128: 
 1129: =cut
 1130: 
 1131: sub TestCacheData {
 1132:     my ($ChartDB,$isRecalculate,$totalDelay)=@_;
 1133:     my $isCached=-1;
 1134:     my %testData;
 1135:     my $tieTries=0;
 1136: 
 1137:     if(!defined($totalDelay)) {
 1138:         $totalDelay = 10;
 1139:     }
 1140: 
 1141:     if ((-e "$ChartDB") && (!$isRecalculate)) {
 1142: 	$isCached = 1;
 1143:     } else {
 1144: 	$isCached = 0;
 1145:     }
 1146: 
 1147:     while($tieTries < $totalDelay) {
 1148:         my $result=0;
 1149:         if($isCached) {
 1150:             $result=tie(%testData,'GDBM_File',$ChartDB,&GDBM_READER(),0640);
 1151:         } else {
 1152:             $result=tie(%testData,'GDBM_File',$ChartDB,&GDBM_NEWDB(),0640);
 1153:         }
 1154:         if($result) {
 1155:             last;
 1156:         }
 1157:         $tieTries++;
 1158:         sleep 1;
 1159:     }
 1160:     if($tieTries >= $totalDelay) {
 1161:         return -1;
 1162:     }
 1163: 
 1164:     untie(%testData);
 1165: 
 1166:     return $isCached;
 1167: }
 1168: 
 1169: sub DownloadStudentCourseData {
 1170:     my ($students,$checkDate,$cacheDB,$extract,$status,$courseID,$r,$c)=@_;
 1171: 
 1172:     my $title = 'LON-CAPA Statistics';
 1173:     my $heading = 'Download and Process Course Data';
 1174:     my $studentCount = scalar(@$students);
 1175: 
 1176:     my $WhatIWant;
 1177:     $WhatIWant = '(^version:|';
 1178:     $WhatIWant .= '^\d+:.+?:(resource\.\d+\.';
 1179:     $WhatIWant .= '(solved|tries|previous|awarded|(\d+\.submission))\s*$';
 1180:     $WhatIWant .= '|timestamp)';
 1181:     $WhatIWant .= ')';
 1182: #    $WhatIWant = '.';
 1183: 
 1184:     if($status eq 'true') {
 1185:         &Apache::lonhtmlcommon::Create_PrgWin($r, $title, $heading);
 1186:     }
 1187: 
 1188:     my $displayString;
 1189:     my $count=0;
 1190:     foreach (@$students) {
 1191:         my %cache;
 1192: 
 1193:         if($c->aborted()) { return 'Aborted'; }
 1194: 
 1195:         if($status eq 'true') {
 1196:             $count++;
 1197:             my $displayString = $count.'/'.$studentCount.': '.$_;
 1198:             &Apache::lonhtmlcommon::Update_PrgWin($displayString, $r);
 1199:         }
 1200: 
 1201:         my $downloadTime='Not downloaded';
 1202:         my $needUpdate = 'false';
 1203:         if($checkDate eq 'true'  && 
 1204:            tie(%cache,'GDBM_File',$cacheDB,&GDBM_READER(),0640)) {
 1205:             $downloadTime = $cache{$_.':lastDownloadTime'};
 1206:             $needUpdate = $cache{'ResourceUpdated'};
 1207:             untie(%cache);
 1208:         }
 1209: 
 1210:         if($c->aborted()) { return 'Aborted'; }
 1211: 
 1212:         if($needUpdate eq 'true') {
 1213:             $downloadTime = 'Not downloaded';
 1214: 	}
 1215: 	my $courseData = 
 1216: 	    &DownloadCourseInformation($_, $courseID, $downloadTime, 
 1217: 				       $WhatIWant);
 1218: 	if(tie(%cache,'GDBM_File',$cacheDB,&GDBM_WRCREAT(),0640)) {
 1219: 	    foreach my $key (keys(%$courseData)) {
 1220: 		if($key =~ /^(con_lost|error|no_such_host)/i) {
 1221: 		    $courseData->{$_.':error'} = 'No course data for '.$_;
 1222: 		    last;
 1223: 		}
 1224: 	    }
 1225: 	    if($extract eq 'true') {
 1226: 		&ExtractStudentData($courseData, \%cache, \%cache, $_);
 1227: 	    } else {
 1228: 		&ProcessStudentData(\%cache, $courseData, $_);
 1229: 	    }
 1230: 	    untie(%cache);
 1231: 	} else {
 1232: 	    next;
 1233: 	}
 1234:     }
 1235:     if($status eq 'true') { &Apache::lonhtmlcommon::Close_PrgWin($r); }
 1236: 
 1237:     return 'OK';
 1238: }
 1239: 
 1240: sub DownloadStudentCourseDataSeparate {
 1241:     my ($students,$checkDate,$cacheDB,$extract,$status,$courseID,$r,$c)=@_;
 1242:     my $residualFile = '/home/httpd/perl/tmp/'.$courseID.'DownloadFile.db';
 1243:     my $title = 'LON-CAPA Statistics';
 1244:     my $heading = 'Download Course Data';
 1245: 
 1246:     my $WhatIWant;
 1247:     $WhatIWant = '(^version:|';
 1248:     $WhatIWant .= '^\d+:.+?:(resource\.\d+\.';
 1249:     $WhatIWant .= '(solved|tries|previous|awarded|(\d+\.submission))\s*$';
 1250:     $WhatIWant .= '|timestamp)';
 1251:     $WhatIWant .= ')';
 1252: 
 1253:     &CheckForResidualDownload($courseID, $cacheDB, $students, $c);
 1254: 
 1255:     my $studentCount = scalar(@$students);
 1256:     if($status eq 'true') {
 1257:         &Apache::lonhtmlcommon::Create_PrgWin($r, $title, $heading);
 1258:     }
 1259:     my $count=0;
 1260:     my $displayString='';
 1261:     foreach (@$students) {
 1262:         if($c->aborted()) {
 1263:             return 'Aborted';
 1264:         }
 1265: 
 1266:         if($status eq 'true') {
 1267:             $count++;
 1268:             $displayString = $count.'/'.$studentCount.': '.$_;
 1269:             &Apache::lonhtmlcommon::Update_PrgWin($displayString, $r);
 1270:         }
 1271: 
 1272:         my %cache;
 1273:         my $downloadTime='Not downloaded';
 1274:         my $needUpdate = 'false';
 1275:         if($checkDate eq 'true'  && 
 1276:            tie(%cache,'GDBM_File',$cacheDB,&GDBM_READER(),0640)) {
 1277:             $downloadTime = $cache{$_.':lastDownloadTime'};
 1278:             $needUpdate = $cache{'ResourceUpdated'};
 1279:             untie(%cache);
 1280:         }
 1281: 
 1282:         if($c->aborted()) {
 1283:             return 'Aborted';
 1284:         }
 1285: 
 1286:         if($needUpdate eq 'true') {
 1287:             $downloadTime = 'Not downloaded';
 1288: 	}
 1289: 
 1290:         my $error = 0;
 1291:         my $courseData = 
 1292:             &DownloadCourseInformation($_, $courseID, $downloadTime,
 1293:                                        $WhatIWant);
 1294:         my %downloadData;
 1295:         unless(tie(%downloadData,'GDBM_File',$residualFile,
 1296:                    &GDBM_WRCREAT(),0640)) {
 1297:             return 'Failed to tie temporary download hash.';
 1298:         }
 1299:         foreach my $key (keys(%$courseData)) {
 1300:             $downloadData{$key} = $courseData->{$key};
 1301:             if($key =~ /^(con_lost|error|no_such_host)/i) {
 1302:                 $error = 1;
 1303:                 last;
 1304:             }
 1305:         }
 1306:         if($error) {
 1307:             foreach my $deleteKey (keys(%$courseData)) {
 1308:                 delete $downloadData{$deleteKey};
 1309:             }
 1310:             $downloadData{$_.':error'} = 'No course data for '.$_;
 1311:         }
 1312:         untie(%downloadData);
 1313:     }
 1314:     if($status eq 'true') { &Apache::lonhtmlcommon::Close_PrgWin($r); }
 1315: 
 1316:     return &CheckForResidualDownload($cacheDB, 'true', 'true', 
 1317:                                      $courseID, $r, $c);
 1318: }
 1319: 
 1320: sub CheckForResidualDownload {
 1321:     my ($cacheDB,$extract,$status,$courseID,$r,$c)=@_;
 1322: 
 1323:     my $residualFile = '/home/httpd/perl/tmp/'.$courseID.'DownloadFile.db';
 1324:     if(!-e $residualFile) {
 1325:         return 'OK';
 1326:     }
 1327: 
 1328:     my %downloadData;
 1329:     my %cache;
 1330:     unless(tie(%downloadData,'GDBM_File',$residualFile,&GDBM_READER(),0640)) {
 1331:         return 'Can not tie database for check for residual download: tempDB';
 1332:     }
 1333:     unless(tie(%cache,'GDBM_File',$cacheDB,&GDBM_WRCREAT(),0640)) {
 1334:         untie(%downloadData);
 1335:         return 'Can not tie database for check for residual download: cacheDB';
 1336:     }
 1337: 
 1338:     my @students=();
 1339:     my %checkStudent;
 1340:     my $key;
 1341:     while(($key, undef) = each %downloadData) {
 1342:         my @temp = split(':', $key);
 1343:         my $student = $temp[0].':'.$temp[1];
 1344:         if(!defined($checkStudent{$student})) {
 1345:             $checkStudent{$student}++;
 1346:             push(@students, $student);
 1347:         }
 1348:     }
 1349: 
 1350:     my $heading = 'Process Course Data';
 1351:     my $title = 'LON-CAPA Statistics';
 1352:     my $studentCount = scalar(@students);
 1353:     if($status eq 'true') {
 1354:         &Apache::lonhtmlcommon::Create_PrgWin($r, $title, $heading);
 1355:     }
 1356: 
 1357:     my $count=1;
 1358:     foreach my $name (@students) {
 1359:         last if($c->aborted());
 1360: 
 1361:         if($status eq 'true') {
 1362:             my $displayString = $count.'/'.$studentCount.': '.$name;
 1363:             &Apache::lonhtmlcommon::Update_PrgWin($displayString, $r);
 1364:         }
 1365: 
 1366:         if($extract eq 'true') {
 1367:             &ExtractStudentData(\%downloadData, \%cache, \%cache, $name);
 1368:         } else {
 1369:             &ProcessStudentData(\%cache, \%downloadData, $name);
 1370:         }
 1371:         $count++;
 1372:     }
 1373: 
 1374:     if($status eq 'true') { &Apache::lonhtmlcommon::Close_PrgWin($r); }
 1375: 
 1376:     untie(%cache);
 1377:     untie(%downloadData);
 1378: 
 1379:     if(!$c->aborted()) {
 1380:         my @files = ($residualFile);
 1381:         unlink(@files);
 1382:     }
 1383: 
 1384:     return 'OK';
 1385: }
 1386: 
 1387: # ----- END HELPER FUNCTIONS --------------------------------------------
 1388: 
 1389: 1;
 1390: __END__

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