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

1.1       stredwic    1: # The LearningOnline Network with CAPA
                      2: #
1.58    ! matthew     3: # $Id: loncoursedata.pm,v 1.57 2003/03/17 22:52:04 matthew Exp $
1.1       stredwic    4: #
                      5: # Copyright Michigan State University Board of Trustees
                      6: #
                      7: # This file is part of the LearningOnline Network with CAPA (LON-CAPA).
                      8: #
                      9: # LON-CAPA is free software; you can redistribute it and/or modify
                     10: # it under the terms of the GNU General Public License as published by
                     11: # the Free Software Foundation; either version 2 of the License, or
                     12: # (at your option) any later version.
                     13: #
                     14: # LON-CAPA is distributed in the hope that it will be useful,
                     15: # but WITHOUT ANY WARRANTY; without even the implied warranty of
                     16: # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
                     17: # GNU General Public License for more details.
                     18: #
                     19: # You should have received a copy of the GNU General Public License
                     20: # along with LON-CAPA; if not, write to the Free Software
                     21: # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
                     22: #
                     23: # /home/httpd/html/adm/gpl.txt
                     24: #
                     25: # http://www.lon-capa.org/
                     26: #
                     27: ###
                     28: 
                     29: =pod
                     30: 
                     31: =head1 NAME
                     32: 
                     33: loncoursedata
                     34: 
                     35: =head1 SYNOPSIS
                     36: 
1.22      stredwic   37: Set of functions that download and process student and course information.
1.1       stredwic   38: 
                     39: =head1 PACKAGES USED
                     40: 
                     41:  Apache::Constants qw(:common :http)
                     42:  Apache::lonnet()
1.22      stredwic   43:  Apache::lonhtmlcommon
1.1       stredwic   44:  HTML::TokeParser
                     45:  GDBM_File
                     46: 
                     47: =cut
                     48: 
                     49: package Apache::loncoursedata;
                     50: 
                     51: use strict;
                     52: use Apache::Constants qw(:common :http);
                     53: use Apache::lonnet();
1.13      stredwic   54: use Apache::lonhtmlcommon;
1.57      matthew    55: use Time::HiRes;
                     56: use Apache::lonmysql;
1.1       stredwic   57: use HTML::TokeParser;
                     58: use GDBM_File;
                     59: 
                     60: =pod
                     61: 
                     62: =head1 DOWNLOAD INFORMATION
                     63: 
1.22      stredwic   64: This section contains all the functions that get data from other servers 
                     65: and/or itself.
1.1       stredwic   66: 
                     67: =cut
                     68: 
                     69: # ----- DOWNLOAD INFORMATION -------------------------------------------
                     70: 
                     71: =pod
                     72: 
1.3       stredwic   73: =item &DownloadClasslist()
1.1       stredwic   74: 
                     75: Collects lastname, generation, middlename, firstname, PID, and section for each
1.22      stredwic   76: student from their environment database.  The section data is also download, though
                     77: it is in a rough format, and is processed later.  The list of students is built from
                     78: collecting a classlist for the course that is to be displayed.  Once the classlist
                     79: has been downloaded, its date stamp is recorded.  Unless the datestamp for the
                     80: class database is reset or is modified, this data will not be downloaded again.  
                     81: Also, there was talk about putting the fullname and section
                     82: and perhaps other pieces of data into the classlist file.  This would
                     83: reduce the number of different file accesses and reduce the amount of 
                     84: processing on this side.
1.1       stredwic   85: 
                     86: =over 4
                     87: 
1.21      matthew    88: Input: $courseID, $lastDownloadTime, $c
1.1       stredwic   89: 
                     90: $courseID:  The id of the course
                     91: 
1.22      stredwic   92: $lastDownloadTime:  This is the date stamp for when this information was
1.23      stredwic   93: last gathered.  If it is set to Not downloaded, it will gather the data
1.22      stredwic   94: again, though it currently does not remove the old data.
1.21      matthew    95: 
1.1       stredwic   96: $c: The connection class that can determine if the browser has aborted.  It
1.21      matthew    97: is used to short circuit this function so that it does not continue to 
1.1       stredwic   98: get information when there is no need.
                     99: 
                    100: Output: \%classlist
                    101: 
                    102: \%classlist: A pointer to a hash containing the following data:
                    103: 
                    104: -A list of student name:domain (as keys) (known below as $name)
                    105: 
                    106: -A hash pointer for each student containing lastname, generation, firstname,
1.23      stredwic  107: middlename, and PID : Key is $name.studentInformation
1.1       stredwic  108: 
                    109: -A hash pointer to each students section data : Key is $name.section
                    110: 
1.22      stredwic  111: -If there was an error in dump, it will be returned in the hash.  See
                    112: the error codes for dump in lonnet.  Also, an error key will be 
                    113: generated if an abort occurs.
                    114: 
1.1       stredwic  115: =back
                    116: 
                    117: =cut
                    118: 
1.3       stredwic  119: sub DownloadClasslist {
                    120:     my ($courseID, $lastDownloadTime, $c)=@_;
1.1       stredwic  121:     my ($courseDomain,$courseNumber)=split(/\_/,$courseID);
1.3       stredwic  122:     my %classlist;
1.1       stredwic  123: 
1.50      matthew   124:     my $modifiedTime = &Apache::lonnet::GetFileTimestamp($courseDomain, 
                    125:                                                          $courseNumber,
1.22      stredwic  126:                                                          'classlist.db', 
1.50      matthew   127:                                  $Apache::lonnet::perlvar{'lonUsersDir'});
1.22      stredwic  128: 
                    129:     # Always download the information if lastDownloadTime is set to
1.23      stredwic  130:     # Not downloaded, otherwise it is only downloaded if the file
1.22      stredwic  131:     # has been updated and has a more recent date stamp
1.7       stredwic  132:     if($lastDownloadTime ne 'Not downloaded' &&
                    133:        $lastDownloadTime >= $modifiedTime && $modifiedTime >= 0) {
1.22      stredwic  134:         # Data is not gathered so return UpToDate as true.  This
                    135:         # will be interpreted in ProcessClasslist
1.7       stredwic  136:         $classlist{'lastDownloadTime'}=time;
                    137:         $classlist{'UpToDate'} = 'true';
                    138:         return \%classlist;
                    139:     }
1.3       stredwic  140: 
                    141:     %classlist=&Apache::lonnet::dump('classlist',$courseDomain, $courseNumber);
1.20      stredwic  142:     foreach(keys (%classlist)) {
                    143:         if(/^(con_lost|error|no_such_host)/i) {
1.33      albertel  144: 	    return;
1.20      stredwic  145:         }
1.1       stredwic  146:     }
                    147: 
                    148:     foreach my $name (keys(%classlist)) {
1.22      stredwic  149:         if(defined($c) && ($c->aborted())) {
1.1       stredwic  150:             $classlist{'error'}='aborted';
                    151:             return \%classlist;
                    152:         }
                    153: 
                    154:         my ($studentName,$studentDomain) = split(/\:/,$name);
                    155:         # Download student environment data, specifically the full name and id.
                    156:         my %studentInformation=&Apache::lonnet::get('environment',
                    157:                                                     ['lastname','generation',
                    158:                                                      'firstname','middlename',
                    159:                                                      'id'],
                    160:                                                     $studentDomain,
                    161:                                                     $studentName);
                    162:         $classlist{$name.':studentInformation'}=\%studentInformation;
                    163: 
                    164:         if($c->aborted()) {
                    165:             $classlist{'error'}='aborted';
                    166:             return \%classlist;
                    167:         }
                    168: 
                    169:         #Section
                    170:         my %section=&Apache::lonnet::dump('roles',$studentDomain,$studentName);
1.3       stredwic  171:         $classlist{$name.':sections'}=\%section;
1.1       stredwic  172:     }
                    173: 
1.3       stredwic  174:     $classlist{'UpToDate'} = 'false';
                    175:     $classlist{'lastDownloadTime'}=time;
                    176: 
1.1       stredwic  177:     return \%classlist;
                    178: }
                    179: 
                    180: =pod
                    181: 
1.4       stredwic  182: =item &DownloadCourseInformation()
1.1       stredwic  183: 
1.22      stredwic  184: Dump of all the course information for a single student.  The data can be
                    185: pruned by making use of dumps regular expression arguement.  This function
                    186: also takes a regular expression which it passes straight through to dump.  
                    187: The data is no escaped, because it is done elsewhere.  It also
1.3       stredwic  188: checks the timestamp of the students course database file and only downloads
                    189: if it has been modified since the last download.
1.1       stredwic  190: 
                    191: =over 4
                    192: 
1.22      stredwic  193: Input: $namedata, $courseID, $lastDownloadTime, $WhatIWant
1.1       stredwic  194: 
1.22      stredwic  195: $namedata: student name:domain
1.1       stredwic  196: 
                    197: $courseID:  The id of the course
                    198: 
1.22      stredwic  199: $lastDownloadTime:  This is the date stamp for when this information was
1.23      stredwic  200: last gathered.  If it is set to Not downloaded, it will gather the data
1.22      stredwic  201: again, though it currently does not remove the old data.
                    202: 
                    203: $WhatIWant:  Regular expression used to get selected data with dump
                    204: 
1.1       stredwic  205: Output: \%courseData
                    206: 
1.23      stredwic  207: \%courseData:  A hash pointer to the raw data from the students course
1.1       stredwic  208: database.
                    209: 
                    210: =back
                    211: 
                    212: =cut
                    213: 
1.4       stredwic  214: sub DownloadCourseInformation {
1.12      stredwic  215:     my ($namedata,$courseID,$lastDownloadTime,$WhatIWant)=@_;
1.3       stredwic  216:     my %courseData;
1.4       stredwic  217:     my ($name,$domain) = split(/\:/,$namedata);
1.1       stredwic  218: 
1.22      stredwic  219:     my $modifiedTime = &Apache::lonnet::GetFileTimestamp($domain, $name,
1.7       stredwic  220:                                       $courseID.'.db', 
                    221:                                       $Apache::lonnet::perlvar{'lonUsersDir'});
                    222: 
1.42      matthew   223:     if($lastDownloadTime ne 'Not downloaded' && 
                    224:        $lastDownloadTime >= $modifiedTime && $modifiedTime >= 0) {
1.22      stredwic  225:         # Data is not gathered so return UpToDate as true.  This
                    226:         # will be interpreted in ProcessClasslist
1.13      stredwic  227:         $courseData{$namedata.':lastDownloadTime'}=time;
                    228:         $courseData{$namedata.':UpToDate'} = 'true';
1.7       stredwic  229:         return \%courseData;
                    230:     }
1.3       stredwic  231: 
1.4       stredwic  232:     # Download course data
1.12      stredwic  233:     if(!defined($WhatIWant)) {
1.22      stredwic  234:         # set the regular expression to everything by setting it to period
1.12      stredwic  235:         $WhatIWant = '.';
                    236:     }
                    237:     %courseData=&Apache::lonnet::dump($courseID, $domain, $name, $WhatIWant);
1.3       stredwic  238:     $courseData{'UpToDate'} = 'false';
                    239:     $courseData{'lastDownloadTime'}=time;
1.13      stredwic  240: 
                    241:     my %newData;
                    242:     foreach (keys(%courseData)) {
1.22      stredwic  243:         # need to have the keys to be prepended with the name:domain of the
                    244:         # student to reduce data collision later.
1.13      stredwic  245:         $newData{$namedata.':'.$_} = $courseData{$_};
                    246:     }
                    247: 
                    248:     return \%newData;
1.1       stredwic  249: }
                    250: 
                    251: # ----- END DOWNLOAD INFORMATION ---------------------------------------
                    252: 
                    253: =pod
                    254: 
                    255: =head1 PROCESSING FUNCTIONS
                    256: 
                    257: These functions process all the data for all the students.  Also, they
1.22      stredwic  258: are the functions that access the cache database for writing the majority of
                    259: the time.  The downloading and caching were separated to reduce problems 
1.23      stredwic  260: with stopping downloading then can not tie hash to database later.
1.1       stredwic  261: 
                    262: =cut
                    263: 
                    264: # ----- PROCESSING FUNCTIONS ---------------------------------------
                    265: 
1.50      matthew   266: ####################################################
                    267: ####################################################
1.45      matthew   268: 
                    269: =pod
                    270: 
                    271: =item &get_sequence_assessment_data()
                    272: 
                    273: AT THIS TIME THE USE OF THIS FUNCTION IS *NOT* RECOMMENDED
                    274: 
                    275: Use lonnavmaps to build a data structure describing the order and 
                    276: assessment contents of each sequence in the current course.
                    277: 
                    278: The returned structure is a hash reference. 
                    279: 
                    280: { title  => 'title',
                    281:   symb   => 'symb',
                    282:   source => '/s/o/u/r/c/e',
                    283:   type  => (container|assessment),
1.50      matthew   284:   num_assess   => 2,               # only for container
1.45      matthew   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.
1.52      matthew   316:     my $title = $ENV{'course.'.$ENV{'request.course.id'}.'.description'};
                    317:     my $symb  = 'top';
                    318:     my $src   = 'not applicable';
1.45      matthew   319:     #
1.49      matthew   320:     my @Sequences; 
                    321:     my @Assessments;
1.45      matthew   322:     my @Nested_Sequences = ();   # Stack of sequences, keeps track of depth
                    323:     my $top = { title    => $title,
1.52      matthew   324:                 src      => $src,
1.45      matthew   325:                 symb     => $symb,
                    326:                 type     => 'container',
                    327:                 num_assess => 0,
1.53      matthew   328:                 num_assess_parts => 0,
1.45      matthew   329:                 contents   => [], };
1.49      matthew   330:     push (@Sequences,$top);
1.45      matthew   331:     push (@Nested_Sequences, $top);
                    332:     #
                    333:     # We need to keep track of which sequences contain homework problems
                    334:     # 
1.52      matthew   335:     my $previous;
                    336:     my $curRes = $iterator->next(); # BEGIN_MAP
                    337:     $curRes = $iterator->next(); # The first item in the top level map.
1.45      matthew   338:     while (scalar(@Nested_Sequences)) {
1.50      matthew   339:         $previous = $curRes;
1.45      matthew   340:         $curRes = $iterator->next();
                    341:         my $currentmap = $Nested_Sequences[-1]; # Last one on the stack
                    342:         if ($curRes == $iterator->BEGIN_MAP()) {
                    343:             # get the map itself, instead of BEGIN_MAP
1.51      matthew   344:             $title = $previous->title();
                    345:             $symb  = $previous->symb();
                    346:             $src   = $previous->src();
1.45      matthew   347:             my $newmap = { title    => $title,
                    348:                            src      => $src,
                    349:                            symb     => $symb,
                    350:                            type     => 'container',
                    351:                            num_assess => 0,
                    352:                            contents   => [],
                    353:                        };
                    354:             push (@{$currentmap->{'contents'}},$newmap); # this is permanent
1.49      matthew   355:             push (@Sequences,$newmap);
1.45      matthew   356:             push (@Nested_Sequences, $newmap); # this is a stack
                    357:             next;
                    358:         }
                    359:         if ($curRes == $iterator->END_MAP()) {
                    360:             pop(@Nested_Sequences);
                    361:             next;
                    362:         }
                    363:         next if (! ref($curRes));
1.50      matthew   364:         next if (! $curRes->is_problem());# && !$curRes->randomout);
1.45      matthew   365:         # Okay, from here on out we only deal with assessments
                    366:         $title = $curRes->title();
                    367:         $symb  = $curRes->symb();
                    368:         $src   = $curRes->src();
                    369:         my $parts = $curRes->parts();
                    370:         my $assessment = { title => $title,
                    371:                            src   => $src,
                    372:                            symb  => $symb,
                    373:                            type  => 'assessment',
1.53      matthew   374:                            parts => $parts,
                    375:                            num_parts => scalar(@$parts),
1.45      matthew   376:                        };
1.49      matthew   377:         push(@Assessments,$assessment);
1.45      matthew   378:         push(@{$currentmap->{'contents'}},$assessment);
                    379:         $currentmap->{'num_assess'}++;
1.53      matthew   380:         $currentmap->{'num_assess_parts'}+= scalar(@$parts);
1.45      matthew   381:     }
1.58    ! matthew   382:     $navmap->untieHashes();
1.49      matthew   383:     return ($top,\@Sequences,\@Assessments);
1.45      matthew   384: }
1.50      matthew   385: 
                    386: #################################################
                    387: #################################################
