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

1.1       stredwic    1: # The LearningOnline Network with CAPA
                      2: # (Publication Handler
                      3: #
1.15    ! stredwic    4: # $Id: loncoursedata.pm,v 1.14 2002/08/14 13:13:37 stredwic Exp $
1.1       stredwic    5: #
                      6: # Copyright Michigan State University Board of Trustees
                      7: #
                      8: # This file is part of the LearningOnline Network with CAPA (LON-CAPA).
                      9: #
                     10: # LON-CAPA is free software; you can redistribute it and/or modify
                     11: # it under the terms of the GNU General Public License as published by
                     12: # the Free Software Foundation; either version 2 of the License, or
                     13: # (at your option) any later version.
                     14: #
                     15: # LON-CAPA is distributed in the hope that it will be useful,
                     16: # but WITHOUT ANY WARRANTY; without even the implied warranty of
                     17: # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
                     18: # GNU General Public License for more details.
                     19: #
                     20: # You should have received a copy of the GNU General Public License
                     21: # along with LON-CAPA; if not, write to the Free Software
                     22: # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
                     23: #
                     24: # /home/httpd/html/adm/gpl.txt
                     25: #
                     26: # http://www.lon-capa.org/
                     27: #
                     28: ###
                     29: 
                     30: =pod
                     31: 
                     32: =head1 NAME
                     33: 
                     34: loncoursedata
                     35: 
                     36: =head1 SYNOPSIS
                     37: 
                     38: Set of functions that download and process student information.
                     39: 
                     40: =head1 PACKAGES USED
                     41: 
                     42:  Apache::Constants qw(:common :http)
                     43:  Apache::lonnet()
                     44:  HTML::TokeParser
                     45:  GDBM_File
                     46: 
                     47: =cut
                     48: 
                     49: package Apache::loncoursedata;
                     50: 
                     51: use strict;
                     52: use Apache::Constants qw(:common :http);
                     53: use Apache::lonnet();
1.13      stredwic   54: use Apache::lonhtmlcommon;
1.1       stredwic   55: use HTML::TokeParser;
                     56: use GDBM_File;
                     57: 
                     58: =pod
                     59: 
                     60: =head1 DOWNLOAD INFORMATION
                     61: 
                     62: This section contains all the files that get data from other servers 
                     63: and/or itself.  There is one function that has a call to get remote
                     64: information but isn't included here which is ProcessTopLevelMap.  The
                     65: usage was small enough to be ignored, but that portion may be moved
                     66: here in the future.
                     67: 
                     68: =cut
                     69: 
                     70: # ----- DOWNLOAD INFORMATION -------------------------------------------
                     71: 
                     72: =pod
                     73: 
1.3       stredwic   74: =item &DownloadClasslist()
1.1       stredwic   75: 
                     76: Collects lastname, generation, middlename, firstname, PID, and section for each
                     77: student from their environment database.  The list of students is built from
                     78: collecting a classlist for the course that is to be displayed.
                     79: 
                     80: =over 4
                     81: 
                     82: Input: $courseID, $c
                     83: 
                     84: $courseID:  The id of the course
                     85: 
                     86: $c: The connection class that can determine if the browser has aborted.  It
                     87: is used to short circuit this function so that it doesn't continue to 
                     88: get information when there is no need.
                     89: 
                     90: Output: \%classlist
                     91: 
                     92: \%classlist: A pointer to a hash containing the following data:
                     93: 
                     94: -A list of student name:domain (as keys) (known below as $name)
                     95: 
                     96: -A hash pointer for each student containing lastname, generation, firstname,
                     97: middlename, and PID : Key is $name.'studentInformation'
                     98: 
                     99: -A hash pointer to each students section data : Key is $name.section
                    100: 
                    101: =back
                    102: 
                    103: =cut
                    104: 
1.3       stredwic  105: sub DownloadClasslist {
                    106:     my ($courseID, $lastDownloadTime, $c)=@_;
1.1       stredwic  107:     my ($courseDomain,$courseNumber)=split(/\_/,$courseID);
1.3       stredwic  108:     my %classlist;
1.1       stredwic  109: 
1.7       stredwic  110:     my $modifiedTime = &GetFileTimestamp($courseDomain, $courseNumber,
                    111:                                      'classlist.db', 
                    112:                                      $Apache::lonnet::perlvar{'lonUsersDir'});
                    113: 
                    114:     if($lastDownloadTime ne 'Not downloaded' &&
                    115:        $lastDownloadTime >= $modifiedTime && $modifiedTime >= 0) {
                    116:         $classlist{'lastDownloadTime'}=time;
                    117:         $classlist{'UpToDate'} = 'true';
                    118:         return \%classlist;
                    119:     }
1.3       stredwic  120: 
                    121:     %classlist=&Apache::lonnet::dump('classlist',$courseDomain, $courseNumber);
1.1       stredwic  122:     my ($checkForError)=keys (%classlist);
                    123:     if($checkForError =~ /^(con_lost|error|no_such_host)/i) {
                    124:         return \%classlist;
                    125:     }
                    126: 
                    127:     foreach my $name (keys(%classlist)) {
                    128:         if($c->aborted()) {
                    129:             $classlist{'error'}='aborted';
                    130:             return \%classlist;
                    131:         }
                    132: 
                    133:         my ($studentName,$studentDomain) = split(/\:/,$name);
                    134:         # Download student environment data, specifically the full name and id.
                    135:         my %studentInformation=&Apache::lonnet::get('environment',
                    136:                                                     ['lastname','generation',
                    137:                                                      'firstname','middlename',
                    138:                                                      'id'],
                    139:                                                     $studentDomain,
                    140:                                                     $studentName);
                    141:         $classlist{$name.':studentInformation'}=\%studentInformation;
                    142: 
                    143:         if($c->aborted()) {
                    144:             $classlist{'error'}='aborted';
                    145:             return \%classlist;
                    146:         }
                    147: 
                    148:         #Section
                    149:         my %section=&Apache::lonnet::dump('roles',$studentDomain,$studentName);
1.3       stredwic  150:         $classlist{$name.':sections'}=\%section;
1.1       stredwic  151:     }
                    152: 
1.3       stredwic  153:     $classlist{'UpToDate'} = 'false';
                    154:     $classlist{'lastDownloadTime'}=time;
                    155: 
1.1       stredwic  156:     return \%classlist;
                    157: }
                    158: 
                    159: =pod
                    160: 
1.4       stredwic  161: =item &DownloadCourseInformation()
1.1       stredwic  162: 
                    163: Dump of all the course information for a single student.  There is no
1.3       stredwic  164: pruning of data, it is all stored in a hash and returned.  It also
                    165: checks the timestamp of the students course database file and only downloads
                    166: if it has been modified since the last download.
1.1       stredwic  167: 
                    168: =over 4
                    169: 
                    170: Input: $name, $courseID
                    171: 
                    172: $name: student name:domain
                    173: 
                    174: $courseID:  The id of the course
                    175: 
                    176: Output: \%courseData
                    177: 
                    178: \%courseData:  A hash pointer to the raw data from the student's course
                    179: database.
                    180: 
                    181: =back
                    182: 
                    183: =cut
                    184: 
