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

1.1       stredwic    1: # The LearningOnline Network with CAPA
                      2: #
1.54    ! bowersj2    3: # $Id: loncoursedata.pm,v 1.53 2003/02/28 20:41:27 matthew Exp $
1.1       stredwic    4: #
                      5: # Copyright Michigan State University Board of Trustees
                      6: #
                      7: # This file is part of the LearningOnline Network with CAPA (LON-CAPA).
                      8: #
                      9: # LON-CAPA is free software; you can redistribute it and/or modify
                     10: # it under the terms of the GNU General Public License as published by
                     11: # the Free Software Foundation; either version 2 of the License, or
                     12: # (at your option) any later version.
                     13: #
                     14: # LON-CAPA is distributed in the hope that it will be useful,
                     15: # but WITHOUT ANY WARRANTY; without even the implied warranty of
                     16: # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
                     17: # GNU General Public License for more details.
                     18: #
                     19: # You should have received a copy of the GNU General Public License
                     20: # along with LON-CAPA; if not, write to the Free Software
                     21: # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
                     22: #
                     23: # /home/httpd/html/adm/gpl.txt
                     24: #
                     25: # http://www.lon-capa.org/
                     26: #
                     27: ###
                     28: 
                     29: =pod
                     30: 
                     31: =head1 NAME
                     32: 
                     33: loncoursedata
                     34: 
                     35: =head1 SYNOPSIS
                     36: 
1.22      stredwic   37: Set of functions that download and process student and course information.
1.1       stredwic   38: 
                     39: =head1 PACKAGES USED
                     40: 
                     41:  Apache::Constants qw(:common :http)
                     42:  Apache::lonnet()
1.22      stredwic   43:  Apache::lonhtmlcommon
1.1       stredwic   44:  HTML::TokeParser
                     45:  GDBM_File
                     46: 
                     47: =cut
                     48: 
                     49: package Apache::loncoursedata;
                     50: 
                     51: use strict;
                     52: use Apache::Constants qw(:common :http);
                     53: use Apache::lonnet();
1.13      stredwic   54: use Apache::lonhtmlcommon;
1.1       stredwic   55: use HTML::TokeParser;
                     56: use GDBM_File;
                     57: 
                     58: =pod
                     59: 
                     60: =head1 DOWNLOAD INFORMATION
                     61: 
1.22      stredwic   62: This section contains all the functions that get data from other servers 
                     63: and/or itself.
1.1       stredwic   64: 
                     65: =cut
                     66: 
                     67: # ----- DOWNLOAD INFORMATION -------------------------------------------
                     68: 
                     69: =pod
                     70: 
1.3       stredwic   71: =item &DownloadClasslist()
1.1       stredwic   72: 
                     73: Collects lastname, generation, middlename, firstname, PID, and section for each
1.22      stredwic   74: student from their environment database.  The section data is also download, though
                     75: it is in a rough format, and is processed later.  The list of students is built from
                     76: collecting a classlist for the course that is to be displayed.  Once the classlist
                     77: has been downloaded, its date stamp is recorded.  Unless the datestamp for the
                     78: class database is reset or is modified, this data will not be downloaded again.  
                     79: Also, there was talk about putting the fullname and section
                     80: and perhaps other pieces of data into the classlist file.  This would
                     81: reduce the number of different file accesses and reduce the amount of 
                     82: processing on this side.
1.1       stredwic   83: 
                     84: =over 4
                     85: 
1.21      matthew    86: Input: $courseID, $lastDownloadTime, $c
1.1       stredwic   87: 
                     88: $courseID:  The id of the course
                     89: 
1.22      stredwic   90: $lastDownloadTime:  This is the date stamp for when this information was
1.23      stredwic   91: last gathered.  If it is set to Not downloaded, it will gather the data
1.22      stredwic   92: again, though it currently does not remove the old data.
1.21      matthew    93: 
1.1       stredwic   94: $c: The connection class that can determine if the browser has aborted.  It
1.21      matthew    95: is used to short circuit this function so that it does not continue to 
1.1       stredwic   96: get information when there is no need.
                     97: 
                     98: Output: \%classlist
                     99: 
                    100: \%classlist: A pointer to a hash containing the following data:
                    101: 
                    102: -A list of student name:domain (as keys) (known below as $name)
                    103: 
                    104: -A hash pointer for each student containing lastname, generation, firstname,
1.23      stredwic  105: middlename, and PID : Key is $name.studentInformation
1.1       stredwic  106: 
                    107: -A hash pointer to each students section data : Key is $name.section
                    108: 
1.22      stredwic  109: -If there was an error in dump, it will be returned in the hash.  See
                    110: the error codes for dump in lonnet.  Also, an error key will be 
                    111: generated if an abort occurs.
                    112: 
1.1       stredwic  113: =back
                    114: 
                    115: =cut
                    116: 
