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