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