1.3       stredwic  117: sub DownloadClasslist {
                    118:     my ($courseID, $lastDownloadTime, $c)=@_;
1.1       stredwic  119:     my ($courseDomain,$courseNumber)=split(/\_/,$courseID);
1.3       stredwic  120:     my %classlist;
1.1       stredwic  121: 
1.50      matthew   122:     my $modifiedTime = &Apache::lonnet::GetFileTimestamp($courseDomain, 
                    123:                                                          $courseNumber,
1.22      stredwic  124:                                                          'classlist.db', 
1.50      matthew   125:                                  $Apache::lonnet::perlvar{'lonUsersDir'});
1.22      stredwic  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: 
1.50      matthew   264: ####################################################
                    265: ####################################################
1.45      matthew   266: 
                    267: =pod
                    268: 
                    269: =item &get_sequence_assessment_data()
                    270: 
                    271: AT THIS TIME THE USE OF THIS FUNCTION IS *NOT* RECOMMENDED
                    272: 
                    273: Use lonnavmaps to build a data structure describing the order and 
                    274: assessment contents of each sequence in the current course.
                    275: 
                    276: The returned structure is a hash reference. 
                    277: 
                    278: { title  => 'title',
                    279:   symb   => 'symb',
                    280:   source => '/s/o/u/r/c/e',
                    281:   type  => (container|assessment),
1.50      matthew   282:   num_assess   => 2,               # only for container
1.45      matthew   283:   parts        => [11,13,15],      # only for assessment
1.50      matthew   284:   response_ids => [12,14,16],      # only for assessment
                    285:   contents     => [........]       # only for container
1.45      matthew   286: }
                    287: 
1.50      matthew   288: $hash->{'contents'} is a reference to an array of hashes of the same structure.
                    289: 
                    290: Also returned are array references to the sequences and assessments contained
                    291: in the course.
1.49      matthew   292: 
1.45      matthew   293: 
                    294: =cut
                    295: 
1.50      matthew   296: ####################################################
                    297: ####################################################
1.45      matthew   298: sub get_sequence_assessment_data {
                    299:     my $fn=$ENV{'request.course.fn'};
                    300:     ##
                    301:     ## use navmaps
1.46      matthew   302:     my $navmap = Apache::lonnavmaps::navmap->new($fn.".db",$fn."_parms.db",
                    303:                                                  1,0);
1.45      matthew   304:     if (!defined($navmap)) {
                    305:         return 'Can not open Coursemap';
                    306:     }
                    307:     my $iterator = $navmap->getIterator(undef, undef, undef, 1);
                    308:     ##
                    309:     ## Prime the pump 
                    310:     ## 
                    311:     ## We are going to loop until we run out of sequences/pages to explore for
                    312:     ## resources.  This means we have to start out with something to look
                    313:     ## at.
1.52      matthew   314:     my $title = $ENV{'course.'.$ENV{'request.course.id'}.'.description'};
                    315:     my $symb  = 'top';
                    316:     my $src   = 'not applicable';
1.45      matthew   317:     #
1.49      matthew   318:     my @Sequences; 
                    319:     my @Assessments;
1.45      matthew   320:     my @Nested_Sequences = ();   # Stack of sequences, keeps track of depth
                    321:     my $top = { title    => $title,
1.52      matthew   322:                 src      => $src,
1.45      matthew   323:                 symb     => $symb,
                    324:                 type     => 'container',
                    325:                 num_assess => 0,
1.53      matthew   326:                 num_assess_parts => 0,
1.45      matthew   327:                 contents   => [], };
1.49      matthew   328:     push (@Sequences,$top);
1.45      matthew   329:     push (@Nested_Sequences, $top);
                    330:     #
                    331:     # We need to keep track of which sequences contain homework problems
                    332:     # 
1.52      matthew   333:     my $previous;
                    334:     my $curRes = $iterator->next(); # BEGIN_MAP
                    335:     $curRes = $iterator->next(); # The first item in the top level map.
1.45      matthew   336:     while (scalar(@Nested_Sequences)) {
1.50      matthew   337:         $previous = $curRes;
1.45      matthew   338:         $curRes = $iterator->next();
                    339:         my $currentmap = $Nested_Sequences[-1]; # Last one on the stack
                    340:         if ($curRes == $iterator->BEGIN_MAP()) {
                    341:             # get the map itself, instead of BEGIN_MAP
1.51      matthew   342:             $title = $previous->title();
                    343:             $symb  = $previous->symb();
                    344:             $src   = $previous->src();
1.45      matthew   345:             my $newmap = { title    => $title,
                    346:                            src      => $src,
                    347:                            symb     => $symb,
                    348:                            type     => 'container',
                    349:                            num_assess => 0,
                    350:                            contents   => [],
                    351:                        };
                    352:             push (@{$currentmap->{'contents'}},$newmap); # this is permanent
1.49      matthew   353:             push (@Sequences,$newmap);
1.45      matthew   354:             push (@Nested_Sequences, $newmap); # this is a stack
                    355:             next;
                    356:         }
                    357:         if ($curRes == $iterator->END_MAP()) {
                    358:             pop(@Nested_Sequences);
                    359:             next;
                    360:         }
                    361:         next if (! ref($curRes));
1.50      matthew   362:         next if (! $curRes->is_problem());# && !$curRes->randomout);
1.45      matthew   363:         # Okay, from here on out we only deal with assessments
                    364:         $title = $curRes->title();
                    365:         $symb  = $curRes->symb();
                    366:         $src   = $curRes->src();
                    367:         my $parts = $curRes->parts();
                    368:         my $assessment = { title => $title,
                    369:                            src   => $src,
                    370:                            symb  => $symb,
                    371:                            type  => 'assessment',
1.53      matthew   372:                            parts => $parts,
                    373:                            num_parts => scalar(@$parts),
1.45      matthew   374:                        };
1.49      matthew   375:         push(@Assessments,$assessment);
1.45      matthew   376:         push(@{$currentmap->{'contents'}},$assessment);
                    377:         $currentmap->{'num_assess'}++;
1.53      matthew   378:         $currentmap->{'num_assess_parts'}+= scalar(@$parts);
1.45      matthew   379:     }
1.49      matthew   380:     return ($top,\@Sequences,\@Assessments);
1.45      matthew   381: }
1.50      matthew   382: 
                    383: #################################################
                    384: #################################################
1.45      matthew   385: 
1.1       stredwic  386: =pod
                    387: 
                    388: =item &ProcessTopResourceMap()
                    389: 
                    390: Trace through the "big hash" created in rat/lonuserstate.pm::loadmap.  
                    391: Basically, this function organizes a subset of the data and stores it in
                    392: cached data.  The data stored is the problems, sequences, sequence titles,
                    393: parts of problems, and their ordering.  Column width information is also 
                    394: partially handled here on a per sequence basis.
                    395: 
                    396: =over 4
                    397: 
                    398: Input: $cache, $c
                    399: 
                    400: $cache:  A pointer to a hash to store the information
                    401: 
                    402: $c:  The connection class used to determine if an abort has been sent to the 
                    403: browser
                    404: 
                    405: Output: A string that contains an error message or "OK" if everything went 
                    406: smoothly.
                    407: 
                    408: =back
                    409: 
                    410: =cut
                    411: 
                    412: sub ProcessTopResourceMap {
1.11      stredwic  413:     my ($cache,$c)=@_;
1.1       stredwic  414:     my %hash;
                    415:     my $fn=$ENV{'request.course.fn'};
                    416:     if(-e "$fn.db") {
                    417: 	my $tieTries=0;
                    418: 	while($tieTries < 3) {
                    419:             if($c->aborted()) {
                    420:                 return;
                    421:             }
1.10      stredwic  422: 	    if(tie(%hash,'GDBM_File',"$fn.db",&GDBM_READER(),0640)) {
1.1       stredwic  423: 		last;
                    424: 	    }
                    425: 	    $tieTries++;
                    426: 	    sleep 1;
                    427: 	}
                    428: 	if($tieTries >= 3) {
                    429:             return 'Coursemap undefined.';
                    430:         }
                    431:     } else {
                    432:         return 'Can not open Coursemap.';
                    433:     }
                    434: 
1.28      stredwic  435:     my $oldkeys;
1.40      minaeibi  436:     delete $cache->{'OptionResponses'};
1.28      stredwic  437:     if(defined($cache->{'ResourceKeys'})) {
                    438:         $oldkeys = $cache->{'ResourceKeys'};
                    439:         foreach (split(':::', $cache->{'ResourceKeys'})) {
                    440:             delete $cache->{$_};
                    441:         }
                    442:         delete $cache->{'ResourceKeys'};
                    443:     }
                    444: 
1.1       stredwic  445:     # Initialize state machine.  Set information pointing to top level map.
                    446:     my (@sequences, @currentResource, @finishResource);
                    447:     my ($currentSequence, $currentResourceID, $lastResourceID);
                    448: 
1.31      www       449:     $currentResourceID=$hash{'ids_'.
                    450:       &Apache::lonnet::clutter($ENV{'request.course.uri'})};
1.1       stredwic  451:     push(@currentResource, $currentResourceID);
                    452:     $lastResourceID=-1;
                    453:     $currentSequence=-1;
                    454:     my $topLevelSequenceNumber = $currentSequence;
                    455: 
1.11      stredwic  456:     my %sequenceRecord;
1.28      stredwic  457:     my %allkeys;
1.1       stredwic  458:     while(1) {
                    459:         if($c->aborted()) {
                    460:             last;
                    461:         }
                    462: 	# HANDLE NEW SEQUENCE!
                    463: 	#if page || sequence
1.11      stredwic  464: 	if(defined($hash{'map_pc_'.$hash{'src_'.$currentResourceID}}) &&
                    465:            !defined($sequenceRecord{$currentResourceID})) {
                    466:             $sequenceRecord{$currentResourceID}++;
1.1       stredwic  467: 	    push(@sequences, $currentSequence);
                    468: 	    push(@currentResource, $currentResourceID);
                    469: 	    push(@finishResource, $lastResourceID);
                    470: 
                    471: 	    $currentSequence=$hash{'map_pc_'.$hash{'src_'.$currentResourceID}};
                    472: 
                    473:             # Mark sequence as containing problems.  If it doesn't, then
                    474:             # it will be removed when processing for this sequence is
                    475:             # complete.  This allows the problems in a sequence
                    476:             # to be outputed before problems in the subsequences
                    477:             if(!defined($cache->{'orderedSequences'})) {
                    478:                 $cache->{'orderedSequences'}=$currentSequence;
                    479:             } else {
                    480:                 $cache->{'orderedSequences'}.=':'.$currentSequence;
                    481:             }
1.28      stredwic  482:             $allkeys{'orderedSequences'}++;
1.1       stredwic  483: 
                    484: 	    $lastResourceID=$hash{'map_finish_'.
                    485: 				  $hash{'src_'.$currentResourceID}};
                    486: 	    $currentResourceID=$hash{'map_start_'.
                    487: 				     $hash{'src_'.$currentResourceID}};
                    488: 
                    489: 	    if(!($currentResourceID) || !($lastResourceID)) {
                    490: 		$currentSequence=pop(@sequences);
                    491: 		$currentResourceID=pop(@currentResource);
                    492: 		$lastResourceID=pop(@finishResource);
                    493: 		if($currentSequence eq $topLevelSequenceNumber) {
                    494: 		    last;
                    495: 		}
                    496: 	    }
1.12      stredwic  497:             next;
1.1       stredwic  498: 	}
                    499: 
                    500: 	# Handle gradable resources: exams, problems, etc
                    501: 	$currentResourceID=~/(\d+)\.(\d+)/;
                    502:         my $partA=$1;
                    503:         my $partB=$2;
                    504: 	if($hash{'src_'.$currentResourceID}=~
                    505: 	   /\.(problem|exam|quiz|assess|survey|form)$/ &&
1.11      stredwic  506: 	   $partA eq $currentSequence && 
                    507:            !defined($sequenceRecord{$currentSequence.':'.
                    508:                                     $currentResourceID})) {
                    509:             $sequenceRecord{$currentSequence.':'.$currentResourceID}++;
1.1       stredwic  510: 	    my $Problem = &Apache::lonnet::symbclean(
                    511: 			  &Apache::lonnet::declutter($hash{'map_id_'.$partA}).
                    512: 			  '___'.$partB.'___'.
                    513: 			  &Apache::lonnet::declutter($hash{'src_'.
                    514: 							 $currentResourceID}));
                    515: 
                    516: 	    $cache->{$currentResourceID.':problem'}=$Problem;
1.28      stredwic  517:             $allkeys{$currentResourceID.':problem'}++;
1.1       stredwic  518: 	    if(!defined($cache->{$currentSequence.':problems'})) {
                    519: 		$cache->{$currentSequence.':problems'}=$currentResourceID;
                    520: 	    } else {
                    521: 		$cache->{$currentSequence.':problems'}.=
                    522: 		    ':'.$currentResourceID;
                    523: 	    }
1.28      stredwic  524:             $allkeys{$currentSequence.':problems'}++;
1.1       stredwic  525: 
1.2       stredwic  526: 	    my $meta=$hash{'src_'.$currentResourceID};
                    527: #            $cache->{$currentResourceID.':title'}=
                    528: #                &Apache::lonnet::metdata($meta,'title');
                    529:             $cache->{$currentResourceID.':title'}=
                    530:                 $hash{'title_'.$currentResourceID};
1.28      stredwic  531:             $allkeys{$currentResourceID.':title'}++;
1.9       minaeibi  532:             $cache->{$currentResourceID.':source'}=
                    533:                 $hash{'src_'.$currentResourceID};
1.28      stredwic  534:             $allkeys{$currentResourceID.':source'}++;
1.2       stredwic  535: 
1.1       stredwic  536:             # Get Parts for problem
1.8       stredwic  537:             my %beenHere;
                    538:             foreach (split(/\,/,&Apache::lonnet::metadata($meta,'packages'))) {
                    539:                 if(/^\w+response_\d+.*/) {
                    540:                     my (undef, $partId, $responseId) = split(/_/,$_);
                    541:                     if($beenHere{'p:'.$partId} ==  0) {
                    542:                         $beenHere{'p:'.$partId}++;
                    543:                         if(!defined($cache->{$currentSequence.':'.
                    544:                                             $currentResourceID.':parts'})) {
                    545:                             $cache->{$currentSequence.':'.$currentResourceID.
                    546:                                      ':parts'}=$partId;
                    547:                         } else {
                    548:                             $cache->{$currentSequence.':'.$currentResourceID.
                    549:                                      ':parts'}.=':'.$partId;
                    550:                         }
1.28      stredwic  551:                         $allkeys{$currentSequence.':'.$currentResourceID.
                    552:                                   ':parts'}++;
1.8       stredwic  553:                     }
                    554:                     if($beenHere{'r:'.$partId.':'.$responseId} == 0) {
                    555:                         $beenHere{'r:'.$partId.':'.$responseId}++;
                    556:                         if(!defined($cache->{$currentSequence.':'.
                    557:                                              $currentResourceID.':'.$partId.
                    558:                                              ':responseIDs'})) {
                    559:                             $cache->{$currentSequence.':'.$currentResourceID.
                    560:                                      ':'.$partId.':responseIDs'}=$responseId;
                    561:                         } else {
                    562:                             $cache->{$currentSequence.':'.$currentResourceID.
                    563:                                      ':'.$partId.':responseIDs'}.=':'.
                    564:                                                                   $responseId;
                    565:                         }
1.28      stredwic  566:                         $allkeys{$currentSequence.':'.$currentResourceID.':'.
                    567:                                      $partId.':responseIDs'}++;
1.1       stredwic  568:                     }
1.8       stredwic  569:                     if(/^optionresponse/ && 
                    570:                        $beenHere{'o:'.$partId.':'.$currentResourceID} == 0) {
                    571:                         $beenHere{'o:'.$partId.$currentResourceID}++;
                    572:                         if(defined($cache->{'OptionResponses'})) {
                    573:                             $cache->{'OptionResponses'}.= ':::'.
1.16      stredwic  574:                                 $currentSequence.':'.$currentResourceID.':'.
                    575:                                 $partId.':'.$responseId;
                    576:                         } else {
                    577:                             $cache->{'OptionResponses'}= $currentSequence.':'.
1.8       stredwic  578:                                 $currentResourceID.':'.
                    579:                                 $partId.':'.$responseId;
1.2       stredwic  580:                         }
1.28      stredwic  581:                         $allkeys{'OptionResponses'}++;
1.2       stredwic  582:                     }
                    583:                 }
1.8       stredwic  584:             }
                    585:         }
1.1       stredwic  586: 
                    587: 	# if resource == finish resource, then it is the end of a sequence/page
                    588: 	if($currentResourceID eq $lastResourceID) {
                    589: 	    # pop off last resource of sequence
                    590: 	    $currentResourceID=pop(@currentResource);
                    591: 	    $lastResourceID=pop(@finishResource);
                    592: 
                    593: 	    if(defined($cache->{$currentSequence.':problems'})) {
                    594: 		# Capture sequence information here
                    595: 		$cache->{$currentSequence.':title'}=
                    596: 		    $hash{'title_'.$currentResourceID};
1.28      stredwic  597:                 $allkeys{$currentSequence.':title'}++;
1.2       stredwic  598:                 $cache->{$currentSequence.':source'}=
                    599:                     $hash{'src_'.$currentResourceID};
1.28      stredwic  600:                 $allkeys{$currentSequence.':source'}++;
1.1       stredwic  601: 
                    602:                 my $totalProblems=0;
                    603:                 foreach my $currentProblem (split(/\:/,
                    604:                                                $cache->{$currentSequence.
                    605:                                                ':problems'})) {
                    606:                     foreach (split(/\:/,$cache->{$currentSequence.':'.
                    607:                                                    $currentProblem.
                    608:                                                    ':parts'})) {
                    609:                         $totalProblems++;
                    610:                     }
                    611:                 }
                    612: 		my @titleLength=split(//,$cache->{$currentSequence.
                    613:                                                     ':title'});
1.39      minaeibi  614:                 # $extra is 5 for problems correct and 3 for space
1.1       stredwic  615:                 # between problems correct and problem output
1.39      minaeibi  616:                 my $extra = 8;
1.1       stredwic  617: 		if(($totalProblems + $extra) > (scalar @titleLength)) {
                    618: 		    $cache->{$currentSequence.':columnWidth'}=
                    619:                         $totalProblems + $extra;
                    620: 		} else {
                    621: 		    $cache->{$currentSequence.':columnWidth'}=
                    622:                         (scalar @titleLength);
                    623: 		}
1.28      stredwic  624:                 $allkeys{$currentSequence.':columnWidth'}++;
1.1       stredwic  625: 	    } else {
                    626:                 # Remove sequence from list, if it contains no problems to
                    627:                 # display.
                    628:                 $cache->{'orderedSequences'}=~s/$currentSequence//;
                    629:                 $cache->{'orderedSequences'}=~s/::/:/g;
                    630:                 $cache->{'orderedSequences'}=~s/^:|:$//g;
                    631:             }
                    632: 
                    633: 	    $currentSequence=pop(@sequences);
                    634: 	    if($currentSequence eq $topLevelSequenceNumber) {
                    635: 		last;
                    636: 	    }
1.11      stredwic  637:         }
1.1       stredwic  638: 
                    639: 	# MOVE!!!
                    640: 	# move to next resource
                    641: 	unless(defined($hash{'to_'.$currentResourceID})) {
                    642: 	    # big problem, need to handle.  Next is probably wrong
1.11      stredwic  643:             my $errorMessage = 'Big problem in ';
                    644:             $errorMessage .= 'loncoursedata::ProcessTopLevelMap.';
1.41      matthew   645:             $errorMessage .= "  bighash to_$currentResourceID not defined!";
1.11      stredwic  646:             &Apache::lonnet::logthis($errorMessage);
1.44      albertel  647: 	    if (!defined($currentResourceID)) {last;}
1.1       stredwic  648: 	}
                    649: 	my @nextResources=();
                    650: 	foreach (split(/\,/,$hash{'to_'.$currentResourceID})) {
1.11      stredwic  651:             if(!defined($sequenceRecord{$currentSequence.':'.
                    652:                                         $hash{'goesto_'.$_}})) {
                    653:                 push(@nextResources, $hash{'goesto_'.$_});
                    654:             }
1.1       stredwic  655: 	}
                    656: 	push(@currentResource, @nextResources);
                    657: 	# Set the next resource to be processed
                    658: 	$currentResourceID=pop(@currentResource);
                    659:     }
                    660: 
1.28      stredwic  661:     my @theKeys = keys(%allkeys);
                    662:     my $newkeys = join(':::', @theKeys);
                    663:     $cache->{'ResourceKeys'} = join(':::', $newkeys);
                    664:     if($newkeys ne $oldkeys) {
                    665:         $cache->{'ResourceUpdated'} = 'true';
                    666:     } else {
                    667:         $cache->{'ResourceUpdated'} = 'false';
                    668:     }
                    669: 
1.1       stredwic  670:     unless (untie(%hash)) {
                    671:         &Apache::lonnet::logthis("<font color=blue>WARNING: ".
                    672:                                  "Could not untie coursemap $fn (browse)".
                    673:                                  ".</font>"); 
                    674:     }
                    675: 
                    676:     return 'OK';
                    677: }
                    678: 
                    679: =pod
                    680: 