1.4       stredwic  185: sub DownloadCourseInformation {
1.12      stredwic  186:     my ($namedata,$courseID,$lastDownloadTime,$WhatIWant)=@_;
1.3       stredwic  187:     my %courseData;
1.4       stredwic  188:     my ($name,$domain) = split(/\:/,$namedata);
1.1       stredwic  189: 
1.7       stredwic  190:     my $modifiedTime = &GetFileTimestamp($domain, $name,
                    191:                                       $courseID.'.db', 
                    192:                                       $Apache::lonnet::perlvar{'lonUsersDir'});
                    193: 
1.13      stredwic  194:     if($lastDownloadTime >= $modifiedTime && $modifiedTime >= 0) {
                    195:         $courseData{$namedata.':lastDownloadTime'}=time;
                    196:         $courseData{$namedata.':UpToDate'} = 'true';
1.7       stredwic  197:         return \%courseData;
                    198:     }
1.3       stredwic  199: 
1.4       stredwic  200:     # Download course data
1.12      stredwic  201:     if(!defined($WhatIWant)) {
                    202:         $WhatIWant = '.';
                    203:     }
                    204:     %courseData=&Apache::lonnet::dump($courseID, $domain, $name, $WhatIWant);
1.3       stredwic  205:     $courseData{'UpToDate'} = 'false';
                    206:     $courseData{'lastDownloadTime'}=time;
1.13      stredwic  207: 
                    208:     my %newData;
                    209:     foreach (keys(%courseData)) {
                    210:         $newData{$namedata.':'.$_} = $courseData{$_};
                    211:     }
                    212: 
                    213:     return \%newData;
1.1       stredwic  214: }
                    215: 
                    216: # ----- END DOWNLOAD INFORMATION ---------------------------------------
                    217: 
                    218: =pod
                    219: 
                    220: =head1 PROCESSING FUNCTIONS
                    221: 
                    222: These functions process all the data for all the students.  Also, they
                    223: are the only functions that access the cache database for writing.  Thus
                    224: they are the only functions that cache data.  The downloading and caching
                    225: were separated to reduce problems with stopping downloading then can't
                    226: tie hash to database later.
                    227: 
                    228: =cut
                    229: 
                    230: # ----- PROCESSING FUNCTIONS ---------------------------------------
                    231: 
                    232: =pod
                    233: 
                    234: =item &ProcessTopResourceMap()
                    235: 
                    236: Trace through the "big hash" created in rat/lonuserstate.pm::loadmap.  
                    237: Basically, this function organizes a subset of the data and stores it in
                    238: cached data.  The data stored is the problems, sequences, sequence titles,
                    239: parts of problems, and their ordering.  Column width information is also 
                    240: partially handled here on a per sequence basis.
                    241: 
                    242: =over 4
                    243: 
                    244: Input: $cache, $c
                    245: 
                    246: $cache:  A pointer to a hash to store the information
                    247: 
                    248: $c:  The connection class used to determine if an abort has been sent to the 
                    249: browser
                    250: 
                    251: Output: A string that contains an error message or "OK" if everything went 
                    252: smoothly.
                    253: 
                    254: =back
                    255: 
                    256: =cut
                    257: 
                    258: sub ProcessTopResourceMap {
1.11      stredwic  259:     my ($cache,$c)=@_;
1.1       stredwic  260:     my %hash;
                    261:     my $fn=$ENV{'request.course.fn'};
                    262:     if(-e "$fn.db") {
                    263: 	my $tieTries=0;
                    264: 	while($tieTries < 3) {
                    265:             if($c->aborted()) {
                    266:                 return;
                    267:             }
1.10      stredwic  268: 	    if(tie(%hash,'GDBM_File',"$fn.db",&GDBM_READER(),0640)) {
1.1       stredwic  269: 		last;
                    270: 	    }
                    271: 	    $tieTries++;
                    272: 	    sleep 1;
                    273: 	}
                    274: 	if($tieTries >= 3) {
                    275:             return 'Coursemap undefined.';
                    276:         }
                    277:     } else {
                    278:         return 'Can not open Coursemap.';
                    279:     }
                    280: 
                    281:     # Initialize state machine.  Set information pointing to top level map.
                    282:     my (@sequences, @currentResource, @finishResource);
                    283:     my ($currentSequence, $currentResourceID, $lastResourceID);
                    284: 
                    285:     $currentResourceID=$hash{'ids_/res/'.$ENV{'request.course.uri'}};
                    286:     push(@currentResource, $currentResourceID);
                    287:     $lastResourceID=-1;
                    288:     $currentSequence=-1;
                    289:     my $topLevelSequenceNumber = $currentSequence;
                    290: 
1.11      stredwic  291:     my %sequenceRecord;
1.1       stredwic  292:     while(1) {
                    293:         if($c->aborted()) {
                    294:             last;
                    295:         }
                    296: 	# HANDLE NEW SEQUENCE!
                    297: 	#if page || sequence
1.11      stredwic  298: 	if(defined($hash{'map_pc_'.$hash{'src_'.$currentResourceID}}) &&
                    299:            !defined($sequenceRecord{$currentResourceID})) {
                    300:             $sequenceRecord{$currentResourceID}++;
1.1       stredwic  301: 	    push(@sequences, $currentSequence);
                    302: 	    push(@currentResource, $currentResourceID);
                    303: 	    push(@finishResource, $lastResourceID);
                    304: 
                    305: 	    $currentSequence=$hash{'map_pc_'.$hash{'src_'.$currentResourceID}};
                    306: 
                    307:             # Mark sequence as containing problems.  If it doesn't, then
                    308:             # it will be removed when processing for this sequence is
                    309:             # complete.  This allows the problems in a sequence
                    310:             # to be outputed before problems in the subsequences
                    311:             if(!defined($cache->{'orderedSequences'})) {
                    312:                 $cache->{'orderedSequences'}=$currentSequence;
                    313:             } else {
                    314:                 $cache->{'orderedSequences'}.=':'.$currentSequence;
                    315:             }
                    316: 
                    317: 	    $lastResourceID=$hash{'map_finish_'.
                    318: 				  $hash{'src_'.$currentResourceID}};
                    319: 	    $currentResourceID=$hash{'map_start_'.
                    320: 				     $hash{'src_'.$currentResourceID}};
                    321: 
                    322: 	    if(!($currentResourceID) || !($lastResourceID)) {
                    323: 		$currentSequence=pop(@sequences);
                    324: 		$currentResourceID=pop(@currentResource);
                    325: 		$lastResourceID=pop(@finishResource);
                    326: 		if($currentSequence eq $topLevelSequenceNumber) {
                    327: 		    last;
                    328: 		}
                    329: 	    }
1.12      stredwic  330:             next;
1.1       stredwic  331: 	}
                    332: 
                    333: 	# Handle gradable resources: exams, problems, etc
                    334: 	$currentResourceID=~/(\d+)\.(\d+)/;
                    335:         my $partA=$1;
                    336:         my $partB=$2;
                    337: 	if($hash{'src_'.$currentResourceID}=~
                    338: 	   /\.(problem|exam|quiz|assess|survey|form)$/ &&
1.11      stredwic  339: 	   $partA eq $currentSequence && 
                    340:            !defined($sequenceRecord{$currentSequence.':'.
                    341:                                     $currentResourceID})) {
                    342:             $sequenceRecord{$currentSequence.':'.$currentResourceID}++;
1.1       stredwic  343: 	    my $Problem = &Apache::lonnet::symbclean(
                    344: 			  &Apache::lonnet::declutter($hash{'map_id_'.$partA}).
                    345: 			  '___'.$partB.'___'.
                    346: 			  &Apache::lonnet::declutter($hash{'src_'.
                    347: 							 $currentResourceID}));
                    348: 
                    349: 	    $cache->{$currentResourceID.':problem'}=$Problem;
                    350: 	    if(!defined($cache->{$currentSequence.':problems'})) {
                    351: 		$cache->{$currentSequence.':problems'}=$currentResourceID;
                    352: 	    } else {
                    353: 		$cache->{$currentSequence.':problems'}.=
                    354: 		    ':'.$currentResourceID;
                    355: 	    }
                    356: 
1.2       stredwic  357: 	    my $meta=$hash{'src_'.$currentResourceID};
                    358: #            $cache->{$currentResourceID.':title'}=
                    359: #                &Apache::lonnet::metdata($meta,'title');
                    360:             $cache->{$currentResourceID.':title'}=
                    361:                 $hash{'title_'.$currentResourceID};
1.9       minaeibi  362:             $cache->{$currentResourceID.':source'}=
                    363:                 $hash{'src_'.$currentResourceID};
1.2       stredwic  364: 
1.1       stredwic  365:             # Get Parts for problem
1.8       stredwic  366:             my %beenHere;
                    367:             foreach (split(/\,/,&Apache::lonnet::metadata($meta,'packages'))) {
                    368:                 if(/^\w+response_\d+.*/) {
                    369:                     my (undef, $partId, $responseId) = split(/_/,$_);
                    370:                     if($beenHere{'p:'.$partId} ==  0) {
                    371:                         $beenHere{'p:'.$partId}++;
                    372:                         if(!defined($cache->{$currentSequence.':'.
                    373:                                             $currentResourceID.':parts'})) {
                    374:                             $cache->{$currentSequence.':'.$currentResourceID.
                    375:                                      ':parts'}=$partId;
                    376:                         } else {
                    377:                             $cache->{$currentSequence.':'.$currentResourceID.
                    378:                                      ':parts'}.=':'.$partId;
                    379:                         }
                    380:                     }
                    381:                     if($beenHere{'r:'.$partId.':'.$responseId} == 0) {
                    382:                         $beenHere{'r:'.$partId.':'.$responseId}++;
                    383:                         if(!defined($cache->{$currentSequence.':'.
                    384:                                              $currentResourceID.':'.$partId.
                    385:                                              ':responseIDs'})) {
                    386:                             $cache->{$currentSequence.':'.$currentResourceID.
                    387:                                      ':'.$partId.':responseIDs'}=$responseId;
                    388:                         } else {
                    389:                             $cache->{$currentSequence.':'.$currentResourceID.
                    390:                                      ':'.$partId.':responseIDs'}.=':'.
                    391:                                                                   $responseId;
                    392:                         }
1.1       stredwic  393:                     }
1.8       stredwic  394:                     if(/^optionresponse/ && 
                    395:                        $beenHere{'o:'.$partId.':'.$currentResourceID} == 0) {
                    396:                         $beenHere{'o:'.$partId.$currentResourceID}++;
                    397:                         if(defined($cache->{'OptionResponses'})) {
                    398:                             $cache->{'OptionResponses'}.= ':::'.
                    399:                                 $currentResourceID.':'.
                    400:                                 $partId.':'.$responseId;
                    401:                         } else {
                    402:                             $cache->{'OptionResponses'}= $currentResourceID.
                    403:                                 ':'.$partId.':'.$responseId;
1.2       stredwic  404:                         }
                    405:                     }
                    406:                 }
1.8       stredwic  407:             }
                    408:         }
1.1       stredwic  409: 
                    410: 	# if resource == finish resource, then it is the end of a sequence/page
                    411: 	if($currentResourceID eq $lastResourceID) {
                    412: 	    # pop off last resource of sequence
                    413: 	    $currentResourceID=pop(@currentResource);
                    414: 	    $lastResourceID=pop(@finishResource);
                    415: 
                    416: 	    if(defined($cache->{$currentSequence.':problems'})) {
                    417: 		# Capture sequence information here
                    418: 		$cache->{$currentSequence.':title'}=
                    419: 		    $hash{'title_'.$currentResourceID};
1.2       stredwic  420:                 $cache->{$currentSequence.':source'}=
                    421:                     $hash{'src_'.$currentResourceID};
1.1       stredwic  422: 
                    423:                 my $totalProblems=0;
                    424:                 foreach my $currentProblem (split(/\:/,
                    425:                                                $cache->{$currentSequence.
                    426:                                                ':problems'})) {
                    427:                     foreach (split(/\:/,$cache->{$currentSequence.':'.
                    428:                                                    $currentProblem.
                    429:                                                    ':parts'})) {
                    430:                         $totalProblems++;
                    431:                     }
                    432:                 }
                    433: 		my @titleLength=split(//,$cache->{$currentSequence.
                    434:                                                     ':title'});
                    435:                 # $extra is 3 for problems correct and 3 for space
                    436:                 # between problems correct and problem output
                    437:                 my $extra = 6;
                    438: 		if(($totalProblems + $extra) > (scalar @titleLength)) {
                    439: 		    $cache->{$currentSequence.':columnWidth'}=
                    440:                         $totalProblems + $extra;
                    441: 		} else {
                    442: 		    $cache->{$currentSequence.':columnWidth'}=
                    443:                         (scalar @titleLength);
                    444: 		}
                    445: 	    } else {
                    446:                 # Remove sequence from list, if it contains no problems to
                    447:                 # display.
                    448:                 $cache->{'orderedSequences'}=~s/$currentSequence//;
                    449:                 $cache->{'orderedSequences'}=~s/::/:/g;
                    450:                 $cache->{'orderedSequences'}=~s/^:|:$//g;
                    451:             }
                    452: 
                    453: 	    $currentSequence=pop(@sequences);
                    454: 	    if($currentSequence eq $topLevelSequenceNumber) {
                    455: 		last;
                    456: 	    }
1.11      stredwic  457:         }
1.1       stredwic  458: 
                    459: 	# MOVE!!!
                    460: 	# move to next resource
                    461: 	unless(defined($hash{'to_'.$currentResourceID})) {
                    462: 	    # big problem, need to handle.  Next is probably wrong
1.11      stredwic  463:             my $errorMessage = 'Big problem in ';
                    464:             $errorMessage .= 'loncoursedata::ProcessTopLevelMap.';
                    465:             $errorMessage .= '  bighash to_$currentResourceID not defined!';
                    466:             &Apache::lonnet::logthis($errorMessage);
1.1       stredwic  467: 	    last;
                    468: 	}
                    469: 	my @nextResources=();
                    470: 	foreach (split(/\,/,$hash{'to_'.$currentResourceID})) {
1.11      stredwic  471:             if(!defined($sequenceRecord{$currentSequence.':'.
                    472:                                         $hash{'goesto_'.$_}})) {
                    473:                 push(@nextResources, $hash{'goesto_'.$_});
                    474:             }
1.1       stredwic  475: 	}
                    476: 	push(@currentResource, @nextResources);
                    477: 	# Set the next resource to be processed
                    478: 	$currentResourceID=pop(@currentResource);
                    479:     }
                    480: 
                    481:     unless (untie(%hash)) {
                    482:         &Apache::lonnet::logthis("<font color=blue>WARNING: ".
                    483:                                  "Could not untie coursemap $fn (browse)".
                    484:                                  ".</font>"); 
                    485:     }
                    486: 
                    487:     return 'OK';
                    488: }
                    489: 
                    490: =pod
                    491: 