1.45      matthew   388: 
1.1       stredwic  389: =pod
                    390: 
                    391: =item &ProcessTopResourceMap()
                    392: 
                    393: Trace through the "big hash" created in rat/lonuserstate.pm::loadmap.  
                    394: Basically, this function organizes a subset of the data and stores it in
                    395: cached data.  The data stored is the problems, sequences, sequence titles,
                    396: parts of problems, and their ordering.  Column width information is also 
                    397: partially handled here on a per sequence basis.
                    398: 
                    399: =over 4
                    400: 
                    401: Input: $cache, $c
                    402: 
                    403: $cache:  A pointer to a hash to store the information
                    404: 
                    405: $c:  The connection class used to determine if an abort has been sent to the 
                    406: browser
                    407: 
                    408: Output: A string that contains an error message or "OK" if everything went 
                    409: smoothly.
                    410: 
                    411: =back
                    412: 
                    413: =cut
                    414: 
                    415: sub ProcessTopResourceMap {
1.11      stredwic  416:     my ($cache,$c)=@_;
1.1       stredwic  417:     my %hash;
                    418:     my $fn=$ENV{'request.course.fn'};
                    419:     if(-e "$fn.db") {
                    420: 	my $tieTries=0;
                    421: 	while($tieTries < 3) {
                    422:             if($c->aborted()) {
                    423:                 return;
                    424:             }
1.10      stredwic  425: 	    if(tie(%hash,'GDBM_File',"$fn.db",&GDBM_READER(),0640)) {
1.1       stredwic  426: 		last;
                    427: 	    }
                    428: 	    $tieTries++;
                    429: 	    sleep 1;
                    430: 	}
                    431: 	if($tieTries >= 3) {
                    432:             return 'Coursemap undefined.';
                    433:         }
                    434:     } else {
                    435:         return 'Can not open Coursemap.';
                    436:     }
                    437: 
1.28      stredwic  438:     my $oldkeys;
1.40      minaeibi  439:     delete $cache->{'OptionResponses'};
1.28      stredwic  440:     if(defined($cache->{'ResourceKeys'})) {
                    441:         $oldkeys = $cache->{'ResourceKeys'};
                    442:         foreach (split(':::', $cache->{'ResourceKeys'})) {
                    443:             delete $cache->{$_};
                    444:         }
                    445:         delete $cache->{'ResourceKeys'};
                    446:     }
                    447: 
1.1       stredwic  448:     # Initialize state machine.  Set information pointing to top level map.
                    449:     my (@sequences, @currentResource, @finishResource);
                    450:     my ($currentSequence, $currentResourceID, $lastResourceID);
                    451: 
1.31      www       452:     $currentResourceID=$hash{'ids_'.
                    453:       &Apache::lonnet::clutter($ENV{'request.course.uri'})};
1.1       stredwic  454:     push(@currentResource, $currentResourceID);
                    455:     $lastResourceID=-1;
                    456:     $currentSequence=-1;
                    457:     my $topLevelSequenceNumber = $currentSequence;
                    458: 
1.11      stredwic  459:     my %sequenceRecord;
1.28      stredwic  460:     my %allkeys;
1.1       stredwic  461:     while(1) {
                    462:         if($c->aborted()) {
                    463:             last;
                    464:         }
                    465: 	# HANDLE NEW SEQUENCE!
                    466: 	#if page || sequence
1.11      stredwic  467: 	if(defined($hash{'map_pc_'.$hash{'src_'.$currentResourceID}}) &&
                    468:            !defined($sequenceRecord{$currentResourceID})) {
                    469:             $sequenceRecord{$currentResourceID}++;
1.1       stredwic  470: 	    push(@sequences, $currentSequence);
                    471: 	    push(@currentResource, $currentResourceID);
                    472: 	    push(@finishResource, $lastResourceID);
                    473: 
                    474: 	    $currentSequence=$hash{'map_pc_'.$hash{'src_'.$currentResourceID}};
                    475: 
                    476:             # Mark sequence as containing problems.  If it doesn't, then
                    477:             # it will be removed when processing for this sequence is
                    478:             # complete.  This allows the problems in a sequence
                    479:             # to be outputed before problems in the subsequences
                    480:             if(!defined($cache->{'orderedSequences'})) {
                    481:                 $cache->{'orderedSequences'}=$currentSequence;
                    482:             } else {
                    483:                 $cache->{'orderedSequences'}.=':'.$currentSequence;
                    484:             }
1.28      stredwic  485:             $allkeys{'orderedSequences'}++;
1.1       stredwic  486: 
                    487: 	    $lastResourceID=$hash{'map_finish_'.
                    488: 				  $hash{'src_'.$currentResourceID}};
                    489: 	    $currentResourceID=$hash{'map_start_'.
                    490: 				     $hash{'src_'.$currentResourceID}};
                    491: 
                    492: 	    if(!($currentResourceID) || !($lastResourceID)) {
                    493: 		$currentSequence=pop(@sequences);
                    494: 		$currentResourceID=pop(@currentResource);
                    495: 		$lastResourceID=pop(@finishResource);
                    496: 		if($currentSequence eq $topLevelSequenceNumber) {
                    497: 		    last;
                    498: 		}
                    499: 	    }
1.12      stredwic  500:             next;
1.1       stredwic  501: 	}
                    502: 
                    503: 	# Handle gradable resources: exams, problems, etc
                    504: 	$currentResourceID=~/(\d+)\.(\d+)/;
                    505:         my $partA=$1;
                    506:         my $partB=$2;
                    507: 	if($hash{'src_'.$currentResourceID}=~
                    508: 	   /\.(problem|exam|quiz|assess|survey|form)$/ &&
1.11      stredwic  509: 	   $partA eq $currentSequence && 
                    510:            !defined($sequenceRecord{$currentSequence.':'.
                    511:                                     $currentResourceID})) {
                    512:             $sequenceRecord{$currentSequence.':'.$currentResourceID}++;
1.1       stredwic  513: 	    my $Problem = &Apache::lonnet::symbclean(
                    514: 			  &Apache::lonnet::declutter($hash{'map_id_'.$partA}).
                    515: 			  '___'.$partB.'___'.
                    516: 			  &Apache::lonnet::declutter($hash{'src_'.
                    517: 							 $currentResourceID}));
                    518: 
                    519: 	    $cache->{$currentResourceID.':problem'}=$Problem;
1.28      stredwic  520:             $allkeys{$currentResourceID.':problem'}++;
1.1       stredwic  521: 	    if(!defined($cache->{$currentSequence.':problems'})) {
                    522: 		$cache->{$currentSequence.':problems'}=$currentResourceID;
                    523: 	    } else {
                    524: 		$cache->{$currentSequence.':problems'}.=
                    525: 		    ':'.$currentResourceID;
                    526: 	    }
1.28      stredwic  527:             $allkeys{$currentSequence.':problems'}++;
1.1       stredwic  528: 
1.2       stredwic  529: 	    my $meta=$hash{'src_'.$currentResourceID};
                    530: #            $cache->{$currentResourceID.':title'}=
                    531: #                &Apache::lonnet::metdata($meta,'title');
                    532:             $cache->{$currentResourceID.':title'}=
                    533:                 $hash{'title_'.$currentResourceID};
1.28      stredwic  534:             $allkeys{$currentResourceID.':title'}++;
1.9       minaeibi  535:             $cache->{$currentResourceID.':source'}=
                    536:                 $hash{'src_'.$currentResourceID};
1.28      stredwic  537:             $allkeys{$currentResourceID.':source'}++;
1.2       stredwic  538: 
1.1       stredwic  539:             # Get Parts for problem
1.8       stredwic  540:             my %beenHere;
                    541:             foreach (split(/\,/,&Apache::lonnet::metadata($meta,'packages'))) {
                    542:                 if(/^\w+response_\d+.*/) {
                    543:                     my (undef, $partId, $responseId) = split(/_/,$_);
                    544:                     if($beenHere{'p:'.$partId} ==  0) {
                    545:                         $beenHere{'p:'.$partId}++;
                    546:                         if(!defined($cache->{$currentSequence.':'.
                    547:                                             $currentResourceID.':parts'})) {
                    548:                             $cache->{$currentSequence.':'.$currentResourceID.
                    549:                                      ':parts'}=$partId;
                    550:                         } else {
                    551:                             $cache->{$currentSequence.':'.$currentResourceID.
                    552:                                      ':parts'}.=':'.$partId;
                    553:                         }
1.28      stredwic  554:                         $allkeys{$currentSequence.':'.$currentResourceID.
                    555:                                   ':parts'}++;
1.8       stredwic  556:                     }
                    557:                     if($beenHere{'r:'.$partId.':'.$responseId} == 0) {
                    558:                         $beenHere{'r:'.$partId.':'.$responseId}++;
                    559:                         if(!defined($cache->{$currentSequence.':'.
                    560:                                              $currentResourceID.':'.$partId.
                    561:                                              ':responseIDs'})) {
                    562:                             $cache->{$currentSequence.':'.$currentResourceID.
                    563:                                      ':'.$partId.':responseIDs'}=$responseId;
                    564:                         } else {
                    565:                             $cache->{$currentSequence.':'.$currentResourceID.
                    566:                                      ':'.$partId.':responseIDs'}.=':'.
                    567:                                                                   $responseId;
                    568:                         }
1.28      stredwic  569:                         $allkeys{$currentSequence.':'.$currentResourceID.':'.
                    570:                                      $partId.':responseIDs'}++;
1.1       stredwic  571:                     }
1.8       stredwic  572:                     if(/^optionresponse/ && 
                    573:                        $beenHere{'o:'.$partId.':'.$currentResourceID} == 0) {
                    574:                         $beenHere{'o:'.$partId.$currentResourceID}++;
                    575:                         if(defined($cache->{'OptionResponses'})) {
                    576:                             $cache->{'OptionResponses'}.= ':::'.
1.16      stredwic  577:                                 $currentSequence.':'.$currentResourceID.':'.
                    578:                                 $partId.':'.$responseId;
                    579:                         } else {
                    580:                             $cache->{'OptionResponses'}= $currentSequence.':'.
1.8       stredwic  581:                                 $currentResourceID.':'.
                    582:                                 $partId.':'.$responseId;
1.2       stredwic  583:                         }
1.28      stredwic  584:                         $allkeys{'OptionResponses'}++;
1.2       stredwic  585:                     }
                    586:                 }
1.8       stredwic  587:             }
                    588:         }
1.1       stredwic  589: 
                    590: 	# if resource == finish resource, then it is the end of a sequence/page
                    591: 	if($currentResourceID eq $lastResourceID) {
                    592: 	    # pop off last resource of sequence
                    593: 	    $currentResourceID=pop(@currentResource);
                    594: 	    $lastResourceID=pop(@finishResource);
                    595: 
                    596: 	    if(defined($cache->{$currentSequence.':problems'})) {
                    597: 		# Capture sequence information here
                    598: 		$cache->{$currentSequence.':title'}=
                    599: 		    $hash{'title_'.$currentResourceID};
1.28      stredwic  600:                 $allkeys{$currentSequence.':title'}++;
1.2       stredwic  601:                 $cache->{$currentSequence.':source'}=
                    602:                     $hash{'src_'.$currentResourceID};
1.28      stredwic  603:                 $allkeys{$currentSequence.':source'}++;
1.1       stredwic  604: 
                    605:                 my $totalProblems=0;
                    606:                 foreach my $currentProblem (split(/\:/,
                    607:                                                $cache->{$currentSequence.
                    608:                                                ':problems'})) {
                    609:                     foreach (split(/\:/,$cache->{$currentSequence.':'.
                    610:                                                    $currentProblem.
                    611:                                                    ':parts'})) {
                    612:                         $totalProblems++;
                    613:                     }
                    614:                 }
                    615: 		my @titleLength=split(//,$cache->{$currentSequence.
                    616:                                                     ':title'});
1.39      minaeibi  617:                 # $extra is 5 for problems correct and 3 for space
1.1       stredwic  618:                 # between problems correct and problem output
1.39      minaeibi  619:                 my $extra = 8;
1.1       stredwic  620: 		if(($totalProblems + $extra) > (scalar @titleLength)) {
                    621: 		    $cache->{$currentSequence.':columnWidth'}=
                    622:                         $totalProblems + $extra;
                    623: 		} else {
                    624: 		    $cache->{$currentSequence.':columnWidth'}=
                    625:                         (scalar @titleLength);
                    626: 		}
1.28      stredwic  627:                 $allkeys{$currentSequence.':columnWidth'}++;
1.1       stredwic  628: 	    } else {
                    629:                 # Remove sequence from list, if it contains no problems to
                    630:                 # display.
                    631:                 $cache->{'orderedSequences'}=~s/$currentSequence//;
                    632:                 $cache->{'orderedSequences'}=~s/::/:/g;
                    633:                 $cache->{'orderedSequences'}=~s/^:|:$//g;
                    634:             }
                    635: 
                    636: 	    $currentSequence=pop(@sequences);
                    637: 	    if($currentSequence eq $topLevelSequenceNumber) {
                    638: 		last;
                    639: 	    }
1.11      stredwic  640:         }
1.1       stredwic  641: 
                    642: 	# MOVE!!!
                    643: 	# move to next resource
                    644: 	unless(defined($hash{'to_'.$currentResourceID})) {
                    645: 	    # big problem, need to handle.  Next is probably wrong
1.11      stredwic  646:             my $errorMessage = 'Big problem in ';
                    647:             $errorMessage .= 'loncoursedata::ProcessTopLevelMap.';
1.41      matthew   648:             $errorMessage .= "  bighash to_$currentResourceID not defined!";
1.11      stredwic  649:             &Apache::lonnet::logthis($errorMessage);
1.44      albertel  650: 	    if (!defined($currentResourceID)) {last;}
1.1       stredwic  651: 	}
                    652: 	my @nextResources=();
                    653: 	foreach (split(/\,/,$hash{'to_'.$currentResourceID})) {
1.11      stredwic  654:             if(!defined($sequenceRecord{$currentSequence.':'.
                    655:                                         $hash{'goesto_'.$_}})) {
                    656:                 push(@nextResources, $hash{'goesto_'.$_});
                    657:             }
1.1       stredwic  658: 	}
                    659: 	push(@currentResource, @nextResources);
                    660: 	# Set the next resource to be processed
                    661: 	$currentResourceID=pop(@currentResource);
                    662:     }
                    663: 