1.3       stredwic  681: =item &ProcessClasslist()
1.1       stredwic  682: 
1.3       stredwic  683: Taking the class list dumped from &DownloadClasslist(), all the 
1.1       stredwic  684: students and their non-class information is processed using the 
                    685: &ProcessStudentInformation() function.  A date stamp is also recorded for
                    686: when the data was processed.
                    687: 
1.3       stredwic  688: Takes data downloaded for a student and breaks it up into managable pieces and 
                    689: stored in cache data.  The username, domain, class related date, PID, 
                    690: full name, and section are all processed here.
                    691: 
1.1       stredwic  692: =over 4
                    693: 
                    694: Input: $cache, $classlist, $courseID, $ChartDB, $c
                    695: 
                    696: $cache: A hash pointer to store the data
                    697: 
                    698: $classlist:  The hash of data collected about a student from 
1.3       stredwic  699: &DownloadClasslist().  The hash contains a list of students, a pointer 
1.23      stredwic  700: to a hash of student information for each student, and each students section 
1.1       stredwic  701: number.
                    702: 
                    703: $courseID:  The course ID
                    704: 
                    705: $ChartDB:  The name of the cache database file.
                    706: 
                    707: $c:  The connection class used to determine if an abort has been sent to the 
                    708: browser
                    709: 
                    710: Output: @names
                    711: 
                    712: @names:  An array of students whose information has been processed, and are to 
1.32      matthew   713: be considered in an arbitrary order.  The entries in @names are of the form
                    714: username:domain.
                    715: 
                    716: The values in $cache are as follows:
                    717: 
                    718:  *NOTE: for the following $name implies username:domain
                    719:  $name.':error'                  only defined if an error occured.  Value
                    720:                                  contains the error message
                    721:  $name.':lastDownloadTime'       unconverted time of the last update of a
                    722:                                  student\'s course data
                    723:  $name.'updateTime'              coverted time of the last update of a 
                    724:                                  student\'s course data
                    725:  $name.':username'               username of a student
                    726:  $name.':domain'                 domain of a student
                    727:  $name.':fullname'               full name of a student
                    728:  $name.':id'                     PID of a student
                    729:  $name.':Status'                 active/expired status of a student
                    730:  $name.':section'                section of a student
1.1       stredwic  731: 
                    732: =back
                    733: 
                    734: =cut
                    735: 