1.3       stredwic  492: =item &ProcessClasslist()
1.1       stredwic  493: 
1.3       stredwic  494: Taking the class list dumped from &DownloadClasslist(), all the 
1.1       stredwic  495: students and their non-class information is processed using the 
                    496: &ProcessStudentInformation() function.  A date stamp is also recorded for
                    497: when the data was processed.
                    498: 
1.3       stredwic  499: Takes data downloaded for a student and breaks it up into managable pieces and 
                    500: stored in cache data.  The username, domain, class related date, PID, 
                    501: full name, and section are all processed here.
                    502: 
                    503: 
1.1       stredwic  504: =over 4
                    505: 
                    506: Input: $cache, $classlist, $courseID, $ChartDB, $c
                    507: 
                    508: $cache: A hash pointer to store the data
                    509: 
                    510: $classlist:  The hash of data collected about a student from 
1.3       stredwic  511: &DownloadClasslist().  The hash contains a list of students, a pointer 
1.1       stredwic  512: to a hash of student information for each student, and each student's section 
                    513: number.
                    514: 
                    515: $courseID:  The course ID
                    516: 
                    517: $ChartDB:  The name of the cache database file.
                    518: 
                    519: $c:  The connection class used to determine if an abort has been sent to the 
                    520: browser
                    521: 
                    522: Output: @names
                    523: 
                    524: @names:  An array of students whose information has been processed, and are to 
                    525: be considered in an arbitrary order.
                    526: 
                    527: =back
                    528: 
                    529: =cut
                    530: 
