Annotation of loncom/interface/loncoursedata.pm, revision 1.44

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

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