1.3       stredwic  736: sub ProcessClasslist {
                    737:     my ($cache,$classlist,$courseID,$c)=@_;
1.1       stredwic  738:     my @names=();
                    739: 
1.3       stredwic  740:     $cache->{'ClasslistTimeStamp'}=$classlist->{'lastDownloadTime'};
                    741:     if($classlist->{'UpToDate'} eq 'true') {
                    742:         return split(/:::/,$cache->{'NamesOfStudents'});;
                    743:     }
                    744: 
1.1       stredwic  745:     foreach my $name (keys(%$classlist)) {
                    746:         if($name =~ /\:section/ || $name =~ /\:studentInformation/ ||
1.3       stredwic  747:            $name eq '' || $name eq 'UpToDate' || $name eq 'lastDownloadTime') {
1.1       stredwic  748:             next;
                    749:         }
                    750:         if($c->aborted()) {
1.3       stredwic  751:             return ();
1.1       stredwic  752:         }
1.32      matthew   753:         my $studentInformation = $classlist->{$name.':studentInformation'};
                    754:         my $date = $classlist->{$name};
1.3       stredwic  755:         my ($studentName,$studentDomain) = split(/\:/,$name);
                    756: 
                    757:         $cache->{$name.':username'}=$studentName;
                    758:         $cache->{$name.':domain'}=$studentDomain;
1.10      stredwic  759:         # Initialize timestamp for student
1.3       stredwic  760:         if(!defined($cache->{$name.':lastDownloadTime'})) {
                    761:             $cache->{$name.':lastDownloadTime'}='Not downloaded';
1.6       stredwic  762:             $cache->{$name.':updateTime'}=' Not updated';
1.3       stredwic  763:         }
                    764: 
1.20      stredwic  765:         my $error = 0;
                    766:         foreach(keys(%$studentInformation)) {
                    767:             if(/^(con_lost|error|no_such_host)/i) {
                    768:                 $cache->{$name.':error'}=
                    769:                     'Could not download student environment data.';
                    770:                 $cache->{$name.':fullname'}='';
                    771:                 $cache->{$name.':id'}='';
                    772:                 $error = 1;
                    773:             }
                    774:         }
                    775:         next if($error);
                    776:         push(@names,$name);
                    777:         $cache->{$name.':fullname'}=&ProcessFullName(
1.3       stredwic  778:                                           $studentInformation->{'lastname'},
                    779:                                           $studentInformation->{'generation'},
                    780:                                           $studentInformation->{'firstname'},
                    781:                                           $studentInformation->{'middlename'});
1.20      stredwic  782:         $cache->{$name.':id'}=$studentInformation->{'id'};
1.3       stredwic  783: 
                    784:         my ($end, $start)=split(':',$date);
                    785:         $courseID=~s/\_/\//g;
                    786:         $courseID=~s/^(\w)/\/$1/;
                    787: 
                    788:         my $sec='';
1.32      matthew   789:         my $sectionData = $classlist->{$name.':sections'};
1.3       stredwic  790:         foreach my $key (keys (%$sectionData)) {
                    791:             my $value = $sectionData->{$key};
                    792:             if ($key=~/^$courseID(?:\/)*(\w+)*\_st$/) {
                    793:                 my $tempsection=$1;
                    794:                 if($key eq $courseID.'_st') {
                    795:                     $tempsection='';
                    796:                 }
1.32      matthew   797:                 my (undef,$roleend,$rolestart)=split(/\_/,$value);
1.3       stredwic  798:                 if($roleend eq $end && $rolestart eq $start) {
                    799:                     $sec = $tempsection;
                    800:                     last;
                    801:                 }
                    802:             }
                    803:         }
                    804: 
                    805:         my $status='Expired';
                    806:         if(((!$end) || time < $end) && ((!$start) || (time > $start))) {
                    807:             $status='Active';
                    808:         }
                    809:         $cache->{$name.':Status'}=$status;
                    810:         $cache->{$name.':section'}=$sec;
1.7       stredwic  811: 
                    812:         if($sec eq '' || !defined($sec) || $sec eq ' ') {
                    813:             $sec = 'none';
                    814:         }
                    815:         if(defined($cache->{'sectionList'})) {
                    816:             if($cache->{'sectionList'} !~ /(^$sec:|^$sec$|:$sec$|:$sec:)/) {
                    817:                 $cache->{'sectionList'} .= ':'.$sec;
                    818:             }
                    819:         } else {
                    820:             $cache->{'sectionList'} = $sec;
                    821:         }
1.1       stredwic  822:     }
                    823: 
1.3       stredwic  824:     $cache->{'ClasslistTimestamp'}=time;
                    825:     $cache->{'NamesOfStudents'}=join(':::',@names);
1.1       stredwic  826: 
                    827:     return @names;
                    828: }
                    829: 
                    830: =pod
                    831: 
                    832: =item &ProcessStudentData()
                    833: 
                    834: Takes the course data downloaded for a student in 
1.4       stredwic  835: &DownloadCourseInformation() and breaks it up into key value pairs
1.1       stredwic  836: to be stored in the cached data.  The keys are comprised of the 
                    837: $username:$domain:$keyFromCourseDatabase.  The student username:domain is
1.23      stredwic  838: stored away signifying that the students information has been downloaded and 
1.1       stredwic  839: can be reused from cached data.
                    840: 
                    841: =over 4
                    842: 
                    843: Input: $cache, $courseData, $name
                    844: 
                    845: $cache: A hash pointer to store data
                    846: 
                    847: $courseData:  A hash pointer that points to the course data downloaded for a 
                    848: student.
                    849: 
                    850: $name:  username:domain
                    851: 
                    852: Output: None
                    853: 
                    854: *NOTE:  There is no output, but an error message is stored away in the cache 
                    855: data.  This is checked in &FormatStudentData().  The key username:domain:error 
                    856: will only exist if an error occured.  The error is an error from 
1.4       stredwic  857: &DownloadCourseInformation().
1.1       stredwic  858: 
                    859: =back
                    860: 
                    861: =cut
                    862: 
                    863: sub ProcessStudentData {
                    864:     my ($cache,$courseData,$name)=@_;
                    865: 
1.13      stredwic  866:     if(!&CheckDateStampError($courseData, $cache, $name)) {
                    867:         return;
                    868:     }
                    869: 
1.28      stredwic  870:     # This little delete thing, should not be here.  Move some other
                    871:     # time though.
1.26      stredwic  872:     if(defined($cache->{$name.':keys'})) {
                    873: 	foreach (split(':::', $cache->{$name.':keys'})) {
                    874: 	    delete $cache->{$name.':'.$_};
                    875: 	}
1.28      stredwic  876:         delete $cache->{$name.':keys'};
1.26      stredwic  877:     }
                    878: 
                    879:     my %courseKeys;
1.22      stredwic  880:     # user name:domain was prepended earlier in DownloadCourseInformation
1.13      stredwic  881:     foreach (keys %$courseData) {
1.29      albertel  882: 	my $currentKey = $_;
                    883: 	$currentKey =~ s/^$name//;
1.26      stredwic  884: 	$courseKeys{$currentKey}++;
1.13      stredwic  885:         $cache->{$_}=$courseData->{$_};
                    886:     }
                    887: 
1.26      stredwic  888:     $cache->{$name.':keys'} = join(':::', keys(%courseKeys));
                    889: 
1.13      stredwic  890:     return;
                    891: }
                    892: 
1.22      stredwic  893: =pod
                    894: 
                    895: =item &ExtractStudentData()
                    896: 
                    897: HISTORY: This function originally existed in every statistics module,
                    898: and performed different tasks, the had some overlap.  Due to the need
                    899: for the data from the different modules, they were combined into
                    900: a single function.
                    901: 
                    902: This function now extracts all the necessary course data for a student
                    903: from what was downloaded from their homeserver.  There is some extra
                    904: time overhead compared to the ProcessStudentInformation function, but
                    905: it would have had to occurred at some point anyways.  This is now
                    906: typically called while downloading the data it will process.  It is
                    907: the brother function to ProcessStudentInformation.
                    908: 
                    909: =over 4
                    910: 
                    911: Input: $input, $output, $data, $name
                    912: 
                    913: $input: A hash that contains the input data to be processed
                    914: 
                    915: $output: A hash to contain the processed data
                    916: 
                    917: $data: A hash containing the information on what is to be
                    918: processed and how (basically).
                    919: 
                    920: $name:  username:domain
                    921: 
                    922: The input is slightly different here, but is quite simple.
                    923: It is currently used where the $input, $output, and $data
                    924: can and are often the same hashes, but they do not need
                    925: to be.
                    926: 
                    927: Output: None
                    928: 
                    929: *NOTE:  There is no output, but an error message is stored away in the cache 
                    930: data.  This is checked in &FormatStudentData().  The key username:domain:error 
                    931: will only exist if an error occured.  The error is an error from 
                    932: &DownloadCourseInformation().
                    933: 
                    934: =back
                    935: 
                    936: =cut
                    937: 