1.3       stredwic  531: sub ProcessClasslist {
                    532:     my ($cache,$classlist,$courseID,$c)=@_;
1.1       stredwic  533:     my @names=();
                    534: 
1.3       stredwic  535:     $cache->{'ClasslistTimeStamp'}=$classlist->{'lastDownloadTime'};
                    536:     if($classlist->{'UpToDate'} eq 'true') {
                    537:         return split(/:::/,$cache->{'NamesOfStudents'});;
                    538:     }
                    539: 
1.1       stredwic  540:     foreach my $name (keys(%$classlist)) {
                    541:         if($name =~ /\:section/ || $name =~ /\:studentInformation/ ||
1.3       stredwic  542:            $name eq '' || $name eq 'UpToDate' || $name eq 'lastDownloadTime') {
1.1       stredwic  543:             next;
                    544:         }
                    545:         if($c->aborted()) {
1.3       stredwic  546:             return ();
1.1       stredwic  547:         }
                    548:         push(@names,$name);
1.3       stredwic  549:         my $studentInformation = $classlist->{$name.':studentInformation'},
                    550:         my $sectionData = $classlist->{$name.':sections'},
                    551:         my $date = $classlist->{$name},
                    552:         my ($studentName,$studentDomain) = split(/\:/,$name);
                    553: 
                    554:         $cache->{$name.':username'}=$studentName;
                    555:         $cache->{$name.':domain'}=$studentDomain;
1.10      stredwic  556:         # Initialize timestamp for student
1.3       stredwic  557:         if(!defined($cache->{$name.':lastDownloadTime'})) {
                    558:             $cache->{$name.':lastDownloadTime'}='Not downloaded';
1.6       stredwic  559:             $cache->{$name.':updateTime'}=' Not updated';
1.3       stredwic  560:         }
                    561: 
                    562:         my ($checkForError)=keys(%$studentInformation);
                    563:         if($checkForError =~ /^(con_lost|error|no_such_host)/i) {
                    564:             $cache->{$name.':error'}=
                    565:                 'Could not download student environment data.';
                    566:             $cache->{$name.':fullname'}='';
                    567:             $cache->{$name.':id'}='';
                    568:         } else {
                    569:             $cache->{$name.':fullname'}=&ProcessFullName(
                    570:                                           $studentInformation->{'lastname'},
                    571:                                           $studentInformation->{'generation'},
                    572:                                           $studentInformation->{'firstname'},
                    573:                                           $studentInformation->{'middlename'});
                    574:             $cache->{$name.':id'}=$studentInformation->{'id'};
                    575:         }
                    576: 
                    577:         my ($end, $start)=split(':',$date);
                    578:         $courseID=~s/\_/\//g;
                    579:         $courseID=~s/^(\w)/\/$1/;
                    580: 
                    581:         my $sec='';
                    582:         foreach my $key (keys (%$sectionData)) {
                    583:             my $value = $sectionData->{$key};
                    584:             if ($key=~/^$courseID(?:\/)*(\w+)*\_st$/) {
                    585:                 my $tempsection=$1;
                    586:                 if($key eq $courseID.'_st') {
                    587:                     $tempsection='';
                    588:                 }
                    589:                 my ($dummy,$roleend,$rolestart)=split(/\_/,$value);
                    590:                 if($roleend eq $end && $rolestart eq $start) {
                    591:                     $sec = $tempsection;
                    592:                     last;
                    593:                 }
                    594:             }
                    595:         }
                    596: 
                    597:         my $status='Expired';
                    598:         if(((!$end) || time < $end) && ((!$start) || (time > $start))) {
                    599:             $status='Active';
                    600:         }
                    601:         $cache->{$name.':Status'}=$status;
                    602:         $cache->{$name.':section'}=$sec;
1.7       stredwic  603: 
                    604:         if($sec eq '' || !defined($sec) || $sec eq ' ') {
                    605:             $sec = 'none';
                    606:         }
                    607:         if(defined($cache->{'sectionList'})) {
                    608:             if($cache->{'sectionList'} !~ /(^$sec:|^$sec$|:$sec$|:$sec:)/) {
                    609:                 $cache->{'sectionList'} .= ':'.$sec;
                    610:             }
                    611:         } else {
                    612:             $cache->{'sectionList'} = $sec;
                    613:         }
1.1       stredwic  614:     }
                    615: 
1.3       stredwic  616:     $cache->{'ClasslistTimestamp'}=time;
                    617:     $cache->{'NamesOfStudents'}=join(':::',@names);
1.1       stredwic  618: 
                    619:     return @names;
                    620: }
                    621: 
                    622: =pod
                    623: 
                    624: =item &ProcessStudentData()
                    625: 
                    626: Takes the course data downloaded for a student in 