1.28      stredwic  664:     my @theKeys = keys(%allkeys);
                    665:     my $newkeys = join(':::', @theKeys);
                    666:     $cache->{'ResourceKeys'} = join(':::', $newkeys);
                    667:     if($newkeys ne $oldkeys) {
                    668:         $cache->{'ResourceUpdated'} = 'true';
                    669:     } else {
                    670:         $cache->{'ResourceUpdated'} = 'false';
                    671:     }
                    672: 
1.1       stredwic  673:     unless (untie(%hash)) {
                    674:         &Apache::lonnet::logthis("<font color=blue>WARNING: ".
                    675:                                  "Could not untie coursemap $fn (browse)".
                    676:                                  ".</font>"); 
                    677:     }
                    678: 
                    679:     return 'OK';
                    680: }
                    681: 
                    682: =pod
                    683: 
1.3       stredwic  684: =item &ProcessClasslist()
1.1       stredwic  685: 
1.3       stredwic  686: Taking the class list dumped from &DownloadClasslist(), all the 
1.1       stredwic  687: students and their non-class information is processed using the 
                    688: &ProcessStudentInformation() function.  A date stamp is also recorded for
                    689: when the data was processed.
                    690: 
1.3       stredwic  691: Takes data downloaded for a student and breaks it up into managable pieces and 
                    692: stored in cache data.  The username, domain, class related date, PID, 
                    693: full name, and section are all processed here.
                    694: 
1.1       stredwic  695: =over 4
                    696: 
                    697: Input: $cache, $classlist, $courseID, $ChartDB, $c
                    698: 
                    699: $cache: A hash pointer to store the data
                    700: 
                    701: $classlist:  The hash of data collected about a student from 
1.3       stredwic  702: &DownloadClasslist().  The hash contains a list of students, a pointer 
1.23      stredwic  703: to a hash of student information for each student, and each students section 
1.1       stredwic  704: number.
                    705: 
                    706: $courseID:  The course ID
                    707: 
                    708: $ChartDB:  The name of the cache database file.
                    709: 
                    710: $c:  The connection class used to determine if an abort has been sent to the 
                    711: browser
                    712: 
                    713: Output: @names
                    714: 
                    715: @names:  An array of students whose information has been processed, and are to 
1.32      matthew   716: be considered in an arbitrary order.  The entries in @names are of the form
                    717: username:domain.
                    718: 
                    719: The values in $cache are as follows:
                    720: 
                    721:  *NOTE: for the following $name implies username:domain
                    722:  $name.':error'                  only defined if an error occured.  Value
                    723:                                  contains the error message
                    724:  $name.':lastDownloadTime'       unconverted time of the last update of a
                    725:                                  student\'s course data
                    726:  $name.'updateTime'              coverted time of the last update of a 
                    727:                                  student\'s course data
                    728:  $name.':username'               username of a student
                    729:  $name.':domain'                 domain of a student
                    730:  $name.':fullname'               full name of a student
                    731:  $name.':id'                     PID of a student
                    732:  $name.':Status'                 active/expired status of a student
                    733:  $name.':section'                section of a student
1.1       stredwic  734: 
                    735: =back
                    736: 
                    737: =cut
                    738: 
1.3       stredwic  739: sub ProcessClasslist {
                    740:     my ($cache,$classlist,$courseID,$c)=@_;
1.1       stredwic  741:     my @names=();
                    742: 
1.3       stredwic  743:     $cache->{'ClasslistTimeStamp'}=$classlist->{'lastDownloadTime'};
                    744:     if($classlist->{'UpToDate'} eq 'true') {
                    745:         return split(/:::/,$cache->{'NamesOfStudents'});;
                    746:     }
                    747: 
1.1       stredwic  748:     foreach my $name (keys(%$classlist)) {
                    749:         if($name =~ /\:section/ || $name =~ /\:studentInformation/ ||
1.3       stredwic  750:            $name eq '' || $name eq 'UpToDate' || $name eq 'lastDownloadTime') {
1.1       stredwic  751:             next;
                    752:         }
                    753:         if($c->aborted()) {
1.3       stredwic  754:             return ();
1.1       stredwic  755:         }
1.32      matthew   756:         my $studentInformation = $classlist->{$name.':studentInformation'};
                    757:         my $date = $classlist->{$name};
1.3       stredwic  758:         my ($studentName,$studentDomain) = split(/\:/,$name);
                    759: 
                    760:         $cache->{$name.':username'}=$studentName;
                    761:         $cache->{$name.':domain'}=$studentDomain;
1.10      stredwic  762:         # Initialize timestamp for student
1.3       stredwic  763:         if(!defined($cache->{$name.':lastDownloadTime'})) {
                    764:             $cache->{$name.':lastDownloadTime'}='Not downloaded';
1.6       stredwic  765:             $cache->{$name.':updateTime'}=' Not updated';
1.3       stredwic  766:         }
                    767: 
1.20      stredwic  768:         my $error = 0;
                    769:         foreach(keys(%$studentInformation)) {
                    770:             if(/^(con_lost|error|no_such_host)/i) {
                    771:                 $cache->{$name.':error'}=
                    772:                     'Could not download student environment data.';
                    773:                 $cache->{$name.':fullname'}='';
                    774:                 $cache->{$name.':id'}='';
                    775:                 $error = 1;
                    776:             }
                    777:         }
                    778:         next if($error);
                    779:         push(@names,$name);
                    780:         $cache->{$name.':fullname'}=&ProcessFullName(
1.3       stredwic  781:                                           $studentInformation->{'lastname'},
                    782:                                           $studentInformation->{'generation'},
                    783:                                           $studentInformation->{'firstname'},
                    784:                                           $studentInformation->{'middlename'});
1.20      stredwic  785:         $cache->{$name.':id'}=$studentInformation->{'id'};
1.3       stredwic  786: 
                    787:         my ($end, $start)=split(':',$date);
                    788:         $courseID=~s/\_/\//g;
                    789:         $courseID=~s/^(\w)/\/$1/;
                    790: 
                    791:         my $sec='';
1.32      matthew   792:         my $sectionData = $classlist->{$name.':sections'};
1.3       stredwic  793:         foreach my $key (keys (%$sectionData)) {
                    794:             my $value = $sectionData->{$key};
                    795:             if ($key=~/^$courseID(?:\/)*(\w+)*\_st$/) {
                    796:                 my $tempsection=$1;
                    797:                 if($key eq $courseID.'_st') {
                    798:                     $tempsection='';
                    799:                 }
1.32      matthew   800:                 my (undef,$roleend,$rolestart)=split(/\_/,$value);
1.3       stredwic  801:                 if($roleend eq $end && $rolestart eq $start) {
                    802:                     $sec = $tempsection;
                    803:                     last;
                    804:                 }
                    805:             }
                    806:         }
                    807: 
                    808:         my $status='Expired';
                    809:         if(((!$end) || time < $end) && ((!$start) || (time > $start))) {
                    810:             $status='Active';
                    811:         }
                    812:         $cache->{$name.':Status'}=$status;
                    813:         $cache->{$name.':section'}=$sec;
1.7       stredwic  814: 
                    815:         if($sec eq '' || !defined($sec) || $sec eq ' ') {
                    816:             $sec = 'none';
                    817:         }
                    818:         if(defined($cache->{'sectionList'})) {
                    819:             if($cache->{'sectionList'} !~ /(^$sec:|^$sec$|:$sec$|:$sec:)/) {
                    820:                 $cache->{'sectionList'} .= ':'.$sec;
                    821:             }
                    822:         } else {
                    823:             $cache->{'sectionList'} = $sec;
                    824:         }
1.1       stredwic  825:     }
                    826: 
1.3       stredwic  827:     $cache->{'ClasslistTimestamp'}=time;
                    828:     $cache->{'NamesOfStudents'}=join(':::',@names);
1.1       stredwic  829: 
                    830:     return @names;
                    831: }
                    832: 
                    833: =pod
                    834: 
                    835: =item &ProcessStudentData()
                    836: 
                    837: Takes the course data downloaded for a student in 
1.4       stredwic  838: &DownloadCourseInformation() and breaks it up into key value pairs
1.1       stredwic  839: to be stored in the cached data.  The keys are comprised of the 
                    840: $username:$domain:$keyFromCourseDatabase.  The student username:domain is
1.23      stredwic  841: stored away signifying that the students information has been downloaded and 
1.1       stredwic  842: can be reused from cached data.
                    843: 
                    844: =over 4
                    845: 
                    846: Input: $cache, $courseData, $name
                    847: 
                    848: $cache: A hash pointer to store data
                    849: 
                    850: $courseData:  A hash pointer that points to the course data downloaded for a 
                    851: student.
                    852: 
                    853: $name:  username:domain
                    854: 
                    855: Output: None
                    856: 
                    857: *NOTE:  There is no output, but an error message is stored away in the cache 
                    858: data.  This is checked in &FormatStudentData().  The key username:domain:error 
                    859: will only exist if an error occured.  The error is an error from 
1.4       stredwic  860: &DownloadCourseInformation().
1.1       stredwic  861: 
                    862: =back
                    863: 
                    864: =cut
                    865: 
                    866: sub ProcessStudentData {
                    867:     my ($cache,$courseData,$name)=@_;
                    868: 
1.13      stredwic  869:     if(!&CheckDateStampError($courseData, $cache, $name)) {
                    870:         return;
                    871:     }
                    872: 
1.28      stredwic  873:     # This little delete thing, should not be here.  Move some other
                    874:     # time though.
1.26      stredwic  875:     if(defined($cache->{$name.':keys'})) {
                    876: 	foreach (split(':::', $cache->{$name.':keys'})) {
                    877: 	    delete $cache->{$name.':'.$_};
                    878: 	}
1.28      stredwic  879:         delete $cache->{$name.':keys'};
1.26      stredwic  880:     }
                    881: 
                    882:     my %courseKeys;
1.22      stredwic  883:     # user name:domain was prepended earlier in DownloadCourseInformation
1.13      stredwic  884:     foreach (keys %$courseData) {
1.29      albertel  885: 	my $currentKey = $_;
                    886: 	$currentKey =~ s/^$name//;
1.26      stredwic  887: 	$courseKeys{$currentKey}++;
1.13      stredwic  888:         $cache->{$_}=$courseData->{$_};
                    889:     }
                    890: 
1.26      stredwic  891:     $cache->{$name.':keys'} = join(':::', keys(%courseKeys));
                    892: 
1.13      stredwic  893:     return;
                    894: }
                    895: 
1.22      stredwic  896: =pod
                    897: 
                    898: =item &ExtractStudentData()
                    899: 
                    900: HISTORY: This function originally existed in every statistics module,
                    901: and performed different tasks, the had some overlap.  Due to the need
                    902: for the data from the different modules, they were combined into
                    903: a single function.
                    904: 
                    905: This function now extracts all the necessary course data for a student
                    906: from what was downloaded from their homeserver.  There is some extra
                    907: time overhead compared to the ProcessStudentInformation function, but
                    908: it would have had to occurred at some point anyways.  This is now
                    909: typically called while downloading the data it will process.  It is
                    910: the brother function to ProcessStudentInformation.
                    911: 
                    912: =over 4
                    913: 
                    914: Input: $input, $output, $data, $name
                    915: 
                    916: $input: A hash that contains the input data to be processed
                    917: 
                    918: $output: A hash to contain the processed data
                    919: 
                    920: $data: A hash containing the information on what is to be
                    921: processed and how (basically).
                    922: 
                    923: $name:  username:domain
                    924: 
                    925: The input is slightly different here, but is quite simple.
                    926: It is currently used where the $input, $output, and $data
                    927: can and are often the same hashes, but they do not need
                    928: to be.
                    929: 
                    930: Output: None
                    931: 
                    932: *NOTE:  There is no output, but an error message is stored away in the cache 
                    933: data.  This is checked in &FormatStudentData().  The key username:domain:error 
                    934: will only exist if an error occured.  The error is an error from 
                    935: &DownloadCourseInformation().
                    936: 
                    937: =back
                    938: 
                    939: =cut
                    940: 