1.13      stredwic  938: sub ExtractStudentData {
                    939:     my ($input, $output, $data, $name)=@_;
                    940: 
                    941:     if(!&CheckDateStampError($input, $data, $name)) {
1.3       stredwic  942:         return;
                    943:     }
                    944: 
1.28      stredwic  945:     # This little delete thing, should not be here.  Move some other
                    946:     # time though.
1.26      stredwic  947:     my %allkeys;
                    948:     if(defined($output->{$name.':keys'})) {
                    949: 	foreach (split(':::', $output->{$name.':keys'})) {
                    950: 	    delete $output->{$name.':'.$_};
                    951: 	}
1.28      stredwic  952:         delete $output->{$name.':keys'};
1.26      stredwic  953:     }
                    954: 
1.13      stredwic  955:     my ($username,$domain)=split(':',$name);
                    956: 
                    957:     my $Version;
                    958:     my $problemsCorrect = 0;
                    959:     my $totalProblems   = 0;
                    960:     my $problemsSolved  = 0;
                    961:     my $numberOfParts   = 0;
1.14      stredwic  962:     my $totalAwarded    = 0;
1.13      stredwic  963:     foreach my $sequence (split(':', $data->{'orderedSequences'})) {
                    964:         foreach my $problemID (split(':', $data->{$sequence.':problems'})) {
                    965:             my $problem = $data->{$problemID.':problem'};
                    966:             my $LatestVersion = $input->{$name.':version:'.$problem};
                    967: 
                    968:             # Output dashes for all the parts of this problem if there
                    969:             # is no version information about the current problem.
1.27      stredwic  970:             $output->{$name.':'.$problemID.':NoVersion'} = 'false';
                    971:             $allkeys{$name.':'.$problemID.':NoVersion'}++;
1.13      stredwic  972:             if(!$LatestVersion) {
                    973:                 foreach my $part (split(/\:/,$data->{$sequence.':'.
                    974:                                                       $problemID.
                    975:                                                       ':parts'})) {
1.15      stredwic  976:                     $output->{$name.':'.$problemID.':'.$part.':tries'} = 0;
                    977:                     $output->{$name.':'.$problemID.':'.$part.':awarded'} = 0;
                    978:                     $output->{$name.':'.$problemID.':'.$part.':code'} = ' ';
1.26      stredwic  979: 		    $allkeys{$name.':'.$problemID.':'.$part.':tries'}++;
                    980: 		    $allkeys{$name.':'.$problemID.':'.$part.':awarded'}++;
                    981: 		    $allkeys{$name.':'.$problemID.':'.$part.':code'}++;
1.13      stredwic  982:                     $totalProblems++;
                    983:                 }
                    984:                 $output->{$name.':'.$problemID.':NoVersion'} = 'true';
                    985:                 next;
                    986:             }
                    987: 
                    988:             my %partData=undef;
                    989:             # Initialize part data, display skips correctly
                    990:             # Skip refers to when a student made no submissions on that
                    991:             # part/problem.
                    992:             foreach my $part (split(/\:/,$data->{$sequence.':'.
                    993:                                                  $problemID.
                    994:                                                  ':parts'})) {
                    995:                 $partData{$part.':tries'}=0;
                    996:                 $partData{$part.':code'}=' ';
                    997:                 $partData{$part.':awarded'}=0;
                    998:                 $partData{$part.':timestamp'}=0;
                    999:                 foreach my $response (split(':', $data->{$sequence.':'.
                   1000:                                                          $problemID.':'.
                   1001:                                                          $part.':responseIDs'})) {
                   1002:                     $partData{$part.':'.$response.':submission'}='';
                   1003:                 }
                   1004:             }
                   1005: 
                   1006:             # Looping through all the versions of each part, starting with the
                   1007:             # oldest version.  Basically, it gets the most recent 
                   1008:             # set of grade data for each part.
                   1009:             my @submissions = ();
                   1010: 	    for(my $Version=1; $Version<=$LatestVersion; $Version++) {
                   1011:                 foreach my $part (split(/\:/,$data->{$sequence.':'.
                   1012:                                                      $problemID.
                   1013:                                                      ':parts'})) {
                   1014: 
                   1015:                     if(!defined($input->{"$name:$Version:$problem".
                   1016:                                          ":resource.$part.solved"})) {
                   1017:                         # No grade for this submission, so skip
                   1018:                         next;
                   1019:                     }
                   1020: 
                   1021:                     my $tries=0;
                   1022:                     my $code=' ';
                   1023:                     my $awarded=0;
                   1024: 
                   1025:                     $tries = $input->{$name.':'.$Version.':'.$problem.
                   1026:                                       ':resource.'.$part.'.tries'};
                   1027:                     $awarded = $input->{$name.':'.$Version.':'.$problem.
                   1028:                                         ':resource.'.$part.'.awarded'};
                   1029: 
                   1030:                     $partData{$part.':awarded'}=($awarded) ? $awarded : 0;
                   1031:                     $partData{$part.':tries'}=($tries) ? $tries : 0;
                   1032: 
                   1033:                     $partData{$part.':timestamp'}=$input->{$name.':'.$Version.':'.
                   1034:                                                            $problem.
                   1035:                                                            ':timestamp'};
                   1036:                     if(!$input->{$name.':'.$Version.':'.$problem.':resource.'.$part.
                   1037:                                  '.previous'}) {
                   1038:                         foreach my $response (split(':',
                   1039:                                                    $data->{$sequence.':'.
                   1040:                                                            $problemID.':'.
                   1041:                                                            $part.':responseIDs'})) {
                   1042:                             @submissions=($input->{$name.':'.$Version.':'.
                   1043:                                                    $problem.
                   1044:                                                    ':resource.'.$part.'.'.
                   1045:                                                    $response.'.submission'},
                   1046:                                           @submissions);
                   1047:                         }
                   1048:                     }
                   1049: 
                   1050:                     my $val = $input->{$name.':'.$Version.':'.$problem.
                   1051:                                        ':resource.'.$part.'.solved'};
                   1052:                     if    ($val eq 'correct_by_student')   {$code = '*';} 
                   1053:                     elsif ($val eq 'correct_by_override')  {$code = '+';}
                   1054:                     elsif ($val eq 'incorrect_attempted')  {$code = '.';} 
                   1055:                     elsif ($val eq 'incorrect_by_override'){$code = '-';}
                   1056:                     elsif ($val eq 'excused')              {$code = 'x';}
                   1057:                     elsif ($val eq 'ungraded_attempted')   {$code = '#';}
                   1058:                     else                                   {$code = ' ';}
                   1059:                     $partData{$part.':code'}=$code;
                   1060:                 }
                   1061:             }
                   1062: 
                   1063:             foreach my $part (split(/\:/,$data->{$sequence.':'.$problemID.
                   1064:                                                  ':parts'})) {
                   1065:                 $output->{$name.':'.$problemID.':'.$part.':wrong'} = 
                   1066:                     $partData{$part.':tries'};
1.26      stredwic 1067: 		$allkeys{$name.':'.$problemID.':'.$part.':wrong'}++;
1.13      stredwic 1068: 
                   1069:                 if($partData{$part.':code'} eq '*') {
                   1070:                     $output->{$name.':'.$problemID.':'.$part.':wrong'}--;
                   1071:                     $problemsCorrect++;
                   1072:                 } elsif($partData{$part.':code'} eq '+') {
                   1073:                     $output->{$name.':'.$problemID.':'.$part.':wrong'}--;
                   1074:                     $problemsCorrect++;
                   1075:                 }
                   1076: 
                   1077:                 $output->{$name.':'.$problemID.':'.$part.':tries'} = 
                   1078:                     $partData{$part.':tries'};
                   1079:                 $output->{$name.':'.$problemID.':'.$part.':code'} =
                   1080:                     $partData{$part.':code'};
                   1081:                 $output->{$name.':'.$problemID.':'.$part.':awarded'} =
                   1082:                     $partData{$part.':awarded'};
1.26      stredwic 1083: 		$allkeys{$name.':'.$problemID.':'.$part.':tries'}++;
                   1084: 		$allkeys{$name.':'.$problemID.':'.$part.':code'}++;
                   1085: 		$allkeys{$name.':'.$problemID.':'.$part.':awarded'}++;
                   1086: 
1.14      stredwic 1087:                 $totalAwarded += $partData{$part.':awarded'};
1.13      stredwic 1088:                 $output->{$name.':'.$problemID.':'.$part.':timestamp'} =
                   1089:                     $partData{$part.':timestamp'};
1.26      stredwic 1090: 		$allkeys{$name.':'.$problemID.':'.$part.':timestamp'}++;
                   1091: 
1.13      stredwic 1092:                 foreach my $response (split(':', $data->{$sequence.':'.
                   1093:                                                          $problemID.':'.
                   1094:                                                          $part.':responseIDs'})) {
                   1095:                     $output->{$name.':'.$problemID.':'.$part.':'.$response.
                   1096:                               ':submission'}=join(':::',@submissions);
1.26      stredwic 1097: 		    $allkeys{$name.':'.$problemID.':'.$part.':'.$response.
                   1098: 			     ':submission'}++;
1.13      stredwic 1099:                 }
1.3       stredwic 1100: 
1.13      stredwic 1101:                 if($partData{$part.':code'} ne 'x') {
                   1102:                     $totalProblems++;
                   1103:                 }
                   1104:             }
1.1       stredwic 1105:         }
1.13      stredwic 1106: 
                   1107:         $output->{$name.':'.$sequence.':problemsCorrect'} = $problemsCorrect;
1.26      stredwic 1108: 	$allkeys{$name.':'.$sequence.':problemsCorrect'}++;
1.13      stredwic 1109:         $problemsSolved += $problemsCorrect;
                   1110: 	$problemsCorrect=0;
1.3       stredwic 1111:     }
                   1112: 
1.13      stredwic 1113:     $output->{$name.':problemsSolved'} = $problemsSolved;
                   1114:     $output->{$name.':totalProblems'} = $totalProblems;
1.14      stredwic 1115:     $output->{$name.':totalAwarded'} = $totalAwarded;
1.26      stredwic 1116:     $allkeys{$name.':problemsSolved'}++;
                   1117:     $allkeys{$name.':totalProblems'}++;
                   1118:     $allkeys{$name.':totalAwarded'}++;
                   1119: 
                   1120:     $output->{$name.':keys'} = join(':::', keys(%allkeys));
1.1       stredwic 1121: 
                   1122:     return;
1.4       stredwic 1123: }
                   1124: 
                   1125: sub LoadDiscussion {
1.13      stredwic 1126:     my ($courseID)=@_;
1.5       minaeibi 1127:     my %Discuss=();
                   1128:     my %contrib=&Apache::lonnet::dump(
                   1129:                 $courseID,
                   1130:                 $ENV{'course.'.$courseID.'.domain'},
                   1131:                 $ENV{'course.'.$courseID.'.num'});
                   1132: 				 
                   1133:     #my %contrib=&DownloadCourseInformation($name, $courseID, 0);
                   1134: 
1.4       stredwic 1135:     foreach my $temp(keys %contrib) {
                   1136: 	if ($temp=~/^version/) {
                   1137: 	    my $ver=$contrib{$temp};
                   1138: 	    my ($dummy,$prb)=split(':',$temp);
                   1139: 	    for (my $idx=1; $idx<=$ver; $idx++ ) {
                   1140: 		my $name=$contrib{"$idx:$prb:sendername"};
1.5       minaeibi 1141: 		$Discuss{"$name:$prb"}=$idx;	
1.4       stredwic 1142: 	    }
                   1143: 	}
                   1144:     }       
1.5       minaeibi 1145: 
                   1146:     return \%Discuss;
1.1       stredwic 1147: }
                   1148: 
                   1149: # ----- END PROCESSING FUNCTIONS ---------------------------------------
                   1150: 
                   1151: =pod
                   1152: 
                   1153: =head1 HELPER FUNCTIONS
                   1154: 
                   1155: These are just a couple of functions do various odd and end 
1.22      stredwic 1156: jobs.  There was also a couple of bulk functions added.  These are
                   1157: &DownloadStudentCourseData(), &DownloadStudentCourseDataSeparate(), and
                   1158: &CheckForResidualDownload().  These functions now act as the interface
                   1159: for downloading student course data.  The statistical modules should
                   1160: no longer make the calls to dump and download and process etc.  They
                   1161: make calls to these bulk functions to get their data.