1.4       stredwic  627: &DownloadCourseInformation() and breaks it up into key value pairs
1.1       stredwic  628: to be stored in the cached data.  The keys are comprised of the 
                    629: $username:$domain:$keyFromCourseDatabase.  The student username:domain is
                    630: stored away signifying that the student's information has been downloaded and 
                    631: can be reused from cached data.
                    632: 
                    633: =over 4
                    634: 
                    635: Input: $cache, $courseData, $name
                    636: 
                    637: $cache: A hash pointer to store data
                    638: 
                    639: $courseData:  A hash pointer that points to the course data downloaded for a 
                    640: student.
                    641: 
                    642: $name:  username:domain
                    643: 
                    644: Output: None
                    645: 
                    646: *NOTE:  There is no output, but an error message is stored away in the cache 
                    647: data.  This is checked in &FormatStudentData().  The key username:domain:error 
                    648: will only exist if an error occured.  The error is an error from 
1.4       stredwic  649: &DownloadCourseInformation().
1.1       stredwic  650: 
                    651: =back
                    652: 
                    653: =cut
                    654: 
                    655: sub ProcessStudentData {
                    656:     my ($cache,$courseData,$name)=@_;
                    657: 
1.13      stredwic  658:     if(!&CheckDateStampError($courseData, $cache, $name)) {
                    659:         return;
                    660:     }
                    661: 
                    662:     foreach (keys %$courseData) {
                    663:         $cache->{$_}=$courseData->{$_};
                    664:     }
                    665: 
                    666:     return;
                    667: }
                    668: 
                    669: sub ExtractStudentData {
                    670:     my ($input, $output, $data, $name)=@_;
                    671: 
                    672:     if(!&CheckDateStampError($input, $data, $name)) {
1.3       stredwic  673:         return;
                    674:     }
                    675: 
1.13      stredwic  676:     my ($username,$domain)=split(':',$name);
                    677: 
                    678:     my $Version;
                    679:     my $problemsCorrect = 0;
                    680:     my $totalProblems   = 0;
                    681:     my $problemsSolved  = 0;
                    682:     my $numberOfParts   = 0;
1.14      stredwic  683:     my $totalAwarded    = 0;
1.13      stredwic  684:     foreach my $sequence (split(':', $data->{'orderedSequences'})) {
                    685:         foreach my $problemID (split(':', $data->{$sequence.':problems'})) {
                    686:             my $problem = $data->{$problemID.':problem'};
                    687:             my $LatestVersion = $input->{$name.':version:'.$problem};
                    688: 
                    689:             # Output dashes for all the parts of this problem if there
                    690:             # is no version information about the current problem.
                    691:             if(!$LatestVersion) {
                    692:                 foreach my $part (split(/\:/,$data->{$sequence.':'.
                    693:                                                       $problemID.
                    694:                                                       ':parts'})) {
1.15    ! stredwic  695:                     $output->{$name.':'.$problemID.':'.$part.':tries'} = 0;
        !           696:                     $output->{$name.':'.$problemID.':'.$part.':awarded'} = 0;
        !           697:                     $output->{$name.':'.$problemID.':'.$part.':code'} = ' ';
1.13      stredwic  698:                     $totalProblems++;
                    699:                 }
                    700:                 $output->{$name.':'.$problemID.':NoVersion'} = 'true';
                    701:                 next;
                    702:             }
                    703: 
                    704:             my %partData=undef;
                    705:             # Initialize part data, display skips correctly
                    706:             # Skip refers to when a student made no submissions on that
                    707:             # part/problem.
                    708:             foreach my $part (split(/\:/,$data->{$sequence.':'.
                    709:                                                  $problemID.
                    710:                                                  ':parts'})) {
                    711:                 $partData{$part.':tries'}=0;
                    712:                 $partData{$part.':code'}=' ';
                    713:                 $partData{$part.':awarded'}=0;
                    714:                 $partData{$part.':timestamp'}=0;
                    715:                 foreach my $response (split(':', $data->{$sequence.':'.
                    716:                                                          $problemID.':'.
                    717:                                                          $part.':responseIDs'})) {
                    718:                     $partData{$part.':'.$response.':submission'}='';
                    719:                 }
                    720:             }
                    721: 
                    722:             # Looping through all the versions of each part, starting with the
                    723:             # oldest version.  Basically, it gets the most recent 
                    724:             # set of grade data for each part.
                    725:             my @submissions = ();
                    726: 	    for(my $Version=1; $Version<=$LatestVersion; $Version++) {
                    727:                 foreach my $part (split(/\:/,$data->{$sequence.':'.
                    728:                                                      $problemID.
                    729:                                                      ':parts'})) {
                    730: 
                    731:                     if(!defined($input->{"$name:$Version:$problem".
                    732:                                          ":resource.$part.solved"})) {
                    733:                         # No grade for this submission, so skip
                    734:                         next;
                    735:                     }
                    736: 
                    737:                     my $tries=0;
                    738:                     my $code=' ';
                    739:                     my $awarded=0;
                    740: 
                    741:                     $tries = $input->{$name.':'.$Version.':'.$problem.
                    742:                                       ':resource.'.$part.'.tries'};
                    743:                     $awarded = $input->{$name.':'.$Version.':'.$problem.
                    744:                                         ':resource.'.$part.'.awarded'};
                    745: 
                    746:                     $partData{$part.':awarded'}=($awarded) ? $awarded : 0;
                    747:                     $partData{$part.':tries'}=($tries) ? $tries : 0;
                    748: 
                    749:                     $partData{$part.':timestamp'}=$input->{$name.':'.$Version.':'.
                    750:                                                            $problem.
                    751:                                                            ':timestamp'};
                    752:                     if(!$input->{$name.':'.$Version.':'.$problem.':resource.'.$part.
                    753:                                  '.previous'}) {
                    754:                         foreach my $response (split(':',
                    755:                                                    $data->{$sequence.':'.
                    756:                                                            $problemID.':'.
                    757:                                                            $part.':responseIDs'})) {
                    758:                             @submissions=($input->{$name.':'.$Version.':'.
                    759:                                                    $problem.
                    760:                                                    ':resource.'.$part.'.'.
                    761:                                                    $response.'.submission'},
                    762:                                           @submissions);
                    763:                         }
                    764:                     }
                    765: 
                    766:                     my $val = $input->{$name.':'.$Version.':'.$problem.
                    767:                                        ':resource.'.$part.'.solved'};
                    768:                     if    ($val eq 'correct_by_student')   {$code = '*';} 
                    769:                     elsif ($val eq 'correct_by_override')  {$code = '+';}
                    770:                     elsif ($val eq 'incorrect_attempted')  {$code = '.';} 
                    771:                     elsif ($val eq 'incorrect_by_override'){$code = '-';}
                    772:                     elsif ($val eq 'excused')              {$code = 'x';}
                    773:                     elsif ($val eq 'ungraded_attempted')   {$code = '#';}
                    774:                     else                                   {$code = ' ';}
                    775:                     $partData{$part.':code'}=$code;
                    776:                 }
                    777:             }
                    778: 
                    779:             foreach my $part (split(/\:/,$data->{$sequence.':'.$problemID.
                    780:                                                  ':parts'})) {
                    781:                 $output->{$name.':'.$problemID.':'.$part.':wrong'} = 
                    782:                     $partData{$part.':tries'};
                    783: 
                    784:                 if($partData{$part.':code'} eq '*') {
                    785:                     $output->{$name.':'.$problemID.':'.$part.':wrong'}--;
                    786:                     $problemsCorrect++;
                    787:                 } elsif($partData{$part.':code'} eq '+') {
                    788:                     $output->{$name.':'.$problemID.':'.$part.':wrong'}--;
                    789:                     $problemsCorrect++;
                    790:                 }
                    791: 
                    792:                 $output->{$name.':'.$problemID.':'.$part.':tries'} = 
                    793:                     $partData{$part.':tries'};
                    794:                 $output->{$name.':'.$problemID.':'.$part.':code'} =
                    795:                     $partData{$part.':code'};
                    796:                 $output->{$name.':'.$problemID.':'.$part.':awarded'} =
                    797:                     $partData{$part.':awarded'};
1.14      stredwic  798:                 $totalAwarded += $partData{$part.':awarded'};
1.13      stredwic  799:                 $output->{$name.':'.$problemID.':'.$part.':timestamp'} =
                    800:                     $partData{$part.':timestamp'};
                    801:                 foreach my $response (split(':', $data->{$sequence.':'.
                    802:                                                          $problemID.':'.
                    803:                                                          $part.':responseIDs'})) {
                    804:                     $output->{$name.':'.$problemID.':'.$part.':'.$response.
                    805:                               ':submission'}=join(':::',@submissions);
                    806:                 }
1.3       stredwic  807: 
1.13      stredwic  808:                 if($partData{$part.':code'} ne 'x') {
                    809:                     $totalProblems++;
                    810:                 }
                    811:             }
1.1       stredwic  812:         }
1.13      stredwic  813: 
                    814:         $output->{$name.':'.$sequence.':problemsCorrect'} = $problemsCorrect;
                    815:         $problemsSolved += $problemsCorrect;
                    816: 	$problemsCorrect=0;
1.3       stredwic  817:     }
                    818: 
1.13      stredwic  819:     $output->{$name.':problemsSolved'} = $problemsSolved;
                    820:     $output->{$name.':totalProblems'} = $totalProblems;
1.14      stredwic  821:     $output->{$name.':totalAwarded'} = $totalAwarded;
1.1       stredwic  822: 
                    823:     return;
1.4       stredwic  824: }
                    825: 
                    826: sub LoadDiscussion {
1.13      stredwic  827:     my ($courseID)=@_;
1.5       minaeibi  828:     my %Discuss=();
                    829:     my %contrib=&Apache::lonnet::dump(
                    830:                 $courseID,
                    831:                 $ENV{'course.'.$courseID.'.domain'},
                    832:                 $ENV{'course.'.$courseID.'.num'});
                    833: 				 
                    834:     #my %contrib=&DownloadCourseInformation($name, $courseID, 0);
                    835: 
1.4       stredwic  836:     foreach my $temp(keys %contrib) {
                    837: 	if ($temp=~/^version/) {
                    838: 	    my $ver=$contrib{$temp};
                    839: 	    my ($dummy,$prb)=split(':',$temp);
                    840: 	    for (my $idx=1; $idx<=$ver; $idx++ ) {
                    841: 		my $name=$contrib{"$idx:$prb:sendername"};
1.5       minaeibi  842: 		$Discuss{"$name:$prb"}=$idx;	
1.4       stredwic  843: 	    }
                    844: 	}
                    845:     }       
1.5       minaeibi  846: 
                    847:     return \%Discuss;
1.1       stredwic  848: }
                    849: 
                    850: # ----- END PROCESSING FUNCTIONS ---------------------------------------
                    851: 
                    852: =pod
                    853: 
                    854: =head1 HELPER FUNCTIONS
                    855: 
                    856: These are just a couple of functions do various odd and end 
                    857: jobs.
                    858: 
                    859: =cut
                    860: 
                    861: # ----- HELPER FUNCTIONS -----------------------------------------------
                    862: 