1.13      stredwic  941: sub ExtractStudentData {
                    942:     my ($input, $output, $data, $name)=@_;
                    943: 
                    944:     if(!&CheckDateStampError($input, $data, $name)) {
1.3       stredwic  945:         return;
                    946:     }
                    947: 
1.28      stredwic  948:     # This little delete thing, should not be here.  Move some other
                    949:     # time though.
1.26      stredwic  950:     my %allkeys;
                    951:     if(defined($output->{$name.':keys'})) {
                    952: 	foreach (split(':::', $output->{$name.':keys'})) {
                    953: 	    delete $output->{$name.':'.$_};
                    954: 	}
1.28      stredwic  955:         delete $output->{$name.':keys'};
1.26      stredwic  956:     }
                    957: 
1.13      stredwic  958:     my ($username,$domain)=split(':',$name);
                    959: 
                    960:     my $Version;
                    961:     my $problemsCorrect = 0;
                    962:     my $totalProblems   = 0;
                    963:     my $problemsSolved  = 0;
                    964:     my $numberOfParts   = 0;
1.14      stredwic  965:     my $totalAwarded    = 0;
1.13      stredwic  966:     foreach my $sequence (split(':', $data->{'orderedSequences'})) {
                    967:         foreach my $problemID (split(':', $data->{$sequence.':problems'})) {
                    968:             my $problem = $data->{$problemID.':problem'};
                    969:             my $LatestVersion = $input->{$name.':version:'.$problem};
                    970: 
                    971:             # Output dashes for all the parts of this problem if there
                    972:             # is no version information about the current problem.
1.27      stredwic  973:             $output->{$name.':'.$problemID.':NoVersion'} = 'false';
                    974:             $allkeys{$name.':'.$problemID.':NoVersion'}++;
1.13      stredwic  975:             if(!$LatestVersion) {
                    976:                 foreach my $part (split(/\:/,$data->{$sequence.':'.
                    977:                                                       $problemID.
                    978:                                                       ':parts'})) {
1.15      stredwic  979:                     $output->{$name.':'.$problemID.':'.$part.':tries'} = 0;
                    980:                     $output->{$name.':'.$problemID.':'.$part.':awarded'} = 0;
                    981:                     $output->{$name.':'.$problemID.':'.$part.':code'} = ' ';
1.26      stredwic  982: 		    $allkeys{$name.':'.$problemID.':'.$part.':tries'}++;
                    983: 		    $allkeys{$name.':'.$problemID.':'.$part.':awarded'}++;
                    984: 		    $allkeys{$name.':'.$problemID.':'.$part.':code'}++;
1.13      stredwic  985:                     $totalProblems++;
                    986:                 }
                    987:                 $output->{$name.':'.$problemID.':NoVersion'} = 'true';
                    988:                 next;
                    989:             }
                    990: 
                    991:             my %partData=undef;
                    992:             # Initialize part data, display skips correctly
                    993:             # Skip refers to when a student made no submissions on that
                    994:             # part/problem.
                    995:             foreach my $part (split(/\:/,$data->{$sequence.':'.
                    996:                                                  $problemID.
                    997:                                                  ':parts'})) {
                    998:                 $partData{$part.':tries'}=0;
                    999:                 $partData{$part.':code'}=' ';
                   1000:                 $partData{$part.':awarded'}=0;
                   1001:                 $partData{$part.':timestamp'}=0;
                   1002:                 foreach my $response (split(':', $data->{$sequence.':'.
                   1003:                                                          $problemID.':'.
                   1004:                                                          $part.':responseIDs'})) {
                   1005:                     $partData{$part.':'.$response.':submission'}='';
                   1006:                 }
                   1007:             }
                   1008: 
                   1009:             # Looping through all the versions of each part, starting with the
                   1010:             # oldest version.  Basically, it gets the most recent 
                   1011:             # set of grade data for each part.
                   1012:             my @submissions = ();
                   1013: 	    for(my $Version=1; $Version<=$LatestVersion; $Version++) {
                   1014:                 foreach my $part (split(/\:/,$data->{$sequence.':'.
                   1015:                                                      $problemID.
                   1016:                                                      ':parts'})) {
                   1017: 
                   1018:                     if(!defined($input->{"$name:$Version:$problem".
                   1019:                                          ":resource.$part.solved"})) {
                   1020:                         # No grade for this submission, so skip
                   1021:                         next;
                   1022:                     }
                   1023: 
                   1024:                     my $tries=0;
                   1025:                     my $code=' ';
                   1026:                     my $awarded=0;
                   1027: 
                   1028:                     $tries = $input->{$name.':'.$Version.':'.$problem.
                   1029:                                       ':resource.'.$part.'.tries'};
                   1030:                     $awarded = $input->{$name.':'.$Version.':'.$problem.
                   1031:                                         ':resource.'.$part.'.awarded'};
                   1032: 
                   1033:                     $partData{$part.':awarded'}=($awarded) ? $awarded : 0;
                   1034:                     $partData{$part.':tries'}=($tries) ? $tries : 0;
                   1035: 
                   1036:                     $partData{$part.':timestamp'}=$input->{$name.':'.$Version.':'.
                   1037:                                                            $problem.
                   1038:                                                            ':timestamp'};
                   1039:                     if(!$input->{$name.':'.$Version.':'.$problem.':resource.'.$part.
                   1040:                                  '.previous'}) {
                   1041:                         foreach my $response (split(':',
                   1042:                                                    $data->{$sequence.':'.
                   1043:                                                            $problemID.':'.
                   1044:                                                            $part.':responseIDs'})) {
                   1045:                             @submissions=($input->{$name.':'.$Version.':'.
                   1046:                                                    $problem.
                   1047:                                                    ':resource.'.$part.'.'.
                   1048:                                                    $response.'.submission'},
                   1049:                                           @submissions);
                   1050:                         }
                   1051:                     }
                   1052: 
                   1053:                     my $val = $input->{$name.':'.$Version.':'.$problem.
                   1054:                                        ':resource.'.$part.'.solved'};
                   1055:                     if    ($val eq 'correct_by_student')   {$code = '*';} 
                   1056:                     elsif ($val eq 'correct_by_override')  {$code = '+';}
                   1057:                     elsif ($val eq 'incorrect_attempted')  {$code = '.';} 
                   1058:                     elsif ($val eq 'incorrect_by_override'){$code = '-';}
                   1059:                     elsif ($val eq 'excused')              {$code = 'x';}
                   1060:                     elsif ($val eq 'ungraded_attempted')   {$code = '#';}
                   1061:                     else                                   {$code = ' ';}
                   1062:                     $partData{$part.':code'}=$code;
                   1063:                 }
                   1064:             }
                   1065: 
                   1066:             foreach my $part (split(/\:/,$data->{$sequence.':'.$problemID.
                   1067:                                                  ':parts'})) {
                   1068:                 $output->{$name.':'.$problemID.':'.$part.':wrong'} = 
                   1069:                     $partData{$part.':tries'};
1.26      stredwic 1070: 		$allkeys{$name.':'.$problemID.':'.$part.':wrong'}++;
1.13      stredwic 1071: 
                   1072:                 if($partData{$part.':code'} eq '*') {
                   1073:                     $output->{$name.':'.$problemID.':'.$part.':wrong'}--;
                   1074:                     $problemsCorrect++;
                   1075:                 } elsif($partData{$part.':code'} eq '+') {
                   1076:                     $output->{$name.':'.$problemID.':'.$part.':wrong'}--;
                   1077:                     $problemsCorrect++;
                   1078:                 }
                   1079: 
                   1080:                 $output->{$name.':'.$problemID.':'.$part.':tries'} = 
                   1081:                     $partData{$part.':tries'};
                   1082:                 $output->{$name.':'.$problemID.':'.$part.':code'} =
                   1083:                     $partData{$part.':code'};
                   1084:                 $output->{$name.':'.$problemID.':'.$part.':awarded'} =
                   1085:                     $partData{$part.':awarded'};
1.26      stredwic 1086: 		$allkeys{$name.':'.$problemID.':'.$part.':tries'}++;
                   1087: 		$allkeys{$name.':'.$problemID.':'.$part.':code'}++;
                   1088: 		$allkeys{$name.':'.$problemID.':'.$part.':awarded'}++;
                   1089: 
1.14      stredwic 1090:                 $totalAwarded += $partData{$part.':awarded'};
1.13      stredwic 1091:                 $output->{$name.':'.$problemID.':'.$part.':timestamp'} =
                   1092:                     $partData{$part.':timestamp'};
1.26      stredwic 1093: 		$allkeys{$name.':'.$problemID.':'.$part.':timestamp'}++;
                   1094: 
1.13      stredwic 1095:                 foreach my $response (split(':', $data->{$sequence.':'.
                   1096:                                                          $problemID.':'.
                   1097:                                                          $part.':responseIDs'})) {
                   1098:                     $output->{$name.':'.$problemID.':'.$part.':'.$response.
                   1099:                               ':submission'}=join(':::',@submissions);
1.26      stredwic 1100: 		    $allkeys{$name.':'.$problemID.':'.$part.':'.$response.
                   1101: 			     ':submission'}++;
1.13      stredwic 1102:                 }
1.3       stredwic 1103: 
1.13      stredwic 1104:                 if($partData{$part.':code'} ne 'x') {
                   1105:                     $totalProblems++;
                   1106:                 }
                   1107:             }
1.1       stredwic 1108:         }
1.13      stredwic 1109: 
                   1110:         $output->{$name.':'.$sequence.':problemsCorrect'} = $problemsCorrect;
1.26      stredwic 1111: 	$allkeys{$name.':'.$sequence.':problemsCorrect'}++;
1.13      stredwic 1112:         $problemsSolved += $problemsCorrect;
                   1113: 	$problemsCorrect=0;
1.3       stredwic 1114:     }
                   1115: 
1.13      stredwic 1116:     $output->{$name.':problemsSolved'} = $problemsSolved;
                   1117:     $output->{$name.':totalProblems'} = $totalProblems;
1.14      stredwic 1118:     $output->{$name.':totalAwarded'} = $totalAwarded;
1.26      stredwic 1119:     $allkeys{$name.':problemsSolved'}++;
                   1120:     $allkeys{$name.':totalProblems'}++;
                   1121:     $allkeys{$name.':totalAwarded'}++;
                   1122: 
                   1123:     $output->{$name.':keys'} = join(':::', keys(%allkeys));
1.1       stredwic 1124: 
                   1125:     return;
1.4       stredwic 1126: }
                   1127: 
                   1128: sub LoadDiscussion {
1.13      stredwic 1129:     my ($courseID)=@_;
1.5       minaeibi 1130:     my %Discuss=();
                   1131:     my %contrib=&Apache::lonnet::dump(
                   1132:                 $courseID,
                   1133:                 $ENV{'course.'.$courseID.'.domain'},
                   1134:                 $ENV{'course.'.$courseID.'.num'});
                   1135: 				 
                   1136:     #my %contrib=&DownloadCourseInformation($name, $courseID, 0);
                   1137: 
1.4       stredwic 1138:     foreach my $temp(keys %contrib) {
                   1139: 	if ($temp=~/^version/) {
                   1140: 	    my $ver=$contrib{$temp};
                   1141: 	    my ($dummy,$prb)=split(':',$temp);
                   1142: 	    for (my $idx=1; $idx<=$ver; $idx++ ) {
                   1143: 		my $name=$contrib{"$idx:$prb:sendername"};
1.5       minaeibi 1144: 		$Discuss{"$name:$prb"}=$idx;	
1.4       stredwic 1145: 	    }
                   1146: 	}
                   1147:     }       
1.5       minaeibi 1148: 
                   1149:     return \%Discuss;
1.1       stredwic 1150: }
                   1151: 
                   1152: # ----- END PROCESSING FUNCTIONS ---------------------------------------
                   1153: 
                   1154: =pod
                   1155: 
                   1156: =head1 HELPER FUNCTIONS
                   1157: 
                   1158: These are just a couple of functions do various odd and end 
1.22      stredwic 1159: jobs.  There was also a couple of bulk functions added.  These are
                   1160: &DownloadStudentCourseData(), &DownloadStudentCourseDataSeparate(), and
                   1161: &CheckForResidualDownload().  These functions now act as the interface
                   1162: for downloading student course data.  The statistical modules should
                   1163: no longer make the calls to dump and download and process etc.  They
                   1164: make calls to these bulk functions to get their data.
1.1       stredwic 1165: 
                   1166: =cut
                   1167: 
                   1168: # ----- HELPER FUNCTIONS -----------------------------------------------
                   1169: 
1.13      stredwic 1170: sub CheckDateStampError {
                   1171:     my ($courseData, $cache, $name)=@_;
                   1172:     if($courseData->{$name.':UpToDate'} eq 'true') {
                   1173:         $cache->{$name.':lastDownloadTime'} = 
                   1174:             $courseData->{$name.':lastDownloadTime'};
                   1175:         if($courseData->{$name.':lastDownloadTime'} eq 'Not downloaded') {
                   1176:             $cache->{$name.':updateTime'} = ' Not updated';
                   1177:         } else {
                   1178:             $cache->{$name.':updateTime'}=
                   1179:                 localtime($courseData->{$name.':lastDownloadTime'});
                   1180:         }
                   1181:         return 0;
                   1182:     }
                   1183: 
                   1184:     $cache->{$name.':lastDownloadTime'}=$courseData->{$name.':lastDownloadTime'};
                   1185:     if($courseData->{$name.':lastDownloadTime'} eq 'Not downloaded') {
                   1186:         $cache->{$name.':updateTime'} = ' Not updated';
                   1187:     } else {
                   1188:         $cache->{$name.':updateTime'}=
                   1189:             localtime($courseData->{$name.':lastDownloadTime'});
                   1190:     }
                   1191: 
                   1192:     if(defined($courseData->{$name.':error'})) {
                   1193:         $cache->{$name.':error'}=$courseData->{$name.':error'};
                   1194:         return 0;
                   1195:     }
                   1196: 
                   1197:     return 1;
                   1198: }
                   1199: 
1.1       stredwic 1200: =pod
                   1201: 
                   1202: =item &ProcessFullName()
                   1203: 
                   1204: Takes lastname, generation, firstname, and middlename (or some partial
                   1205: set of this data) and returns the full name version as a string.  Format
                   1206: is Lastname generation, firstname middlename or a subset of this.
                   1207: 
                   1208: =cut
                   1209: 
                   1210: sub ProcessFullName {
                   1211:     my ($lastname, $generation, $firstname, $middlename)=@_;
                   1212:     my $Str = '';
                   1213: 
1.34      matthew  1214:     # Strip whitespace preceeding & following name components.
                   1215:     $lastname   =~ s/(\s+$|^\s+)//g;
                   1216:     $generation =~ s/(\s+$|^\s+)//g;
                   1217:     $firstname  =~ s/(\s+$|^\s+)//g;
                   1218:     $middlename =~ s/(\s+$|^\s+)//g;
                   1219: 
1.1       stredwic 1220:     if($lastname ne '') {
1.34      matthew  1221: 	$Str .= $lastname;
                   1222: 	$Str .= ' '.$generation if ($generation ne '');
                   1223: 	$Str .= ',';
                   1224:         $Str .= ' '.$firstname  if ($firstname ne '');
                   1225:         $Str .= ' '.$middlename if ($middlename ne '');
1.1       stredwic 1226:     } else {
1.34      matthew  1227:         $Str .= $firstname      if ($firstname ne '');
                   1228:         $Str .= ' '.$middlename if ($middlename ne '');
                   1229:         $Str .= ' '.$generation if ($generation ne '');
1.1       stredwic 1230:     }
                   1231: 
                   1232:     return $Str;
                   1233: }
                   1234: 
                   1235: =pod
                   1236: 
                   1237: =item &TestCacheData()
                   1238: 
                   1239: Determine if the cache database can be accessed with a tie.  It waits up to
                   1240: ten seconds before returning failure.  This function exists to help with
                   1241: the problems with stopping the data download.  When an abort occurs and the
                   1242: user quickly presses a form button and httpd child is created.  This
                   1243: child needs to wait for the other to finish (hopefully within ten seconds).
                   1244: 
                   1245: =over 4
                   1246: 
                   1247: Input: $ChartDB
                   1248: 
                   1249: $ChartDB: The name of the cache database to be opened
                   1250: 
                   1251: Output: -1, 0, 1
                   1252: 