1.1       stredwic 1162: 
                   1163: =cut
                   1164: 
                   1165: # ----- HELPER FUNCTIONS -----------------------------------------------
                   1166: 
1.13      stredwic 1167: sub CheckDateStampError {
                   1168:     my ($courseData, $cache, $name)=@_;
                   1169:     if($courseData->{$name.':UpToDate'} eq 'true') {
                   1170:         $cache->{$name.':lastDownloadTime'} = 
                   1171:             $courseData->{$name.':lastDownloadTime'};
                   1172:         if($courseData->{$name.':lastDownloadTime'} eq 'Not downloaded') {
                   1173:             $cache->{$name.':updateTime'} = ' Not updated';
                   1174:         } else {
                   1175:             $cache->{$name.':updateTime'}=
                   1176:                 localtime($courseData->{$name.':lastDownloadTime'});
                   1177:         }
                   1178:         return 0;
                   1179:     }
                   1180: 
                   1181:     $cache->{$name.':lastDownloadTime'}=$courseData->{$name.':lastDownloadTime'};
                   1182:     if($courseData->{$name.':lastDownloadTime'} eq 'Not downloaded') {
                   1183:         $cache->{$name.':updateTime'} = ' Not updated';
                   1184:     } else {
                   1185:         $cache->{$name.':updateTime'}=
                   1186:             localtime($courseData->{$name.':lastDownloadTime'});
                   1187:     }
                   1188: 
                   1189:     if(defined($courseData->{$name.':error'})) {
                   1190:         $cache->{$name.':error'}=$courseData->{$name.':error'};
                   1191:         return 0;
                   1192:     }
                   1193: 
                   1194:     return 1;
                   1195: }
                   1196: 
1.1       stredwic 1197: =pod
                   1198: 
                   1199: =item &ProcessFullName()
                   1200: 
                   1201: Takes lastname, generation, firstname, and middlename (or some partial
                   1202: set of this data) and returns the full name version as a string.  Format
                   1203: is Lastname generation, firstname middlename or a subset of this.
                   1204: 
                   1205: =cut
                   1206: 
                   1207: sub ProcessFullName {
                   1208:     my ($lastname, $generation, $firstname, $middlename)=@_;
                   1209:     my $Str = '';
                   1210: 
1.34      matthew  1211:     # Strip whitespace preceeding & following name components.
                   1212:     $lastname   =~ s/(\s+$|^\s+)//g;
                   1213:     $generation =~ s/(\s+$|^\s+)//g;
                   1214:     $firstname  =~ s/(\s+$|^\s+)//g;
                   1215:     $middlename =~ s/(\s+$|^\s+)//g;
                   1216: 
1.1       stredwic 1217:     if($lastname ne '') {
1.34      matthew  1218: 	$Str .= $lastname;
                   1219: 	$Str .= ' '.$generation if ($generation ne '');
                   1220: 	$Str .= ',';
                   1221:         $Str .= ' '.$firstname  if ($firstname ne '');
                   1222:         $Str .= ' '.$middlename if ($middlename ne '');
1.1       stredwic 1223:     } else {
1.34      matthew  1224:         $Str .= $firstname      if ($firstname ne '');
                   1225:         $Str .= ' '.$middlename if ($middlename ne '');
                   1226:         $Str .= ' '.$generation if ($generation ne '');
1.1       stredwic 1227:     }
                   1228: 
                   1229:     return $Str;
                   1230: }
                   1231: 
                   1232: =pod
                   1233: 
                   1234: =item &TestCacheData()
                   1235: 
                   1236: Determine if the cache database can be accessed with a tie.  It waits up to
                   1237: ten seconds before returning failure.  This function exists to help with
                   1238: the problems with stopping the data download.  When an abort occurs and the
                   1239: user quickly presses a form button and httpd child is created.  This
                   1240: child needs to wait for the other to finish (hopefully within ten seconds).
                   1241: 
                   1242: =over 4
                   1243: 
                   1244: Input: $ChartDB
                   1245: 
                   1246: $ChartDB: The name of the cache database to be opened
                   1247: 
                   1248: Output: -1, 0, 1
                   1249: 
1.23      stredwic 1250: -1: Could not tie database
1.1       stredwic 1251:  0: Use cached data
                   1252:  1: New cache database created, use that.
                   1253: 
                   1254: =back
                   1255: 
                   1256: =cut
                   1257: 
                   1258: sub TestCacheData {
                   1259:     my ($ChartDB,$isRecalculate,$totalDelay)=@_;
                   1260:     my $isCached=-1;
                   1261:     my %testData;
                   1262:     my $tieTries=0;
                   1263: 
                   1264:     if(!defined($totalDelay)) {
                   1265:         $totalDelay = 10;
                   1266:     }
                   1267: 
                   1268:     if ((-e "$ChartDB") && (!$isRecalculate)) {
                   1269: 	$isCached = 1;
                   1270:     } else {
                   1271: 	$isCached = 0;
                   1272:     }
                   1273: 
                   1274:     while($tieTries < $totalDelay) {
                   1275:         my $result=0;
                   1276:         if($isCached) {
1.10      stredwic 1277:             $result=tie(%testData,'GDBM_File',$ChartDB,&GDBM_READER(),0640);
1.1       stredwic 1278:         } else {
1.10      stredwic 1279:             $result=tie(%testData,'GDBM_File',$ChartDB,&GDBM_NEWDB(),0640);
1.1       stredwic 1280:         }
                   1281:         if($result) {
                   1282:             last;
                   1283:         }
                   1284:         $tieTries++;
                   1285:         sleep 1;
                   1286:     }
                   1287:     if($tieTries >= $totalDelay) {
                   1288:         return -1;
                   1289:     }
                   1290: 
                   1291:     untie(%testData);
                   1292: 
                   1293:     return $isCached;
                   1294: }