1.13      stredwic  863: sub CheckDateStampError {
                    864:     my ($courseData, $cache, $name)=@_;
                    865:     if($courseData->{$name.':UpToDate'} eq 'true') {
                    866:         $cache->{$name.':lastDownloadTime'} = 
                    867:             $courseData->{$name.':lastDownloadTime'};
                    868:         if($courseData->{$name.':lastDownloadTime'} eq 'Not downloaded') {
                    869:             $cache->{$name.':updateTime'} = ' Not updated';
                    870:         } else {
                    871:             $cache->{$name.':updateTime'}=
                    872:                 localtime($courseData->{$name.':lastDownloadTime'});
                    873:         }
                    874:         return 0;
                    875:     }
                    876: 
                    877:     $cache->{$name.':lastDownloadTime'}=$courseData->{$name.':lastDownloadTime'};
                    878:     if($courseData->{$name.':lastDownloadTime'} eq 'Not downloaded') {
                    879:         $cache->{$name.':updateTime'} = ' Not updated';
                    880:     } else {
                    881:         $cache->{$name.':updateTime'}=
                    882:             localtime($courseData->{$name.':lastDownloadTime'});
                    883:     }
                    884: 
                    885:     if(defined($courseData->{$name.':error'})) {
                    886:         $cache->{$name.':error'}=$courseData->{$name.':error'};
                    887:         return 0;
                    888:     }
                    889: 
                    890:     return 1;
                    891: }
                    892: 