1.23      stredwic 1253: -1: Could not tie database
1.1       stredwic 1254:  0: Use cached data
                   1255:  1: New cache database created, use that.
                   1256: 
                   1257: =back
                   1258: 
                   1259: =cut
                   1260: 
                   1261: sub TestCacheData {
                   1262:     my ($ChartDB,$isRecalculate,$totalDelay)=@_;
                   1263:     my $isCached=-1;
                   1264:     my %testData;
                   1265:     my $tieTries=0;
                   1266: 
                   1267:     if(!defined($totalDelay)) {
                   1268:         $totalDelay = 10;
                   1269:     }
                   1270: 
                   1271:     if ((-e "$ChartDB") && (!$isRecalculate)) {
                   1272: 	$isCached = 1;
                   1273:     } else {
                   1274: 	$isCached = 0;
                   1275:     }
                   1276: 
                   1277:     while($tieTries < $totalDelay) {
                   1278:         my $result=0;
                   1279:         if($isCached) {
1.10      stredwic 1280:             $result=tie(%testData,'GDBM_File',$ChartDB,&GDBM_READER(),0640);
1.1       stredwic 1281:         } else {
1.10      stredwic 1282:             $result=tie(%testData,'GDBM_File',$ChartDB,&GDBM_NEWDB(),0640);
1.1       stredwic 1283:         }
                   1284:         if($result) {
                   1285:             last;
                   1286:         }
                   1287:         $tieTries++;
                   1288:         sleep 1;
                   1289:     }
                   1290:     if($tieTries >= $totalDelay) {
                   1291:         return -1;
                   1292:     }
                   1293: 
                   1294:     untie(%testData);
                   1295: 
                   1296:     return $isCached;
                   1297: }