1.2       stredwic 1295: 
1.13      stredwic 1296: sub DownloadStudentCourseData {
                   1297:     my ($students,$checkDate,$cacheDB,$extract,$status,$courseID,$r,$c)=@_;
                   1298: 
                   1299:     my $title = 'LON-CAPA Statistics';
                   1300:     my $heading = 'Download and Process Course Data';
                   1301:     my $studentCount = scalar(@$students);
1.18      stredwic 1302: 
1.13      stredwic 1303:     my $WhatIWant;
1.20      stredwic 1304:     $WhatIWant = '(^version:|';
1.18      stredwic 1305:     $WhatIWant .= '^\d+:.+?:(resource\.\d+\.';
1.42      matthew  1306:     $WhatIWant .= '(solved|tries|previous|awarded|(\d+\.submission))\s*$';#'
1.13      stredwic 1307:     $WhatIWant .= '|timestamp)';
                   1308:     $WhatIWant .= ')';
1.20      stredwic 1309: #    $WhatIWant = '.';
1.13      stredwic 1310: 
                   1311:     if($status eq 'true') {
                   1312:         &Apache::lonhtmlcommon::Create_PrgWin($r, $title, $heading);
                   1313:     }
1.17      stredwic 1314: 
                   1315:     my $displayString;
                   1316:     my $count=0;
1.13      stredwic 1317:     foreach (@$students) {
1.24      stredwic 1318:         my %cache;
                   1319: 
1.13      stredwic 1320:         if($c->aborted()) { return 'Aborted'; }
                   1321: 
                   1322:         if($status eq 'true') {
1.17      stredwic 1323:             $count++;
1.13      stredwic 1324:             my $displayString = $count.'/'.$studentCount.': '.$_;
                   1325:             &Apache::lonhtmlcommon::Update_PrgWin($displayString, $r);
                   1326:         }
                   1327: 
                   1328:         my $downloadTime='Not downloaded';
1.28      stredwic 1329:         my $needUpdate = 'false';
1.13      stredwic 1330:         if($checkDate eq 'true'  && 
                   1331:            tie(%cache,'GDBM_File',$cacheDB,&GDBM_READER(),0640)) {
                   1332:             $downloadTime = $cache{$_.':lastDownloadTime'};
1.28      stredwic 1333:             $needUpdate = $cache{'ResourceUpdated'};
1.13      stredwic 1334:             untie(%cache);
                   1335:         }
                   1336: 
                   1337:         if($c->aborted()) { return 'Aborted'; }
                   1338: 
1.43      matthew  1339:         if($needUpdate eq 'true') {
1.28      stredwic 1340:             $downloadTime = 'Not downloaded';
                   1341: 	}
1.24      stredwic 1342: 	my $courseData = 
                   1343: 	    &DownloadCourseInformation($_, $courseID, $downloadTime, 
                   1344: 				       $WhatIWant);
                   1345: 	if(tie(%cache,'GDBM_File',$cacheDB,&GDBM_WRCREAT(),0640)) {
                   1346: 	    foreach my $key (keys(%$courseData)) {
                   1347: 		if($key =~ /^(con_lost|error|no_such_host)/i) {
                   1348: 		    $courseData->{$_.':error'} = 'No course data for '.$_;
                   1349: 		    last;
                   1350: 		}
                   1351: 	    }
                   1352: 	    if($extract eq 'true') {
                   1353: 		&ExtractStudentData($courseData, \%cache, \%cache, $_);
                   1354: 	    } else {
                   1355: 		&ProcessStudentData(\%cache, $courseData, $_);
                   1356: 	    }
                   1357: 	    untie(%cache);
                   1358: 	} else {
                   1359: 	    next;
                   1360: 	}
1.13      stredwic 1361:     }
                   1362:     if($status eq 'true') { &Apache::lonhtmlcommon::Close_PrgWin($r); }
                   1363: 
                   1364:     return 'OK';
                   1365: }
                   1366: 
                   1367: sub DownloadStudentCourseDataSeparate {
                   1368:     my ($students,$checkDate,$cacheDB,$extract,$status,$courseID,$r,$c)=@_;
1.46      matthew  1369:     my $residualFile = $Apache::lonnet::tmpdir.$courseID.'DownloadFile.db';
1.13      stredwic 1370:     my $title = 'LON-CAPA Statistics';
                   1371:     my $heading = 'Download Course Data';
                   1372: 
                   1373:     my $WhatIWant;
1.20      stredwic 1374:     $WhatIWant = '(^version:|';
1.18      stredwic 1375:     $WhatIWant .= '^\d+:.+?:(resource\.\d+\.';
1.45      matthew  1376:     $WhatIWant .= '(solved|tries|previous|awarded|(\d+\.submission))\s*$';#'
1.13      stredwic 1377:     $WhatIWant .= '|timestamp)';
                   1378:     $WhatIWant .= ')';
                   1379: 
1.30      stredwic 1380:     &CheckForResidualDownload($cacheDB, 'true', 'true', $courseID, $r, $c);
1.13      stredwic 1381: 
                   1382:     my $studentCount = scalar(@$students);
                   1383:     if($status eq 'true') {
                   1384:         &Apache::lonhtmlcommon::Create_PrgWin($r, $title, $heading);
                   1385:     }
1.17      stredwic 1386:     my $count=0;
                   1387:     my $displayString='';
1.13      stredwic 1388:     foreach (@$students) {
                   1389:         if($c->aborted()) {
                   1390:             return 'Aborted';
                   1391:         }
                   1392: 
                   1393:         if($status eq 'true') {
1.17      stredwic 1394:             $count++;
                   1395:             $displayString = $count.'/'.$studentCount.': '.$_;
1.13      stredwic 1396:             &Apache::lonhtmlcommon::Update_PrgWin($displayString, $r);
                   1397:         }
                   1398: 
1.24      stredwic 1399:         my %cache;
1.13      stredwic 1400:         my $downloadTime='Not downloaded';
1.28      stredwic 1401:         my $needUpdate = 'false';
1.13      stredwic 1402:         if($checkDate eq 'true'  && 
                   1403:            tie(%cache,'GDBM_File',$cacheDB,&GDBM_READER(),0640)) {
                   1404:             $downloadTime = $cache{$_.':lastDownloadTime'};
1.28      stredwic 1405:             $needUpdate = $cache{'ResourceUpdated'};
1.13      stredwic 1406:             untie(%cache);
                   1407:         }
                   1408: 
                   1409:         if($c->aborted()) {
                   1410:             return 'Aborted';
                   1411:         }
                   1412: 
1.43      matthew  1413:         if($needUpdate eq 'true') {
1.28      stredwic 1414:             $downloadTime = 'Not downloaded';
                   1415: 	}
                   1416: 
                   1417:         my $error = 0;
                   1418:         my $courseData = 
                   1419:             &DownloadCourseInformation($_, $courseID, $downloadTime,
                   1420:                                        $WhatIWant);
                   1421:         my %downloadData;
                   1422:         unless(tie(%downloadData,'GDBM_File',$residualFile,
                   1423:                    &GDBM_WRCREAT(),0640)) {
                   1424:             return 'Failed to tie temporary download hash.';
                   1425:         }
                   1426:         foreach my $key (keys(%$courseData)) {
                   1427:             $downloadData{$key} = $courseData->{$key};
                   1428:             if($key =~ /^(con_lost|error|no_such_host)/i) {
                   1429:                 $error = 1;
                   1430:                 last;
1.18      stredwic 1431:             }
1.28      stredwic 1432:         }
                   1433:         if($error) {
                   1434:             foreach my $deleteKey (keys(%$courseData)) {
                   1435:                 delete $downloadData{$deleteKey};
1.13      stredwic 1436:             }
1.28      stredwic 1437:             $downloadData{$_.':error'} = 'No course data for '.$_;
                   1438:         }
                   1439:         untie(%downloadData);
1.13      stredwic 1440:     }
                   1441:     if($status eq 'true') { &Apache::lonhtmlcommon::Close_PrgWin($r); }
                   1442: 
                   1443:     return &CheckForResidualDownload($cacheDB, 'true', 'true', 
                   1444:                                      $courseID, $r, $c);
                   1445: }
                   1446: 
                   1447: sub CheckForResidualDownload {
                   1448:     my ($cacheDB,$extract,$status,$courseID,$r,$c)=@_;
                   1449: 
1.46      matthew  1450:     my $residualFile = $Apache::lonnet::tmpdir.$courseID.'DownloadFile.db';
1.13      stredwic 1451:     if(!-e $residualFile) {
1.18      stredwic 1452:         return 'OK';
1.13      stredwic 1453:     }
                   1454: 
                   1455:     my %downloadData;
                   1456:     my %cache;
1.17      stredwic 1457:     unless(tie(%downloadData,'GDBM_File',$residualFile,&GDBM_READER(),0640)) {
                   1458:         return 'Can not tie database for check for residual download: tempDB';
                   1459:     }
                   1460:     unless(tie(%cache,'GDBM_File',$cacheDB,&GDBM_WRCREAT(),0640)) {
                   1461:         untie(%downloadData);
                   1462:         return 'Can not tie database for check for residual download: cacheDB';
1.13      stredwic 1463:     }
                   1464: 
                   1465:     my @students=();
                   1466:     my %checkStudent;
1.18      stredwic 1467:     my $key;
                   1468:     while(($key, undef) = each %downloadData) {
                   1469:         my @temp = split(':', $key);
1.13      stredwic 1470:         my $student = $temp[0].':'.$temp[1];
                   1471:         if(!defined($checkStudent{$student})) {
                   1472:             $checkStudent{$student}++;
                   1473:             push(@students, $student);
                   1474:         }
                   1475:     }
                   1476: 
                   1477:     my $heading = 'Process Course Data';
                   1478:     my $title = 'LON-CAPA Statistics';
                   1479:     my $studentCount = scalar(@students);
                   1480:     if($status eq 'true') {
                   1481:         &Apache::lonhtmlcommon::Create_PrgWin($r, $title, $heading);
                   1482:     }
                   1483: 
1.20      stredwic 1484:     my $count=1;
1.13      stredwic 1485:     foreach my $name (@students) {
                   1486:         last if($c->aborted());
                   1487: 
                   1488:         if($status eq 'true') {
1.19      stredwic 1489:             my $displayString = $count.'/'.$studentCount.': '.$name;
1.13      stredwic 1490:             &Apache::lonhtmlcommon::Update_PrgWin($displayString, $r);
                   1491:         }
                   1492: 
                   1493:         if($extract eq 'true') {
                   1494:             &ExtractStudentData(\%downloadData, \%cache, \%cache, $name);
                   1495:         } else {
                   1496:             &ProcessStudentData(\%cache, \%downloadData, $name);
                   1497:         }
                   1498:         $count++;
                   1499:     }
                   1500: 
                   1501:     if($status eq 'true') { &Apache::lonhtmlcommon::Close_PrgWin($r); }
                   1502: 
                   1503:     untie(%cache);
                   1504:     untie(%downloadData);
                   1505: 
                   1506:     if(!$c->aborted()) {
                   1507:         my @files = ($residualFile);
                   1508:         unlink(@files);
                   1509:     }
                   1510: 
                   1511:     return 'OK';
1.46      matthew  1512: }
                   1513: 
                   1514: 
                   1515: ################################################
                   1516: ################################################
                   1517: 
                   1518: =pod
                   1519: 