1.1       stredwic  893: =pod
                    894: 
                    895: =item &ProcessFullName()
                    896: 
                    897: Takes lastname, generation, firstname, and middlename (or some partial
                    898: set of this data) and returns the full name version as a string.  Format
                    899: is Lastname generation, firstname middlename or a subset of this.
                    900: 
                    901: =cut
                    902: 
                    903: sub ProcessFullName {
                    904:     my ($lastname, $generation, $firstname, $middlename)=@_;
                    905:     my $Str = '';
                    906: 
                    907:     if($lastname ne '') {
                    908: 	$Str .= $lastname.' ';
                    909: 	if($generation ne '') {
                    910: 	    $Str .= $generation;
                    911: 	} else {
                    912: 	    chop($Str);
                    913: 	}
                    914: 	$Str .= ', ';
                    915: 	if($firstname ne '') {
                    916: 	    $Str .= $firstname.' ';
                    917: 	}
                    918: 	if($middlename ne '') {
                    919: 	    $Str .= $middlename;
                    920: 	} else {
                    921: 	    chop($Str);
                    922: 	    if($firstname eq '') {
                    923: 		chop($Str);
                    924: 	    }
                    925: 	}
                    926:     } else {
                    927: 	if($firstname ne '') {
                    928: 	    $Str .= $firstname.' ';
                    929: 	}
                    930: 	if($middlename ne '') {
                    931: 	    $Str .= $middlename.' ';
                    932: 	}
                    933: 	if($generation ne '') {
                    934: 	    $Str .= $generation;
                    935: 	} else {
                    936: 	    chop($Str);
                    937: 	}
                    938:     }
                    939: 
                    940:     return $Str;
                    941: }
                    942: 
                    943: =pod
                    944: 
                    945: =item &TestCacheData()
                    946: 
                    947: Determine if the cache database can be accessed with a tie.  It waits up to
                    948: ten seconds before returning failure.  This function exists to help with
                    949: the problems with stopping the data download.  When an abort occurs and the
                    950: user quickly presses a form button and httpd child is created.  This
                    951: child needs to wait for the other to finish (hopefully within ten seconds).
                    952: 
                    953: =over 4
                    954: 
                    955: Input: $ChartDB
                    956: 
                    957: $ChartDB: The name of the cache database to be opened
                    958: 
                    959: Output: -1, 0, 1
                    960: 
                    961: -1: Couldn't tie database
                    962:  0: Use cached data
                    963:  1: New cache database created, use that.
                    964: 
                    965: =back
                    966: 
                    967: =cut
                    968: 
                    969: sub TestCacheData {
                    970:     my ($ChartDB,$isRecalculate,$totalDelay)=@_;
                    971:     my $isCached=-1;
                    972:     my %testData;
                    973:     my $tieTries=0;
                    974: 
                    975:     if(!defined($totalDelay)) {
                    976:         $totalDelay = 10;
                    977:     }
                    978: 
                    979:     if ((-e "$ChartDB") && (!$isRecalculate)) {
                    980: 	$isCached = 1;
                    981:     } else {
                    982: 	$isCached = 0;
                    983:     }
                    984: 
                    985:     while($tieTries < $totalDelay) {
                    986:         my $result=0;
                    987:         if($isCached) {
1.10      stredwic  988:             $result=tie(%testData,'GDBM_File',$ChartDB,&GDBM_READER(),0640);
1.1       stredwic  989:         } else {
1.10      stredwic  990:             $result=tie(%testData,'GDBM_File',$ChartDB,&GDBM_NEWDB(),0640);
1.1       stredwic  991:         }
                    992:         if($result) {
                    993:             last;
                    994:         }
                    995:         $tieTries++;
                    996:         sleep 1;
                    997:     }
                    998:     if($tieTries >= $totalDelay) {
                    999:         return -1;
                   1000:     }
                   1001: 
                   1002:     untie(%testData);
                   1003: 
                   1004:     return $isCached;
                   1005: }
