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

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

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