1.2       stredwic 1298: 
1.13      stredwic 1299: sub DownloadStudentCourseData {
                   1300:     my ($students,$checkDate,$cacheDB,$extract,$status,$courseID,$r,$c)=@_;
                   1301: 
                   1302:     my $title = 'LON-CAPA Statistics';
                   1303:     my $heading = 'Download and Process Course Data';
                   1304:     my $studentCount = scalar(@$students);
1.18      stredwic 1305: 
1.13      stredwic 1306:     my $WhatIWant;
1.20      stredwic 1307:     $WhatIWant = '(^version:|';
1.18      stredwic 1308:     $WhatIWant .= '^\d+:.+?:(resource\.\d+\.';
1.42      matthew  1309:     $WhatIWant .= '(solved|tries|previous|awarded|(\d+\.submission))\s*$';#'
1.13      stredwic 1310:     $WhatIWant .= '|timestamp)';
                   1311:     $WhatIWant .= ')';
1.20      stredwic 1312: #    $WhatIWant = '.';
1.13      stredwic 1313: 
1.55      albertel 1314:     my %prog_state;
1.13      stredwic 1315:     if($status eq 'true') {
1.55      albertel 1316:         %prog_state=&Apache::lonhtmlcommon::Create_PrgWin($r, $title,
                   1317: 					       $heading,($#$students)+1);
1.13      stredwic 1318:     }
1.17      stredwic 1319: 
1.13      stredwic 1320:     foreach (@$students) {
1.24      stredwic 1321:         my %cache;
                   1322: 
1.13      stredwic 1323:         if($c->aborted()) { return 'Aborted'; }
                   1324: 
                   1325:         if($status eq 'true') {
1.55      albertel 1326:             &Apache::lonhtmlcommon::Increment_PrgWin($r,\%prog_state,
                   1327: 						  'last student '.$_);
1.13      stredwic 1328:         }
                   1329: 
                   1330:         my $downloadTime='Not downloaded';
1.28      stredwic 1331:         my $needUpdate = 'false';
1.13      stredwic 1332:         if($checkDate eq 'true'  && 
                   1333:            tie(%cache,'GDBM_File',$cacheDB,&GDBM_READER(),0640)) {
                   1334:             $downloadTime = $cache{$_.':lastDownloadTime'};
1.28      stredwic 1335:             $needUpdate = $cache{'ResourceUpdated'};
1.13      stredwic 1336:             untie(%cache);
                   1337:         }
                   1338: 
                   1339:         if($c->aborted()) { return 'Aborted'; }
                   1340: 
1.43      matthew  1341:         if($needUpdate eq 'true') {
1.28      stredwic 1342:             $downloadTime = 'Not downloaded';
                   1343: 	}
1.24      stredwic 1344: 	my $courseData = 
                   1345: 	    &DownloadCourseInformation($_, $courseID, $downloadTime, 
                   1346: 				       $WhatIWant);
                   1347: 	if(tie(%cache,'GDBM_File',$cacheDB,&GDBM_WRCREAT(),0640)) {
                   1348: 	    foreach my $key (keys(%$courseData)) {
                   1349: 		if($key =~ /^(con_lost|error|no_such_host)/i) {
                   1350: 		    $courseData->{$_.':error'} = 'No course data for '.$_;
                   1351: 		    last;
                   1352: 		}
                   1353: 	    }
                   1354: 	    if($extract eq 'true') {
                   1355: 		&ExtractStudentData($courseData, \%cache, \%cache, $_);
                   1356: 	    } else {
                   1357: 		&ProcessStudentData(\%cache, $courseData, $_);
                   1358: 	    }
                   1359: 	    untie(%cache);
                   1360: 	} else {
                   1361: 	    next;
                   1362: 	}
1.13      stredwic 1363:     }
1.55      albertel 1364:     if($status eq 'true') { &Apache::lonhtmlcommon::Close_PrgWin($r,\%prog_state); }
1.13      stredwic 1365: 
                   1366:     return 'OK';
                   1367: }
                   1368: 
                   1369: sub DownloadStudentCourseDataSeparate {
                   1370:     my ($students,$checkDate,$cacheDB,$extract,$status,$courseID,$r,$c)=@_;
1.46      matthew  1371:     my $residualFile = $Apache::lonnet::tmpdir.$courseID.'DownloadFile.db';
1.13      stredwic 1372:     my $title = 'LON-CAPA Statistics';
                   1373:     my $heading = 'Download Course Data';
                   1374: 
                   1375:     my $WhatIWant;
1.20      stredwic 1376:     $WhatIWant = '(^version:|';
1.18      stredwic 1377:     $WhatIWant .= '^\d+:.+?:(resource\.\d+\.';
1.45      matthew  1378:     $WhatIWant .= '(solved|tries|previous|awarded|(\d+\.submission))\s*$';#'
1.13      stredwic 1379:     $WhatIWant .= '|timestamp)';
                   1380:     $WhatIWant .= ')';
                   1381: 
1.30      stredwic 1382:     &CheckForResidualDownload($cacheDB, 'true', 'true', $courseID, $r, $c);
1.13      stredwic 1383: 
                   1384:     my $studentCount = scalar(@$students);
1.55      albertel 1385:     my %prog_state;
1.13      stredwic 1386:     if($status eq 'true') {
1.55      albertel 1387:         %prog_state=&Apache::lonhtmlcommon::Create_PrgWin($r, $title,
                   1388: 						     $heading,($#$students)+1);
1.13      stredwic 1389:     }
1.17      stredwic 1390:     my $displayString='';
1.13      stredwic 1391:     foreach (@$students) {
                   1392:         if($c->aborted()) {
                   1393:             return 'Aborted';
                   1394:         }
                   1395: 
                   1396:         if($status eq 'true') {
1.55      albertel 1397:             &Apache::lonhtmlcommon::Increment_PrgWin($r,\%prog_state,
                   1398: 						  'last student '.$_);
1.13      stredwic 1399:         }
                   1400: 
1.24      stredwic 1401:         my %cache;
1.13      stredwic 1402:         my $downloadTime='Not downloaded';
1.28      stredwic 1403:         my $needUpdate = 'false';
1.13      stredwic 1404:         if($checkDate eq 'true'  && 
                   1405:            tie(%cache,'GDBM_File',$cacheDB,&GDBM_READER(),0640)) {
                   1406:             $downloadTime = $cache{$_.':lastDownloadTime'};
1.28      stredwic 1407:             $needUpdate = $cache{'ResourceUpdated'};
1.13      stredwic 1408:             untie(%cache);
                   1409:         }
                   1410: 
                   1411:         if($c->aborted()) {
                   1412:             return 'Aborted';
                   1413:         }
                   1414: 
1.43      matthew  1415:         if($needUpdate eq 'true') {
1.28      stredwic 1416:             $downloadTime = 'Not downloaded';
                   1417: 	}
                   1418: 
                   1419:         my $error = 0;
                   1420:         my $courseData = 
                   1421:             &DownloadCourseInformation($_, $courseID, $downloadTime,
                   1422:                                        $WhatIWant);
                   1423:         my %downloadData;
                   1424:         unless(tie(%downloadData,'GDBM_File',$residualFile,
                   1425:                    &GDBM_WRCREAT(),0640)) {
                   1426:             return 'Failed to tie temporary download hash.';
                   1427:         }
                   1428:         foreach my $key (keys(%$courseData)) {
                   1429:             $downloadData{$key} = $courseData->{$key};
                   1430:             if($key =~ /^(con_lost|error|no_such_host)/i) {
                   1431:                 $error = 1;
                   1432:                 last;
1.18      stredwic 1433:             }
1.28      stredwic 1434:         }
                   1435:         if($error) {
                   1436:             foreach my $deleteKey (keys(%$courseData)) {
                   1437:                 delete $downloadData{$deleteKey};
1.13      stredwic 1438:             }
1.28      stredwic 1439:             $downloadData{$_.':error'} = 'No course data for '.$_;
                   1440:         }
                   1441:         untie(%downloadData);
1.13      stredwic 1442:     }
1.55      albertel 1443:     if($status eq 'true') { &Apache::lonhtmlcommon::Close_PrgWin($r,
                   1444: 							  \%prog_state); }
1.13      stredwic 1445: 
                   1446:     return &CheckForResidualDownload($cacheDB, 'true', 'true', 
                   1447:                                      $courseID, $r, $c);
                   1448: }
                   1449: 
                   1450: sub CheckForResidualDownload {
                   1451:     my ($cacheDB,$extract,$status,$courseID,$r,$c)=@_;
                   1452: 
1.46      matthew  1453:     my $residualFile = $Apache::lonnet::tmpdir.$courseID.'DownloadFile.db';
1.13      stredwic 1454:     if(!-e $residualFile) {
1.18      stredwic 1455:         return 'OK';
1.13      stredwic 1456:     }
                   1457: 
                   1458:     my %downloadData;
                   1459:     my %cache;
1.17      stredwic 1460:     unless(tie(%downloadData,'GDBM_File',$residualFile,&GDBM_READER(),0640)) {
                   1461:         return 'Can not tie database for check for residual download: tempDB';
                   1462:     }
                   1463:     unless(tie(%cache,'GDBM_File',$cacheDB,&GDBM_WRCREAT(),0640)) {
                   1464:         untie(%downloadData);
                   1465:         return 'Can not tie database for check for residual download: cacheDB';
1.13      stredwic 1466:     }
                   1467: 
                   1468:     my @students=();
                   1469:     my %checkStudent;
1.18      stredwic 1470:     my $key;
                   1471:     while(($key, undef) = each %downloadData) {
                   1472:         my @temp = split(':', $key);
1.13      stredwic 1473:         my $student = $temp[0].':'.$temp[1];
                   1474:         if(!defined($checkStudent{$student})) {
                   1475:             $checkStudent{$student}++;
                   1476:             push(@students, $student);
                   1477:         }
                   1478:     }
                   1479: 
                   1480:     my $heading = 'Process Course Data';
                   1481:     my $title = 'LON-CAPA Statistics';
                   1482:     my $studentCount = scalar(@students);
1.55      albertel 1483:     my %prog_state;
1.13      stredwic 1484:     if($status eq 'true') {
1.55      albertel 1485:         %prog_state=&Apache::lonhtmlcommon::Create_PrgWin($r, $title,
                   1486: 						      $heading,$#students+1);
1.13      stredwic 1487:     }
                   1488: 
1.20      stredwic 1489:     my $count=1;
1.13      stredwic 1490:     foreach my $name (@students) {
                   1491:         last if($c->aborted());
                   1492: 
                   1493:         if($status eq 'true') {
1.55      albertel 1494: 	    &Apache::lonhtmlcommon::Increment_PrgWin($r,\%prog_state,
                   1495: 						     'last student '.$name);
1.13      stredwic 1496:         }
                   1497: 
                   1498:         if($extract eq 'true') {
                   1499:             &ExtractStudentData(\%downloadData, \%cache, \%cache, $name);
                   1500:         } else {
                   1501:             &ProcessStudentData(\%cache, \%downloadData, $name);
                   1502:         }
                   1503:         $count++;
                   1504:     }
                   1505: 
1.55      albertel 1506:     if($status eq 'true') { &Apache::lonhtmlcommon::Close_PrgWin($r,
                   1507: 							   \%prog_state); }
1.13      stredwic 1508: 
                   1509:     untie(%cache);
                   1510:     untie(%downloadData);
                   1511: 
                   1512:     if(!$c->aborted()) {
                   1513:         my @files = ($residualFile);
                   1514:         unlink(@files);
                   1515:     }
                   1516: 
                   1517:     return 'OK';
1.46      matthew  1518: }
                   1519: 
                   1520: 
                   1521: ################################################
                   1522: ################################################
                   1523: 
                   1524: =pod
                   1525: 
1.47      matthew  1526: =item &make_into_hash($values);
                   1527: 
                   1528: Returns a reference to a hash as described by $values.  $values is
                   1529: assumed to be the result of 
1.57      matthew  1530:     join(':',map {&Apache::lonnet::escape($_)} %orighash);
1.47      matthew  1531: 
                   1532: This is a helper function for get_current_state.
                   1533: 
                   1534: =cut
                   1535: 
                   1536: ################################################
                   1537: ################################################
                   1538: sub make_into_hash {
                   1539:     my $values = shift;
                   1540:     my %tmp = map { &Apache::lonnet::unescape($_); }
                   1541:                                            split(':',$values);
                   1542:     return \%tmp;
                   1543: }
                   1544: 
                   1545: 
                   1546: ################################################
                   1547: ################################################
                   1548: 
                   1549: =pod
                   1550: 
1.57      matthew  1551: =head1 LOCAL DATA CACHING SUBROUTINES
                   1552: 
                   1553: The local caching is done using MySQL.  There is no fall-back implementation
                   1554: if MySQL is not running.
                   1555: 
                   1556: The programmers interface is to call &get_current_state() or some other
                   1557: primary interface subroutine (described below).  The internals of this 
                   1558: storage system are documented here.
                   1559: 
                   1560: There are six tables used to store student performance data (the results of
                   1561: a dumpcurrent).  Each of these tables is created in MySQL with a name of
                   1562: $courseid_*****, where ***** is 'symb', 'part', or whatever is appropriate 
                   1563: for the table.  The tables and their purposes are described below.
                   1564: 
                   1565: Some notes before we get started.
                   1566: 
                   1567: Each table must have a PRIMARY KEY, which is a column or set of columns which
                   1568: will serve to uniquely identify a row of data.  NULL is not allowed!
                   1569: 
                   1570: INDEXes work best on integer data.
                   1571: 
                   1572: JOIN is used to combine data from many tables into one output.
                   1573: 
                   1574: lonmysql.pm is used for some of the interface, specifically the table creation
                   1575: calls.  The inserts are done in bulk by directly calling the database handler.
                   1576: The SELECT ... JOIN statement used to retrieve the data does not have an
                   1577: interface in lonmysql.pm and I shudder at the thought of writing one.
                   1578: 
                   1579: =head3 Table Descriptions
                   1580: 
                   1581: =over 4
                   1582: 
                   1583: =item $symb_table
                   1584: 
                   1585: The symb_table has two columns.  The first is a 'symb_id' and the second
                   1586: is the text name for the 'symb' (limited to 64k).  The 'symb_id' is generated
                   1587: automatically by MySQL so inserts should be done on this table with an
                   1588: empty first element.  This table has its PRIMARY KEY on the 'symb_id'.
                   1589: 
                   1590: =item $part_table
                   1591: 
                   1592: The part_table has two columns.  The first is a 'part_id' and the second
                   1593: is the text name for the 'part' (limited to 100 characters).  The 'part_id' is
                   1594: generated automatically by MySQL so inserts should be done on this table with
                   1595: an empty first element.  This table has its PRIMARY KEY on the 'part' (100
                   1596: characters) and a KEY on 'part_id'.
                   1597: 
                   1598: =item $student_table
                   1599: 
                   1600: The student_table has two columns.  The first is a 'student_id' and the second
                   1601: is the text description of the 'student' (typically username:domain) (less
                   1602: than 100 characters).  The 'student_id' is automatically generated by MySQL.
                   1603: The use of the name 'student_id' is loaded, I know, but this ID is used ONLY 
                   1604: internally to the MySQL database and is not the same as the students ID 
                   1605: (stored in the students environment).  This table has its PRIMARY KEY on the
                   1606: 'student' (100 characters).
                   1607: 
                   1608: =item $updatetime_table
                   1609: 
                   1610: The updatetime_table has two columns.  The first is 'student' (100 characters,
                   1611: typically username:domain).  The second is 'updatetime', which is an unsigned
                   1612: integer, NOT a MySQL date.  This table has its PRIMARY KEY on 'student' (100
                   1613: characters).
                   1614: 
                   1615: =item $performance_table
                   1616: 
                   1617: The performance_table has 9 columns.  The first three are 'symb_id', 
                   1618: 'student_id', and 'part_id'.  These comprise the PRIMARY KEY for this table
                   1619: and are directly related to the $symb_table, $student_table, and $part_table
                   1620: described above.  MySQL does better indexing on numeric items than text,
                   1621: so we use these three "index tables".  The remaining columns are
                   1622: 'solved', 'tries', 'awarded', 'award', 'awarddetail', and 'timestamp'.
                   1623: These are either the MySQL type TINYTEXT or various integers ('tries' and 
                   1624: 'timestamp').  This table has KEYs of 'student_id' and 'symb_id'.
                   1625: For use of this table, see the functions described below.
                   1626: 
                   1627: =item $parameters_table
                   1628: 
                   1629: The parameters_table holds the data that does not fit neatly into the
                   1630: performance_table.  The parameters table has four columns: 'symb_id',
                   1631: 'student_id', 'parameter', and 'value'.  'symb_id', 'student_id', and
                   1632: 'parameter' comprise the PRIMARY KEY for this table.  'parameter' is 
                   1633: limited to 255 characters.  'value' is limited to 64k characters.
                   1634: 
                   1635: =back
                   1636: 
                   1637: =head3 Important Subroutines
                   1638: 
                   1639: Here is a brief overview of the subroutines which are likely to be of 
                   1640: interest:
                   1641: 
                   1642: =over 4
                   1643: 
                   1644: =item &get_current_state(): programmers interface.
                   1645: 
                   1646: =item &init_dbs(): table creation
                   1647: 
                   1648: =item &update_student_data(): data storage calls
                   1649: 
                   1650: =item &get_student_data_from_performance_cache(): data retrieval
                   1651: 
                   1652: =back
                   1653: 
                   1654: =head3 Main Documentation
                   1655: 
                   1656: =over 4
                   1657: 
                   1658: =cut
                   1659: 
                   1660: ################################################
                   1661: ################################################
                   1662: 
                   1663: ################################################
                   1664: ################################################
                   1665: {
                   1666: 
                   1667: my $current_course ='';
                   1668: my $symb_table;
                   1669: my $part_table;
                   1670: my $student_table;
                   1671: my $updatetime_table;
                   1672: my $performance_table;
                   1673: my $parameters_table;
                   1674: 
                   1675: ################################################
                   1676: ################################################
                   1677: 
                   1678: =pod
                   1679: 
                   1680: =item &setup_table_names()
                   1681: 
                   1682: input: course id
                   1683: 
                   1684: output: none
                   1685: 
                   1686: Sets the package variables for the MySQL table names:
                   1687: 
                   1688: =over 4
                   1689: 
                   1690: =item $symb_table
                   1691: 
                   1692: =item $part_table
                   1693: 
                   1694: =item $student_table
                   1695: 
                   1696: =item $updatetime_table
                   1697: 
                   1698: =item $performance_table
                   1699: 
                   1700: =item $parameters_table
                   1701: 
                   1702: =back
                   1703: 
                   1704: =cut
                   1705: 
                   1706: ################################################
                   1707: ################################################
                   1708: sub setup_table_names {
                   1709:     my $courseid = shift;
                   1710:     if (! defined($courseid)) {
                   1711:         $courseid = $ENV{'request.course.id'};
                   1712:     }
                   1713:     #
                   1714:     # Set up database names
                   1715:     my $base_id = $courseid;
                   1716:     $symb_table        = $base_id.'_'.'symb';
                   1717:     $part_table        = $base_id.'_'.'part';
                   1718:     $student_table     = $base_id.'_'.'student';
                   1719:     $updatetime_table  = $base_id.'_'.'updatetime';
                   1720:     $performance_table = $base_id.'_'.'performance';
                   1721:     $parameters_table  = $base_id.'_'.'parameters';
                   1722:     return;
                   1723: }
                   1724: 
                   1725: ################################################
                   1726: ################################################
                   1727: 
                   1728: =pod
                   1729: 
                   1730: =item &init_dbs()
                   1731: 
                   1732: Input: course id
                   1733: 
                   1734: Output: 0 on success, positive integer on error
                   1735: 
                   1736: This routine issues the calls to lonmysql to create the tables used to
                   1737: store student data.
                   1738: 
                   1739: =cut
                   1740: 
                   1741: ################################################
                   1742: ################################################
                   1743: sub init_dbs {
                   1744:     my $courseid = shift;
                   1745:     &setup_table_names($courseid);
                   1746:     #
                   1747:     # Note - changes to this table must be reflected in the code that 
                   1748:     # stores the data (calls &Apache::lonmysql::store_row with this table
                   1749:     # id
                   1750:     my $symb_table_def = {
                   1751:         id => $symb_table,
                   1752:         permanent => 'no',
                   1753:         columns => [{ name => 'symb_id',
                   1754:                       type => 'MEDIUMINT UNSIGNED',
                   1755:                       restrictions => 'NOT NULL',
                   1756:                       auto_inc     => 'yes', },
                   1757:                     { name => 'symb',
                   1758:                       type => 'MEDIUMTEXT',
                   1759:                       restrictions => 'NOT NULL'},
                   1760:                     ],
                   1761:         'PRIMARY KEY' => ['symb_id'],
                   1762:     };
                   1763:     #
                   1764:     my $part_table_def = {
                   1765:         id => $part_table,
                   1766:         permanent => 'no',
                   1767:         columns => [{ name => 'part_id',
                   1768:                       type => 'MEDIUMINT UNSIGNED',
                   1769:                       restrictions => 'NOT NULL',
                   1770:                       auto_inc     => 'yes', },
                   1771:                     { name => 'part',
                   1772:                       type => 'VARCHAR(100)',
                   1773:                       restrictions => 'NOT NULL'},
                   1774:                     ],
                   1775:         'PRIMARY KEY' => ['part (100)'],
                   1776:         'KEY' => [{ columns => ['part_id']},],
                   1777:     };
                   1778:     #
                   1779:     my $student_table_def = {
                   1780:         id => $student_table,
                   1781:         permanent => 'no',
                   1782:         columns => [{ name => 'student_id',
                   1783:                       type => 'MEDIUMINT UNSIGNED',
                   1784:                       restrictions => 'NOT NULL',
                   1785:                       auto_inc     => 'yes', },
                   1786:                     { name => 'student',
                   1787:                       type => 'VARCHAR(100)',
                   1788:                       restrictions => 'NOT NULL'},
                   1789:                     ],
                   1790:         'PRIMARY KEY' => ['student (100)'],
                   1791:         'KEY' => [{ columns => ['student_id']},],
                   1792:     };
                   1793:     #
                   1794:     my $updatetime_table_def = {
                   1795:         id => $updatetime_table,
                   1796:         permanent => 'no',
                   1797:         columns => [{ name => 'student',
                   1798:                       type => 'VARCHAR(100)',
                   1799:                       restrictions => 'NOT NULL UNIQUE',},
                   1800:                     { name => 'updatetime',
                   1801:                       type => 'INT UNSIGNED',
                   1802:                       restrictions => 'NOT NULL' },
                   1803:                     ],
                   1804:         'PRIMARY KEY' => ['student (100)'],
                   1805:     };
                   1806:     #
                   1807:     my $performance_table_def = {
                   1808:         id => $performance_table,
                   1809:         permanent => 'no',
                   1810:         columns => [{ name => 'symb_id',
                   1811:                       type => 'MEDIUMINT UNSIGNED',
                   1812:                       restrictions => 'NOT NULL'  },
                   1813:                     { name => 'student_id',
                   1814:                       type => 'MEDIUMINT UNSIGNED',
                   1815:                       restrictions => 'NOT NULL'  },
                   1816:                     { name => 'part_id',
                   1817:                       type => 'MEDIUMINT UNSIGNED',
                   1818:                       restrictions => 'NOT NULL' },
                   1819:                     { name => 'solved',
                   1820:                       type => 'TINYTEXT' },
                   1821:                     { name => 'tries',
                   1822:                       type => 'SMALLINT UNSIGNED' },
                   1823:                     { name => 'awarded',
                   1824:                       type => 'TINYTEXT' },
                   1825:                     { name => 'award',
                   1826:                       type => 'TINYTEXT' },
                   1827:                     { name => 'awarddetail',
                   1828:                       type => 'TINYTEXT' },
                   1829:                     { name => 'timestamp',
                   1830:                       type => 'INT UNSIGNED'},
                   1831:                     ],
                   1832:         'PRIMARY KEY' => ['symb_id','student_id','part_id'],
                   1833:         'KEY' => [{ columns=>['student_id'] },
                   1834:                   { columns=>['symb_id'] },],
                   1835:     };
                   1836:     #
                   1837:     my $parameters_table_def = {
                   1838:         id => $parameters_table,
                   1839:         permanent => 'no',
                   1840:         columns => [{ name => 'symb_id',
                   1841:                       type => 'MEDIUMINT UNSIGNED',
                   1842:                       restrictions => 'NOT NULL'  },
                   1843:                     { name => 'student_id',
                   1844:                       type => 'MEDIUMINT UNSIGNED',
                   1845:                       restrictions => 'NOT NULL'  },
                   1846:                     { name => 'parameter',
                   1847:                       type => 'TINYTEXT',
                   1848:                       restrictions => 'NOT NULL'  },
                   1849:                     { name => 'value',
                   1850:                       type => 'MEDIUMTEXT' },
                   1851:                     ],
                   1852:         'PRIMARY KEY' => ['symb_id','student_id','parameter (255)'],
                   1853:     };
                   1854:     #
                   1855:     # Create the tables
                   1856:     my $tableid;
                   1857:     $tableid = &Apache::lonmysql::create_table($symb_table_def);
                   1858:     if (! defined($tableid)) {
                   1859:         &Apache::lonnet::logthis("error creating symb_table: ".
                   1860:                                  &Apache::lonmysql::get_error());
                   1861:         return 1;
                   1862:     }
                   1863:     #
                   1864:     $tableid = &Apache::lonmysql::create_table($part_table_def);
                   1865:     if (! defined($tableid)) {
                   1866:         &Apache::lonnet::logthis("error creating part_table: ".
                   1867:                                  &Apache::lonmysql::get_error());
                   1868:         return 2;
                   1869:     }
                   1870:     #
                   1871:     $tableid = &Apache::lonmysql::create_table($student_table_def);
                   1872:     if (! defined($tableid)) {
                   1873:         &Apache::lonnet::logthis("error creating student_table: ".
                   1874:                                  &Apache::lonmysql::get_error());
                   1875:         return 3;
                   1876:     }
                   1877:     #
                   1878:     $tableid = &Apache::lonmysql::create_table($updatetime_table_def);
                   1879:     if (! defined($tableid)) {
                   1880:         &Apache::lonnet::logthis("error creating updatetime_table: ".
                   1881:                                  &Apache::lonmysql::get_error());
                   1882:         return 4;
                   1883:     }
                   1884:     #
                   1885:     $tableid = &Apache::lonmysql::create_table($performance_table_def);
                   1886:     if (! defined($tableid)) {
                   1887:         &Apache::lonnet::logthis("error creating preformance_table: ".
                   1888:                                  &Apache::lonmysql::get_error());
                   1889:         return 5;
                   1890:     }
                   1891:     #
                   1892:     $tableid = &Apache::lonmysql::create_table($parameters_table_def);
                   1893:     if (! defined($tableid)) {
                   1894:         &Apache::lonnet::logthis("error creating parameters_table: ".
                   1895:                                  &Apache::lonmysql::get_error());
                   1896:         return 6;
                   1897:     }
                   1898:     return 0;
                   1899: }
                   1900: 
                   1901: ################################################
                   1902: ################################################
                   1903: 
                   1904: =pod
                   1905: 
                   1906: =item &get_part_id()
                   1907: 
                   1908: Get the MySQL id of a problem part string.
                   1909: 
                   1910: Input: $part
                   1911: 
                   1912: Output: undef on error, integer $part_id on success.
                   1913: 
                   1914: =item &get_part()
                   1915: 
                   1916: Get the string describing a part from the MySQL id of the problem part.
                   1917: 
                   1918: Input: $part_id
                   1919: 
                   1920: Output: undef on error, $part string on success.
                   1921: 
                   1922: =cut
                   1923: 
                   1924: ################################################
                   1925: ################################################
                   1926: 
                   1927: my %ids_by_part;
                   1928: my %parts_by_id;
                   1929: 
                   1930: sub get_part_id {
                   1931:     my ($part) = @_;
                   1932:     if (! exists($ids_by_part{$part})) {
                   1933:         &Apache::lonmysql::store_row($part_table,[undef,$part]);
                   1934:         undef(%ids_by_part);
                   1935:         my @Result = &Apache::lonmysql::get_rows($part_table);
                   1936:         foreach (@Result) {
                   1937:             $ids_by_part{$_->[1]}=$_->[0];
                   1938:         }
                   1939:     }
                   1940:     return $ids_by_part{$part} if (exists($ids_by_part{$part}));
                   1941:     return undef; # error
                   1942: }
                   1943: 
                   1944: sub get_part {
                   1945:     my ($part_id) = @_;
                   1946:     if (! exists($parts_by_id{$part_id})  || 
                   1947:         ! defined($parts_by_id{$part_id}) ||
                   1948:         $parts_by_id{$part_id} eq '') {
                   1949:         my @Result = &Apache::lonmysql::get_rows($part_table);
                   1950:         foreach (@Result) {
                   1951:             $parts_by_id{$_->[0]}=$_->[1];
                   1952:         }
                   1953:     }
                   1954:     return $parts_by_id{$part_id} if(exists($parts_by_id{$part_id}));
                   1955:     return undef; # error
                   1956: }
                   1957: 
                   1958: ################################################
                   1959: ################################################
                   1960: 
                   1961: =pod
                   1962: 
                   1963: =item &get_symb_id()
                   1964: 
                   1965: Get the MySQL id of a symb.
                   1966: 
                   1967: Input: $symb
                   1968: 
                   1969: Output: undef on error, integer $symb_id on success.
                   1970: 
                   1971: =item &get_symb()
                   1972: 
                   1973: Get the symb associated with a MySQL symb_id.
                   1974: 
                   1975: Input: $symb_id
                   1976: 
                   1977: Output: undef on error, $symb on success.
                   1978: 
                   1979: =cut
                   1980: 
                   1981: ################################################
                   1982: ################################################
                   1983: 
                   1984: my %ids_by_symb;
                   1985: my %symbs_by_id;
                   1986: 
                   1987: sub get_symb_id {
                   1988:     my ($symb) = @_;
                   1989:     if (! exists($ids_by_symb{$symb})) {
                   1990:         &Apache::lonmysql::store_row($symb_table,[undef,$symb]);
                   1991:         undef(%ids_by_symb);
                   1992:         my @Result = &Apache::lonmysql::get_rows($symb_table);
                   1993:         foreach (@Result) {
                   1994:             $ids_by_symb{$_->[1]}=$_->[0];
                   1995:         }
                   1996:     }
                   1997:     return $ids_by_symb{$symb} if(exists( $ids_by_symb{$symb}));
                   1998:     return undef; # error
                   1999: }
                   2000: 
                   2001: sub get_symb {
                   2002:     my ($symb_id) = @_;
                   2003:     if (! exists($symbs_by_id{$symb_id})  || 
                   2004:         ! defined($symbs_by_id{$symb_id}) ||
                   2005:         $symbs_by_id{$symb_id} eq '') {
                   2006:         my @Result = &Apache::lonmysql::get_rows($symb_table);
                   2007:         foreach (@Result) {
                   2008:             $symbs_by_id{$_->[0]}=$_->[1];
                   2009:         }
                   2010:     }
                   2011:     return $symbs_by_id{$symb_id} if(exists( $symbs_by_id{$symb_id}));
                   2012:     return undef; # error
                   2013: }
                   2014: 
                   2015: ################################################
                   2016: ################################################
                   2017: 
                   2018: =pod
                   2019: 
                   2020: =item &get_student_id()
                   2021: 
                   2022: Get the MySQL id of a student.
                   2023: 
                   2024: Input: $sname, $dom
                   2025: 
                   2026: Output: undef on error, integer $student_id on success.
                   2027: 
                   2028: =item &get_student()
                   2029: 
                   2030: Get student username:domain associated with the MySQL student_id.
                   2031: 
                   2032: Input: $student_id
                   2033: 
                   2034: Output: undef on error, string $student (username:domain) on success.
                   2035: 
                   2036: =cut
                   2037: 
                   2038: ################################################
                   2039: ################################################
                   2040: 
                   2041: my %ids_by_student;
                   2042: my %students_by_id;
                   2043: 
                   2044: sub get_student_id {
                   2045:     my ($sname,$sdom) = @_;
                   2046:     my $student = $sname.':'.$sdom;
                   2047:     if (! exists($ids_by_student{$student})) {
                   2048:         &Apache::lonmysql::store_row($student_table,[undef,$student]);
                   2049:         undef(%ids_by_student);
                   2050:         my @Result = &Apache::lonmysql::get_rows($student_table);
                   2051:         foreach (@Result) {
                   2052:             $ids_by_student{$_->[1]}=$_->[0];
                   2053:         }
                   2054:     }
                   2055:     return $ids_by_student{$student} if(exists( $ids_by_student{$student}));
                   2056:     return undef; # error
                   2057: }
                   2058: 
                   2059: sub get_student {
                   2060:     my ($student_id) = @_;
                   2061:     if (! exists($students_by_id{$student_id})  || 
                   2062:         ! defined($students_by_id{$student_id}) ||
                   2063:         $students_by_id{$student_id} eq '') {
                   2064:         my @Result = &Apache::lonmysql::get_rows($student_table);
                   2065:         foreach (@Result) {
                   2066:             $students_by_id{$_->[0]}=$_->[1];
                   2067:         }
                   2068:     }
                   2069:     return $students_by_id{$student_id} if(exists($students_by_id{$student_id}));
                   2070:     return undef; # error
                   2071: }
                   2072: 
                   2073: ################################################
                   2074: ################################################
                   2075: 
                   2076: =pod
                   2077: 
                   2078: =item &update_student_data()
                   2079: 
                   2080: Input: $sname, $sdom, $courseid
                   2081: 
                   2082: Output: $returnstatus, \%student_data
                   2083: 
                   2084: $returnstatus is a string describing any errors that occured.  'okay' is the
                   2085: default.
                   2086: \%student_data is the data returned by a call to lonnet::currentdump.
                   2087: 
                   2088: This subroutine loads a students data using lonnet::currentdump and inserts
                   2089: it into the MySQL database.  The inserts are done on two tables, 
                   2090: $performance_table and $parameters_table.  $parameters_table holds the data 
                   2091: that is not included in $performance_table.  See the description of 
                   2092: $performance_table elsewhere in this file.  The INSERT calls are made
                   2093: directly by this subroutine, not through lonmysql because we do a 'bulk'
                   2094: insert which takes advantage of MySQLs non-SQL compliant INSERT command to 
                   2095: insert multiple rows at a time.  If anything has gone wrong during this
                   2096: process, $returnstatus is updated with a description of the error and
                   2097: \%student_data is returned.  
                   2098: 
                   2099: Notice we do not insert the data and immediately query it.  This means it
                   2100: is possible for there to be data returned this first time that is not 
                   2101: available the second time.  CYA.
                   2102: 
                   2103: =cut
                   2104: 
                   2105: ################################################
                   2106: ################################################
                   2107: sub update_student_data {
                   2108:     my ($sname,$sdom,$courseid) = @_;
                   2109:     #
                   2110:     my $student_id = &get_student_id($sname,$sdom);
                   2111:     my $student = $sname.':'.$sdom;
                   2112:     #
                   2113:     my $returnstatus = 'okay';
                   2114:     #
                   2115:     # Set up database names
                   2116:     &setup_table_names($courseid);
                   2117:     #
                   2118:     # Download students data
                   2119:     my $time_of_retrieval = time;
                   2120:     my @tmp = &Apache::lonnet::currentdump($courseid,$sdom,$sname);
                   2121:     if ((scalar(@tmp) > 0) && ($tmp[0] =~ /^error:/)) {
                   2122:         &Apache::lonnet::logthis('error getting data for '.
                   2123:                                  $sname.':'.$sdom.' in course '.$courseid.
                   2124:                                  ':'.$tmp[0]);
                   2125:         $returnstatus = 'error getting data';
                   2126:         return $returnstatus;
                   2127:     }
                   2128:     if (scalar(@tmp) < 1) {
                   2129:         return ('no data',undef);
                   2130:     }
                   2131:     my %student_data = @tmp;
                   2132:     #
                   2133:     # Remove all of the students data from the table
                   2134:     &Apache::lonmysql::remove_from_table($performance_table,'student_id',
                   2135:                                          $student_id);
                   2136:     #
                   2137:     # Store away the data
                   2138:     #
                   2139:     my $starttime = Time::HiRes::time;
                   2140:     my $elapsed = 0;
                   2141:     my $rows_stored;
                   2142:     my $store_parameters_command  = 'INSERT INTO '.$parameters_table.
                   2143:         ' VALUES ';
                   2144:     my $store_performance_command = 'INSERT INTO '.$performance_table.
                   2145:         ' VALUES ';
                   2146:     my $dbh = &Apache::lonmysql::get_dbh();
                   2147:     return 'error' if (! defined($dbh));
                   2148:     while (my ($current_symb,$param_hash) = each(%student_data)) {
                   2149:         #
                   2150:         # make sure the symb is set up properly
                   2151:         my $symb_id = &get_symb_id($current_symb);
                   2152:         #
                   2153:         # Load data into the tables
                   2154:         while (my ($parameter,$value) = each (%$param_hash)) {
                   2155:             my $newstring;
                   2156:             if ($parameter !~ /(timestamp|resource\.(.*)\.(solved|tries|awarded|award|awarddetail|previous))/) {
                   2157:                 $newstring = "('".join("','",
                   2158:                                        $symb_id,$student_id,
                   2159:                                        $parameter,$value)."'),";
                   2160:                 if ($newstring !~ /''/) {
                   2161:                     $store_parameters_command .= $newstring;
                   2162:                     $rows_stored++;
                   2163:                 }
                   2164:             }
                   2165:             next if ($parameter !~ /^resource\.(.*)\.solved$/);
                   2166:             #
                   2167:             my $part = $1;
                   2168:             my $part_id = &get_part_id($part);
                   2169:             next if (!defined($part_id));
                   2170:             my $solved  = $value;
                   2171:             my $tries   = $param_hash->{'resource.'.$part.'.tries'};
                   2172:             my $awarded = $param_hash->{'resource.'.$part.'.awarded'};
                   2173:             my $award   = $param_hash->{'resource.'.$part.'.award'};
                   2174:             my $awarddetail = $param_hash->{'resource.'.$part.'.awarddetail'};
                   2175:             my $timestamp = $param_hash->{'timestamp'};
                   2176:             $solved      = '' if (! defined($awarded));
                   2177:             $tries       = '' if (! defined($tries));
                   2178:             $awarded     = '' if (! defined($awarded));
                   2179:             $award       = '' if (! defined($award));
                   2180:             $awarddetail = '' if (! defined($awarddetail));
                   2181:             $newstring = "('".join("','",$symb_id,$student_id,$part_id,
                   2182:                                    $solved,$tries,$awarded,$award,
                   2183:                                    $awarddetail,$timestamp)."'),";
                   2184:             $store_performance_command .= $newstring;
                   2185:             $rows_stored++;
                   2186:         }
                   2187:     }
                   2188:     chop $store_parameters_command;
                   2189:     chop $store_performance_command;
                   2190:     my $start = Time::HiRes::time;
                   2191:     $dbh->do($store_parameters_command);
                   2192:     if ($dbh->err()) {
                   2193:         &Apache::lonnet::logthis(' bigass insert error:'.$dbh->errstr());
                   2194:         &Apache::lonnet::logthis('command = '.$store_performance_command);
                   2195:         $returnstatus = 'error: unable to insert parameters into database';
                   2196:         return $returnstatus,\%student_data;
                   2197:     }
                   2198:     $dbh->do($store_performance_command);
                   2199:     if ($dbh->err()) {
                   2200:         &Apache::lonnet::logthis(' bigass insert error:'.$dbh->errstr());
                   2201:         &Apache::lonnet::logthis('command = '.$store_parameters_command);
                   2202:         $returnstatus = 'error: unable to insert performance into database';
                   2203:         return $returnstatus,\%student_data;
                   2204:     }
                   2205:     $elapsed += Time::HiRes::time - $start;
                   2206:     #
                   2207:     # Set the students update time
                   2208:     &Apache::lonmysql::replace_row($updatetime_table,
                   2209:                                    [$student,$time_of_retrieval]);
                   2210:     &Apache::lonnet::logthis('store       took: '.(Time::HiRes::time - $starttime).' for '.$rows_stored);
                   2211:     &Apache::lonnet::logthis('mysql store took: '.$elapsed.' for '.$rows_stored);
                   2212:     return ($returnstatus,\%student_data);
                   2213: }
                   2214: 
                   2215: ################################################
                   2216: ################################################
                   2217: 
                   2218: =pod
                   2219: 
                   2220: =item &ensure_current_data()
                   2221: 
                   2222: Input: $sname, $sdom, $courseid
                   2223: 
                   2224: Output: $status, $data
                   2225: 
                   2226: This routine ensures the data for a given student is up to date.  It calls
                   2227: &init_dbs() if the tables do not exist.  The $updatetime_table is queried
                   2228: to determine the time of the last update.  If the students data is out of
                   2229: date, &update_student_data() is called.  The return values from the call
                   2230: to &update_student_data() are returned.
                   2231: 
                   2232: =cut
                   2233: 
                   2234: ################################################
                   2235: ################################################
                   2236: sub ensure_current_data {
                   2237:     my ($sname,$sdom,$courseid) = @_;
                   2238:     my $status = 'okay';   # return value
                   2239:     #
                   2240:     &setup_table_names($courseid);
                   2241:     #
                   2242:     # if the tables do not exist, make them
                   2243:     my @CurrentTable = &Apache::lonmysql::tables_in_db();
                   2244:     my ($found_symb,$found_student,$found_part,$found_update,
                   2245:         $found_performance,$found_parameters);
                   2246:     foreach (@CurrentTable) {
                   2247:         $found_symb        = 1 if ($_ eq $symb_table);
                   2248:         $found_student     = 1 if ($_ eq $student_table);
                   2249:         $found_part        = 1 if ($_ eq $part_table);
                   2250:         $found_update      = 1 if ($_ eq $updatetime_table);
                   2251:         $found_performance = 1 if ($_ eq $performance_table);
                   2252:         $found_parameters  = 1 if ($_ eq $parameters_table);
                   2253:     }
                   2254:     if (!$found_symb        || !$found_update || 
                   2255:         !$found_student     || !$found_part   ||
                   2256:         !$found_performance || !$found_parameters) {
                   2257:         if (&init_dbs($courseid)) {
                   2258:             return 'error';
                   2259:         }
                   2260:     }
                   2261:     #
                   2262:     # Get the update time for the user
                   2263:     my $updatetime = 0;
                   2264:     my $modifiedtime = 1;
                   2265:     #
                   2266:     my $student = $sname.':'.$sdom;
                   2267:     my @Result = &Apache::lonmysql::get_rows($updatetime_table,
                   2268:                                              "student ='$student'");
                   2269:     my $data = undef;
                   2270:     if (@Result) {
                   2271:         $updatetime = $Result[0]->[1];
                   2272:     }
                   2273:     if ($modifiedtime > $updatetime) {
                   2274:         ($status,$data) = &update_student_data($sname,$sdom,$courseid);
                   2275:     }
                   2276:     return ($status,$data);
                   2277: }
                   2278: 
                   2279: ################################################
                   2280: ################################################
                   2281: 
                   2282: =pod
                   2283: 
                   2284: =item &get_student_data_from_performance_cache()
                   2285: 
                   2286: Input: $sname, $sdom, $symb, $courseid
                   2287: 
                   2288: Output: hash reference containing the data for the given student.
                   2289: If $symb is undef, all the students data is returned.
                   2290: 
                   2291: This routine is the heart of the local caching system.  See the description
                   2292: of $performance_table, $symb_table, $student_table, and $part_table.  The
                   2293: main task is building the MySQL request.  The tables appear in the request
                   2294: in the order in which they should be parsed by MySQL.  When searching
                   2295: on a student the $student_table is used to locate the 'student_id'.  All
                   2296: rows in $performance_table which have a matching 'student_id' are returned,
                   2297: with data from $part_table and $symb_table which match the entries in
                   2298: $performance_table, 'part_id' and 'symb_id'.  When searching on a symb,
                   2299: the $symb_table is processed first, with matching rows grabbed from 
                   2300: $performance_table and filled in from $part_table and $student_table in
                   2301: that order.  
                   2302: 
                   2303: Running 'EXPLAIN ' on the 'SELECT' statements generated can be quite 
                   2304: interesting, especially if you play with the order the tables are listed.  
                   2305: 
                   2306: =cut
                   2307: 
                   2308: ################################################
                   2309: ################################################
                   2310: sub get_student_data_from_performance_cache {
                   2311:     my ($sname,$sdom,$symb,$courseid)=@_;
                   2312:     my $student = $sname.':'.$sdom if (defined($sname) && defined($sdom));
                   2313:     &setup_table_names();
                   2314:     #
                   2315:     # Return hash
                   2316:     my $studentdata;
                   2317:     #
                   2318:     my $dbh = &Apache::lonmysql::get_dbh();
                   2319:     my $request = "SELECT ".
                   2320:         "d.symb,c.part,a.solved,a.tries,a.awarded,a.award,a.awarddetail,".
                   2321:             "a.timestamp ";
                   2322:     if (defined($student)) {
                   2323:         $request .= "FROM $student_table AS b ".
                   2324:             "LEFT JOIN $performance_table AS a ON b.student_id=a.student_id ".
                   2325:             "LEFT JOIN $part_table AS c ON c.part_id = a.part_id ".
                   2326:             "LEFT JOIN $symb_table AS d ON d.symb_id = a.symb_id ".
                   2327:                 "WHERE student='$student'";
                   2328:         if (defined($symb) && $symb ne '') {
                   2329:             $request .= " AND d.symb='".$dbh->quote($symb)."'";
                   2330:         }
                   2331:     } elsif (defined($symb) && $symb ne '') {
                   2332:         $request .= "FROM $symb_table as d ".
                   2333:             "LEFT JOIN $performance_table AS a ON d.symb_id=a.symb_id ".
                   2334:             "LEFT JOIN $part_table    AS c ON c.part_id = a.part_id ".
                   2335:             "LEFT JOIN $student_table AS b ON b.student_id = a.student_id ".
                   2336:                 "WHERE symb='".$dbh->quote($symb)."'";
                   2337:     }
                   2338:     my $starttime = Time::HiRes::time;
                   2339:     my $rows_retrieved = 0;
                   2340:     my $sth = $dbh->prepare($request);
                   2341:     $sth->execute();
                   2342:     if ($sth->err()) {
                   2343:         &Apache::lonnet::logthis("Unable to execute MySQL request:");
                   2344:         &Apache::lonnet::logthis("\n".$request."\n");
                   2345:         &Apache::lonnet::logthis("error is:".$sth->errstr());
                   2346:         return undef;
                   2347:     }
                   2348:     foreach my $row (@{$sth->fetchall_arrayref}) {
                   2349:         $rows_retrieved++;
                   2350:         my ($symb,$part,$solved,$tries,$awarded,$award,$awarddetail,$time) = 
                   2351:             (@$row);
                   2352:         my $base = 'resource.'.$part;
                   2353:         $studentdata->{$symb}->{$base.'.solved'}  = $solved;
                   2354:         $studentdata->{$symb}->{$base.'.tries'}   = $tries;
                   2355:         $studentdata->{$symb}->{$base.'.awarded'} = $awarded;
                   2356:         $studentdata->{$symb}->{$base.'.award'}   = $award;
                   2357:         $studentdata->{$symb}->{$base.'.awarddetail'} = $awarddetail;
                   2358:         $studentdata->{$symb}->{'timestamp'} = $time if (defined($time) && $time ne '');
                   2359:     }
                   2360:     &Apache::lonnet::logthis('retrieve took: '.(Time::HiRes::time - $starttime).' for '.$rows_retrieved);
                   2361:     return $studentdata;
                   2362: }
                   2363: 
                   2364: ################################################
                   2365: ################################################
                   2366: 
                   2367: =pod
                   2368: 
                   2369: =item &get_current_state()
                   2370: 
                   2371: Input: $sname,$sdom,$symb,$courseid
                   2372: 
                   2373: Output: Described below
1.46      matthew  2374: 
1.47      matthew  2375: Retrieve the current status of a students performance.  $sname and
1.46      matthew  2376: $sdom are the only required parameters.  If $symb is undef the results
1.47      matthew  2377: of an &Apache::lonnet::currentdump() will be returned.  
1.46      matthew  2378: If $courseid is undef it will be retrieved from the environment.
                   2379: 
                   2380: The return structure is based on &Apache::lonnet::currentdump.  If
                   2381: $symb is unspecified, all the students data is returned in a hash of
                   2382: the form:
                   2383: ( 
                   2384:   symb1 => { param1 => value1, param2 => value2 ... },
                   2385:   symb2 => { param1 => value1, param2 => value2 ... },
                   2386: )
                   2387: 
                   2388: If $symb is specified, a hash of 
                   2389: (
                   2390:   param1 => value1, 
                   2391:   param2 => value2,
                   2392: )
                   2393: is returned.
                   2394: 
1.57      matthew  2395: If no data is found for $symb, or if the student has no performance data,
1.46      matthew  2396: an empty list is returned.
                   2397: 
                   2398: =cut
                   2399: 
                   2400: ################################################
                   2401: ################################################
                   2402: sub get_current_state {
1.47      matthew  2403:     my ($sname,$sdom,$symb,$courseid,$forcedownload)=@_;
1.57      matthew  2404:     if ($current_course ne $courseid) {
                   2405:         # Clear out variables
                   2406:         undef(%ids_by_part);
                   2407:         undef(%parts_by_id);
                   2408:         undef(%ids_by_symb);
                   2409:         undef(%symbs_by_id);
                   2410:         undef(%ids_by_student);
                   2411:         undef(%students_by_id);
                   2412:         $current_course = $courseid;
                   2413:     }
1.47      matthew  2414:     return () if (! defined($sname) || ! defined($sdom));
                   2415:     #
1.46      matthew  2416:     $courseid = $ENV{'request.course.id'} if (! defined($courseid));
1.47      matthew  2417:     #
1.57      matthew  2418:     my ($status,$data) = &ensure_current_data($sname,$sdom,$courseid);
1.47      matthew  2419:     #
1.57      matthew  2420:     if (defined($data)) {
                   2421:         return %$data;
                   2422:     } elsif ($status eq 'no data') {
                   2423:         return ();
                   2424:     } else {
                   2425:         if ($status ne 'okay' && $status ne '') {
                   2426:             &Apache::lonnet::logthis('status = '.$status);
1.47      matthew  2427:             return ();
                   2428:         }
1.57      matthew  2429:         my $returnhash = &get_student_data_from_performance_cache($sname,$sdom,
                   2430:                                                       $symb,$courseid);
                   2431:         return %$returnhash if (defined($returnhash));
1.46      matthew  2432:     }
1.57      matthew  2433:     return ();
1.3       stredwic 2434: }
1.1       stredwic 2435: 
1.35      matthew  2436: ################################################
                   2437: ################################################
                   2438: 
                   2439: =pod
                   2440: 
1.57      matthew  2441: =back
                   2442: 
                   2443: =item End of Local Data Caching Subroutines
                   2444: 
                   2445: =cut
                   2446: 
                   2447: ################################################
                   2448: ################################################
                   2449: 
                   2450: 
                   2451: }
                   2452: ################################################
                   2453: ################################################
                   2454: 
                   2455: =pod
                   2456: 
                   2457: =head3 Classlist Subroutines
                   2458: 
1.35      matthew  2459: =item &get_classlist();
                   2460: 
                   2461: Retrieve the classist of a given class or of the current class.  Student
                   2462: information is returned from the classlist.db file and, if needed,
                   2463: from the students environment.
                   2464: 
                   2465: Optional arguments are $cid, $cdom, and $cnum (course id, course domain,
                   2466: and course number, respectively).  Any omitted arguments will be taken 
                   2467: from the current environment ($ENV{'request.course.id'},
                   2468: $ENV{'course.'.$cid.'.domain'}, and $ENV{'course.'.$cid.'.num'}).
                   2469: 
                   2470: Returns a reference to a hash which contains:
                   2471:  keys    '$sname:$sdom'
1.54      bowersj2 2472:  values  [$sdom,$sname,$end,$start,$id,$section,$fullname,$status]
                   2473: 
                   2474: The constant values CL_SDOM, CL_SNAME, CL_END, etc. can be used
                   2475: as indices into the returned list to future-proof clients against
                   2476: changes in the list order.
1.35      matthew  2477: 
                   2478: =cut
                   2479: 
                   2480: ################################################
                   2481: ################################################
1.54      bowersj2 2482: 
                   2483: sub CL_SDOM     { return 0; }
                   2484: sub CL_SNAME    { return 1; }
                   2485: sub CL_END      { return 2; }
                   2486: sub CL_START    { return 3; }
                   2487: sub CL_ID       { return 4; }
                   2488: sub CL_SECTION  { return 5; }
                   2489: sub CL_FULLNAME { return 6; }
                   2490: sub CL_STATUS   { return 7; }
1.35      matthew  2491: 
                   2492: sub get_classlist {
                   2493:     my ($cid,$cdom,$cnum) = @_;
                   2494:     $cid = $cid || $ENV{'request.course.id'};
                   2495:     $cdom = $cdom || $ENV{'course.'.$cid.'.domain'};
                   2496:     $cnum = $cnum || $ENV{'course.'.$cid.'.num'};
1.57      matthew  2497:     my $now = time;
1.35      matthew  2498:     #
                   2499:     my %classlist=&Apache::lonnet::dump('classlist',$cdom,$cnum);
                   2500:     while (my ($student,$info) = each(%classlist)) {
                   2501:         return undef if ($student =~ /^(con_lost|error|no_such_host)/i);
                   2502:         my ($sname,$sdom) = split(/:/,$student);
                   2503:         my @Values = split(/:/,$info);
                   2504:         my ($end,$start,$id,$section,$fullname);
                   2505:         if (@Values > 2) {
                   2506:             ($end,$start,$id,$section,$fullname) = @Values;
                   2507:         } else { # We have to get the data ourselves
                   2508:             ($end,$start) = @Values;
1.37      matthew  2509:             $section = &Apache::lonnet::getsection($sdom,$sname,$cid);
1.35      matthew  2510:             my %info=&Apache::lonnet::get('environment',
                   2511:                                           ['firstname','middlename',
                   2512:                                            'lastname','generation','id'],
                   2513:                                           $sdom, $sname);
                   2514:             my ($tmp) = keys(%info);
                   2515:             if ($tmp =~/^(con_lost|error|no_such_host)/i) {
                   2516:                 $fullname = 'not available';
                   2517:                 $id = 'not available';
1.38      matthew  2518:                 &Apache::lonnet::logthis('unable to retrieve environment '.
                   2519:                                          'for '.$sname.':'.$sdom);
1.35      matthew  2520:             } else {
                   2521:                 $fullname = &ProcessFullName(@info{qw/lastname generation 
                   2522:                                                        firstname middlename/});
                   2523:                 $id = $info{'id'};
                   2524:             }
1.36      matthew  2525:             # Update the classlist with this students information
                   2526:             if ($fullname ne 'not available') {
                   2527:                 my $enrolldata = join(':',$end,$start,$id,$section,$fullname);
                   2528:                 my $reply=&Apache::lonnet::cput('classlist',
                   2529:                                                 {$student => $enrolldata},
                   2530:                                                 $cdom,$cnum);
                   2531:                 if ($reply !~ /^(ok|delayed)/) {
                   2532:                     &Apache::lonnet::logthis('Unable to update classlist for '.
                   2533:                                              'student '.$sname.':'.$sdom.
                   2534:                                              ' error:'.$reply);
                   2535:                 }
                   2536:             }
1.35      matthew  2537:         }
                   2538:         my $status='Expired';
                   2539:         if(((!$end) || $now < $end) && ((!$start) || ($now > $start))) {
                   2540:             $status='Active';
                   2541:         }
                   2542:         $classlist{$student} = 
                   2543:             [$sdom,$sname,$end,$start,$id,$section,$fullname,$status];
                   2544:     }
                   2545:     if (wantarray()) {
                   2546:         return (\%classlist,['domain','username','end','start','id',
                   2547:                              'section','fullname','status']);
                   2548:     } else {
                   2549:         return \%classlist;
                   2550:     }
                   2551: }
                   2552: 
1.1       stredwic 2553: # ----- END HELPER FUNCTIONS --------------------------------------------
                   2554: 
                   2555: 1;
                   2556: __END__
1.36      matthew  2557: 
1.35      matthew  2558: 

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