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

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

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