1.47      matthew  1520: =item &make_into_hash($values);
                   1521: 
                   1522: Returns a reference to a hash as described by $values.  $values is
                   1523: assumed to be the result of 
                   1524:     join(':',map {&Apache::lonnet::escape($_)} %orighash;
                   1525: 
                   1526: This is a helper function for get_current_state.
                   1527: 
                   1528: =cut
                   1529: 
                   1530: ################################################
                   1531: ################################################
                   1532: sub make_into_hash {
                   1533:     my $values = shift;
                   1534:     my %tmp = map { &Apache::lonnet::unescape($_); }
                   1535:                                            split(':',$values);
                   1536:     return \%tmp;
                   1537: }
                   1538: 
                   1539: 
                   1540: ################################################
                   1541: ################################################
                   1542: 
                   1543: =pod
                   1544: 
1.46      matthew  1545: =item &get_current_state($sname,$sdom,$symb,$courseid);
                   1546: 
1.47      matthew  1547: Retrieve the current status of a students performance.  $sname and
1.46      matthew  1548: $sdom are the only required parameters.  If $symb is undef the results
1.47      matthew  1549: of an &Apache::lonnet::currentdump() will be returned.  
1.46      matthew  1550: If $courseid is undef it will be retrieved from the environment.
                   1551: 
                   1552: The return structure is based on &Apache::lonnet::currentdump.  If
                   1553: $symb is unspecified, all the students data is returned in a hash of
                   1554: the form:
                   1555: ( 
                   1556:   symb1 => { param1 => value1, param2 => value2 ... },
                   1557:   symb2 => { param1 => value1, param2 => value2 ... },
                   1558: )
                   1559: 
                   1560: If $symb is specified, a hash of 
                   1561: (
                   1562:   param1 => value1, 
                   1563:   param2 => value2,
                   1564: )
                   1565: is returned.
                   1566: 
                   1567: If no data is found for $symb, or if the student has not performance data,
                   1568: an empty list is returned.
                   1569: 
                   1570: =cut
                   1571: 
                   1572: ################################################
                   1573: ################################################
                   1574: sub get_current_state {
1.47      matthew  1575:     my ($sname,$sdom,$symb,$courseid,$forcedownload)=@_;
                   1576:     return () if (! defined($sname) || ! defined($sdom));
                   1577:     #
1.46      matthew  1578:     $courseid = $ENV{'request.course.id'} if (! defined($courseid));
1.47      matthew  1579:     #
                   1580:     my $cachefilename = $Apache::lonnet::tmpdir.$ENV{'user.name'}.'_'.
                   1581:                                                 $ENV{'user.domain'}.'_'.
                   1582:                                                 $courseid.'_student_data.db';
                   1583:     my %cache;
                   1584:     #
                   1585:     my %student_data; # return values go here
                   1586:     #
                   1587:     my $updatetime = 0;
                   1588:     my $key = &Apache::lonnet::escape($sname).':'.
                   1589:               &Apache::lonnet::escape($sdom).':';
                   1590:     # Open the cache file
                   1591:     if (tie(%cache,'GDBM_File',$cachefilename,&GDBM_READER(),0640)) {
                   1592:         if (exists($cache{$key.'time'})) {
                   1593:             $updatetime = $cache{$key.'time'};
                   1594: #            &Apache::lonnet::logthis('got updatetime of '.$updatetime);
                   1595:         }
                   1596:         untie(%cache);
                   1597:     }
                   1598:     # timestamp/devalidation 
                   1599:     my $modifiedtime = 1;
                   1600:     # Take whatever steps are neccessary at this point to give $modifiedtime a
                   1601:     # new value
                   1602:     #
                   1603:     if (($updatetime < $modifiedtime) || 
                   1604:         (defined($forcedownload) && $forcedownload)) {
                   1605: #        &Apache::lonnet::logthis("loading data");
                   1606:         # Get all the students current data
                   1607:         my $time_of_retrieval = time;
                   1608:         my @tmp = &Apache::lonnet::currentdump($courseid,$sdom,$sname);
                   1609:         if ((scalar(@tmp) > 0) && ($tmp[0] =~ /^error:/)) {
                   1610:             &Apache::lonnet::logthis('error getting data for '.
                   1611:                                      $sname.':'.$sdom.' in course '.$courseid.
                   1612:                                      ':'.$tmp[0]);
                   1613:             return ();
                   1614:         }
                   1615:         %student_data = @tmp;
                   1616:         #
                   1617:         # Store away the data
                   1618:         #
                   1619:         # The cache structure is colon deliminated.  
                   1620:         # $uname:$udom:time  => timestamp
                   1621:         # $uname:$udom:$symb => $parm1:$val1:$parm2:$val2 ...
                   1622:         #
                   1623:         # BEWARE: The colons are NOT escaped so can search with escaped 
                   1624:         #         keys instead of unescaping every key.
                   1625:         #
                   1626:         if (tie(%cache,'GDBM_File',$cachefilename,&GDBM_WRCREAT(),0640)) {
                   1627: #            &Apache::lonnet::logthis("writing data");
                   1628:             while (my ($current_symb,$param_hash) = each(%student_data)) {
                   1629:                 my @Parameters = %{$param_hash};
                   1630:                 my $value = join(':',map { &Apache::lonnet::escape($_); } 
                   1631:                                  @Parameters);
                   1632:                 # Store away the values
1.48      matthew  1633:                 $cache{$key.&Apache::lonnet::escape($current_symb)}=$value;
1.47      matthew  1634:             }
                   1635:             $cache{$key.'time'}=$time_of_retrieval;
                   1636:             untie(%cache);
                   1637:         }
                   1638:     } else {
1.48      matthew  1639:         &Apache::lonnet::logthis('retrieving cached data ');
1.47      matthew  1640:         if (tie(%cache,'GDBM_File',$cachefilename,&GDBM_READER(),0640)) {
                   1641:             if (defined($symb)) {
                   1642:                 my  $searchkey = $key.&Apache::lonnet::escape($symb);
                   1643:                 if (exists($cache{$searchkey})) {
                   1644:                     $student_data{$symb} = &make_into_hash($cache{$searchkey});
                   1645:                 }
                   1646:             } else {
                   1647:                 my $searchkey = '^'.$key.'(.*)$';#'
                   1648:                 while (my ($testkey,$params)=each(%cache)) {
                   1649:                     if ($testkey =~ /$searchkey/) { # \Q \E?  May be necc.
1.48      matthew  1650:                         my $tmpsymb = $1;
                   1651:                         next if ($tmpsymb =~ 'time');
                   1652: #                        &Apache::lonnet::logthis('found '.$tmpsymb.':');
                   1653:                         $student_data{&Apache::lonnet::unescape($tmpsymb)} = 
1.47      matthew  1654:                             &make_into_hash($params);
                   1655:                     }
                   1656:                 }
                   1657:             }
                   1658:             untie(%cache);
                   1659:         }
1.46      matthew  1660:     }
                   1661:     if (! defined($symb)) {
1.47      matthew  1662: #        &Apache::lonnet::logthis("returning all data");
1.46      matthew  1663:         return %student_data;
                   1664:     } elsif (exists($student_data{$symb})) {
1.47      matthew  1665: #        &Apache::lonnet::logthis("returning data for symb=".$symb);
1.46      matthew  1666:         return %{$student_data{$symb}};
                   1667:     } else {
                   1668:         return ();
                   1669:     }
1.3       stredwic 1670: }
1.1       stredwic 1671: 
1.35      matthew  1672: ################################################
                   1673: ################################################
                   1674: 
                   1675: =pod
                   1676: 
                   1677: =item &get_classlist();
                   1678: 
                   1679: Retrieve the classist of a given class or of the current class.  Student
                   1680: information is returned from the classlist.db file and, if needed,
                   1681: from the students environment.
                   1682: 
                   1683: Optional arguments are $cid, $cdom, and $cnum (course id, course domain,
                   1684: and course number, respectively).  Any omitted arguments will be taken 
                   1685: from the current environment ($ENV{'request.course.id'},
                   1686: $ENV{'course.'.$cid.'.domain'}, and $ENV{'course.'.$cid.'.num'}).
                   1687: 
                   1688: Returns a reference to a hash which contains:
                   1689:  keys    '$sname:$sdom'
1.54    ! bowersj2 1690:  values  [$sdom,$sname,$end,$start,$id,$section,$fullname,$status]
        !          1691: 
        !          1692: The constant values CL_SDOM, CL_SNAME, CL_END, etc. can be used
        !          1693: as indices into the returned list to future-proof clients against
        !          1694: changes in the list order.
1.35      matthew  1695: 
                   1696: =cut
                   1697: 
                   1698: ################################################
                   1699: ################################################
1.54    ! bowersj2 1700: 
        !          1701: sub CL_SDOM     { return 0; }
        !          1702: sub CL_SNAME    { return 1; }
        !          1703: sub CL_END      { return 2; }
        !          1704: sub CL_START    { return 3; }
        !          1705: sub CL_ID       { return 4; }
        !          1706: sub CL_SECTION  { return 5; }
        !          1707: sub CL_FULLNAME { return 6; }
        !          1708: sub CL_STATUS   { return 7; }
1.35      matthew  1709: 
                   1710: sub get_classlist {
                   1711:     my ($cid,$cdom,$cnum) = @_;
                   1712:     $cid = $cid || $ENV{'request.course.id'};
                   1713:     $cdom = $cdom || $ENV{'course.'.$cid.'.domain'};
                   1714:     $cnum = $cnum || $ENV{'course.'.$cid.'.num'};
                   1715:    my $now = time;
                   1716:     #
                   1717:     my %classlist=&Apache::lonnet::dump('classlist',$cdom,$cnum);
                   1718:     while (my ($student,$info) = each(%classlist)) {
                   1719:         return undef if ($student =~ /^(con_lost|error|no_such_host)/i);
                   1720:         my ($sname,$sdom) = split(/:/,$student);
                   1721:         my @Values = split(/:/,$info);
                   1722:         my ($end,$start,$id,$section,$fullname);
                   1723:         if (@Values > 2) {
                   1724:             ($end,$start,$id,$section,$fullname) = @Values;
                   1725:         } else { # We have to get the data ourselves
                   1726:             ($end,$start) = @Values;
1.37      matthew  1727:             $section = &Apache::lonnet::getsection($sdom,$sname,$cid);
1.35      matthew  1728:             my %info=&Apache::lonnet::get('environment',
                   1729:                                           ['firstname','middlename',
                   1730:                                            'lastname','generation','id'],
                   1731:                                           $sdom, $sname);
                   1732:             my ($tmp) = keys(%info);
                   1733:             if ($tmp =~/^(con_lost|error|no_such_host)/i) {
                   1734:                 $fullname = 'not available';
                   1735:                 $id = 'not available';
1.38      matthew  1736:                 &Apache::lonnet::logthis('unable to retrieve environment '.
                   1737:                                          'for '.$sname.':'.$sdom);
1.35      matthew  1738:             } else {
                   1739:                 $fullname = &ProcessFullName(@info{qw/lastname generation 
                   1740:                                                        firstname middlename/});
                   1741:                 $id = $info{'id'};
                   1742:             }
1.36      matthew  1743:             # Update the classlist with this students information
                   1744:             if ($fullname ne 'not available') {
                   1745:                 my $enrolldata = join(':',$end,$start,$id,$section,$fullname);
                   1746:                 my $reply=&Apache::lonnet::cput('classlist',
                   1747:                                                 {$student => $enrolldata},
                   1748:                                                 $cdom,$cnum);
                   1749:                 if ($reply !~ /^(ok|delayed)/) {
                   1750:                     &Apache::lonnet::logthis('Unable to update classlist for '.
                   1751:                                              'student '.$sname.':'.$sdom.
                   1752:                                              ' error:'.$reply);
                   1753:                 }
                   1754:             }
1.35      matthew  1755:         }
                   1756:         my $status='Expired';
                   1757:         if(((!$end) || $now < $end) && ((!$start) || ($now > $start))) {
                   1758:             $status='Active';
                   1759:         }
                   1760:         $classlist{$student} = 
                   1761:             [$sdom,$sname,$end,$start,$id,$section,$fullname,$status];
                   1762:     }
                   1763:     if (wantarray()) {
                   1764:         return (\%classlist,['domain','username','end','start','id',
                   1765:                              'section','fullname','status']);
                   1766:     } else {
                   1767:         return \%classlist;
                   1768:     }
                   1769: }
                   1770: 
1.1       stredwic 1771: # ----- END HELPER FUNCTIONS --------------------------------------------
                   1772: 
                   1773: 1;
                   1774: __END__
1.36      matthew  1775: 
1.35      matthew  1776: 

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