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