1.2       stredwic 1006: 
1.13      stredwic 1007: sub DownloadStudentCourseData {
                   1008:     my ($students,$checkDate,$cacheDB,$extract,$status,$courseID,$r,$c)=@_;
                   1009: 
                   1010:     my $title = 'LON-CAPA Statistics';
                   1011:     my $heading = 'Download and Process Course Data';
                   1012:     my $studentCount = scalar(@$students);
                   1013:     my %cache;
                   1014: 
                   1015:     my $WhatIWant;
                   1016:     $WhatIWant = '(^version:(\w|\/|\.|-)+?$|';
                   1017:     $WhatIWant .= '^\d+:(\w|\/|\.|-)+?:(resource\.\d+\.';
                   1018:     $WhatIWant .= '(solved|tries|previous|awarded|(\d+\.submission))\s*$';
                   1019:     $WhatIWant .= '|timestamp)';
                   1020:     $WhatIWant .= ')';
                   1021: 
                   1022:     if($status eq 'true') {
                   1023:         &Apache::lonhtmlcommon::Create_PrgWin($r, $title, $heading);
                   1024:     }
                   1025:     my $count=1;
                   1026:     foreach (@$students) {
                   1027:         if($c->aborted()) { return 'Aborted'; }
                   1028: 
                   1029:         if($status eq 'true') {
                   1030:             my $displayString = $count.'/'.$studentCount.': '.$_;
                   1031:             &Apache::lonhtmlcommon::Update_PrgWin($displayString, $r);
                   1032:         }
                   1033: 
                   1034:         my $downloadTime='Not downloaded';
                   1035:         if($checkDate eq 'true'  && 
                   1036:            tie(%cache,'GDBM_File',$cacheDB,&GDBM_READER(),0640)) {
                   1037:             $downloadTime = $cache{$_.':lastDownloadTime'};
                   1038:             untie(%cache);
                   1039:         }
                   1040: 
                   1041:         if($c->aborted()) { return 'Aborted'; }
                   1042: 
                   1043:         if($downloadTime eq 'Not downloaded') {
                   1044:             my $courseData = 
                   1045:                 &DownloadCourseInformation($_, $courseID, $downloadTime, 
                   1046:                                            $WhatIWant);
                   1047:             if(tie(%cache,'GDBM_File',$cacheDB,&GDBM_WRCREAT(),0640)) {
                   1048:                 foreach my $key (keys(%$courseData)) {
                   1049:                     if($key =~ /^(con_lost|error|no_such_host)/i) {
                   1050:                         $courseData->{$_.':error'} = 'No course data for '.$_;
                   1051:                         last;
                   1052:                     }
                   1053:                 }
                   1054:                 if($extract eq 'true') {
                   1055:                     &ExtractStudentData($courseData, \%cache, \%cache, $_);
                   1056:                 } else {
                   1057:                     &ProcessStudentData(\%cache, $courseData, $_);
                   1058:                 }
                   1059:                 untie(%cache);
                   1060:             } else {
                   1061:                 next;
                   1062:             }
                   1063:         }
                   1064:         $count++;
                   1065:     }
                   1066:     if($status eq 'true') { &Apache::lonhtmlcommon::Close_PrgWin($r); }
                   1067: 
                   1068:     return 'OK';
                   1069: }
                   1070: 
                   1071: sub DownloadStudentCourseDataSeparate {
                   1072:     my ($students,$checkDate,$cacheDB,$extract,$status,$courseID,$r,$c)=@_;
                   1073:     my $residualFile = '/home/httpd/perl/tmp/'.$courseID.'DownloadFile.db';
                   1074:     my $title = 'LON-CAPA Statistics';
                   1075:     my $heading = 'Download Course Data';
                   1076: 
                   1077:     my $WhatIWant;
                   1078:     $WhatIWant = '(^version:(\w|\/|\.|-)+?$|';
                   1079:     $WhatIWant .= '^\d+:(\w|\/|\.|-)+?:(resource\.\d+\.';
                   1080:     $WhatIWant .= '(solved|tries|previous|awarded|(\d+\.submission))\s*$';
                   1081:     $WhatIWant .= '|timestamp)';
                   1082:     $WhatIWant .= ')';
                   1083: 
                   1084:     &CheckForResidualDownload($courseID, $cacheDB, $students, $c);
                   1085: 
                   1086:     my %cache;
                   1087:     my %downloadData;
                   1088:     unless(tie(%downloadData,'GDBM_File',$residualFile,&GDBM_NEWDB(),0640)) {
                   1089:         return 'Failed to tie temporary download hash.';
                   1090:     }
                   1091: 
                   1092:     my $studentCount = scalar(@$students);
                   1093:     if($status eq 'true') {
                   1094:         &Apache::lonhtmlcommon::Create_PrgWin($r, $title, $heading);
                   1095:     }
                   1096:     my $count=1;
                   1097:     foreach (@$students) {
                   1098:         if($c->aborted()) {
                   1099:             untie(%downloadData);
                   1100:             return 'Aborted';
                   1101:         }
                   1102: 
                   1103:         if($status eq 'true') {
                   1104:             my $displayString = $count.'/'.$studentCount.': '.$_;
                   1105:             &Apache::lonhtmlcommon::Update_PrgWin($displayString, $r);
                   1106:         }
                   1107: 
                   1108:         my $downloadTime='Not downloaded';
                   1109:         if($checkDate eq 'true'  && 
                   1110:            tie(%cache,'GDBM_File',$cacheDB,&GDBM_READER(),0640)) {
                   1111:             $downloadTime = $cache{$_.':lastDownloadTime'};
                   1112:             untie(%cache);
                   1113:         }
                   1114: 
                   1115:         if($c->aborted()) {
                   1116:             untie(%downloadData);
                   1117:             return 'Aborted';
                   1118:         }
                   1119: 
                   1120:         if($downloadTime eq 'Not downloaded') {
                   1121:             my $error = 0;
                   1122:             my $courseData = 
                   1123:                 &DownloadCourseInformation($_, $courseID, $downloadTime,
                   1124:                                            $WhatIWant);
                   1125:             foreach my $key (keys(%$courseData)) {
                   1126:                 $downloadData{$key} = $courseData->{$key};
                   1127:                 if($key =~ /^(con_lost|error|no_such_host)/i) {
                   1128:                     $error = 1;
                   1129:                     last;
                   1130:                 }
                   1131:             }
                   1132:             if($error) {
                   1133:                 foreach my $deleteKey (keys(%$courseData)) {
                   1134:                     delete $downloadData{$deleteKey};
                   1135:                 }
                   1136:                 $downloadData{$_.':error'} = 'No course data for '.$_;
                   1137:             }
                   1138:         }
                   1139:         $count++;
                   1140:     }
                   1141:     if($status eq 'true') { &Apache::lonhtmlcommon::Close_PrgWin($r); }
                   1142: 
                   1143:     return &CheckForResidualDownload($cacheDB, 'true', 'true', 
                   1144:                                      $courseID, $r, $c);
                   1145: }
                   1146: 
                   1147: sub CheckForResidualDownload {
                   1148:     my ($cacheDB,$extract,$status,$courseID,$r,$c)=@_;
                   1149: 
                   1150:     my $residualFile = '/home/httpd/perl/tmp/'.$courseID.'DownloadFile.db';
                   1151:     if(!-e $residualFile) {
                   1152:         return;
                   1153:     }
                   1154: 
                   1155:     my %downloadData;
                   1156:     my %cache;
                   1157:     unless(tie(%downloadData,'GDBM_File',$residualFile,&GDBM_READER(),0640) &&
                   1158:            tie(%cache,'GDBM_File',$cacheDB,&GDBM_WRCREAT(),0640)) {
                   1159:         return;
                   1160:     }
                   1161: 
                   1162:     my @dataKeys=keys(%downloadData);
                   1163:     my @students=();
                   1164:     my %checkStudent;
                   1165:     foreach(@dataKeys) {
                   1166:         my @temp = split(':', $_);
                   1167:         my $student = $temp[0].':'.$temp[1];
                   1168:         if(!defined($checkStudent{$student})) {
                   1169:             $checkStudent{$student}++;
                   1170:             push(@students, $student);
                   1171:         }
                   1172:     }
                   1173: 
                   1174:     my $heading = 'Process Course Data';
                   1175:     my $title = 'LON-CAPA Statistics';
                   1176:     my $studentCount = scalar(@students);
                   1177:     if($status eq 'true') {
                   1178:         &Apache::lonhtmlcommon::Create_PrgWin($r, $title, $heading);
                   1179:     }
                   1180: 
                   1181:     my $count=1;
                   1182:     foreach my $name (@students) {
                   1183:         last if($c->aborted());
                   1184: 
                   1185:         if($status eq 'true') {
                   1186:             my $displayString = $count.'/'.$studentCount.': '.$_;
                   1187:             &Apache::lonhtmlcommon::Update_PrgWin($displayString, $r);
                   1188:         }
                   1189: 
                   1190:         if($extract eq 'true') {
                   1191:             &ExtractStudentData(\%downloadData, \%cache, \%cache, $name);
                   1192:         } else {
                   1193:             &ProcessStudentData(\%cache, \%downloadData, $name);
                   1194:         }
                   1195:         foreach (@dataKeys) {
                   1196:             if(/^$name/) {
                   1197:                 delete $downloadData{$_};
                   1198:             }
                   1199:         }
                   1200:         $count++;
                   1201:     }
                   1202: 
                   1203:     if($status eq 'true') { &Apache::lonhtmlcommon::Close_PrgWin($r); }
                   1204: 
                   1205:     untie(%cache);
                   1206:     untie(%downloadData);
                   1207: 
                   1208:     if(!$c->aborted()) {
                   1209:         my @files = ($residualFile);
                   1210:         unlink(@files);
                   1211:     }
                   1212: 
                   1213:     return 'OK';
                   1214: }
                   1215: 
1.3       stredwic 1216: sub GetFileTimestamp {
                   1217:     my ($studentDomain,$studentName,$filename,$root)=@_;
                   1218:     $studentDomain=~s/\W//g;
                   1219:     $studentName=~s/\W//g;
                   1220:     my $subdir=$studentName.'__';
                   1221:     $subdir =~ s/(.)(.)(.).*/$1\/$2\/$3/;
                   1222:     my $proname="$studentDomain/$subdir/$studentName";
                   1223:     $proname .= '/'.$filename;
                   1224:     my @dir = &Apache::lonnet::dirlist($proname, $studentDomain, $studentName,
                   1225:                                        $root);
                   1226:     my $fileStat = $dir[0];
                   1227:     my @stats = split('&', $fileStat);
1.13      stredwic 1228:     if($stats[0] ne 'empty' && $stats[0] ne 'no_such_dir') {
1.3       stredwic 1229:         return $stats[9];
                   1230:     } else {
                   1231:         return -1;
                   1232:     }
                   1233: }
1.1       stredwic 1234: 
                   1235: # ----- END HELPER FUNCTIONS --------------------------------------------
                   1236: 
                   1237: 1;
                   1238: __END__

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