Annotation of loncom/interface/loncoursedata.pm, revision 1.19
1.1 stredwic 1: # The LearningOnline Network with CAPA
2: # (Publication Handler
3: #
1.19 ! stredwic 4: # $Id: loncoursedata.pm,v 1.18 2002/08/15 16:03:11 stredwic Exp $
1.1 stredwic 5: #
6: # Copyright Michigan State University Board of Trustees
7: #
8: # This file is part of the LearningOnline Network with CAPA (LON-CAPA).
9: #
10: # LON-CAPA is free software; you can redistribute it and/or modify
11: # it under the terms of the GNU General Public License as published by
12: # the Free Software Foundation; either version 2 of the License, or
13: # (at your option) any later version.
14: #
15: # LON-CAPA is distributed in the hope that it will be useful,
16: # but WITHOUT ANY WARRANTY; without even the implied warranty of
17: # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18: # GNU General Public License for more details.
19: #
20: # You should have received a copy of the GNU General Public License
21: # along with LON-CAPA; if not, write to the Free Software
22: # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
23: #
24: # /home/httpd/html/adm/gpl.txt
25: #
26: # http://www.lon-capa.org/
27: #
28: ###
29:
30: =pod
31:
32: =head1 NAME
33:
34: loncoursedata
35:
36: =head1 SYNOPSIS
37:
38: Set of functions that download and process student information.
39:
40: =head1 PACKAGES USED
41:
42: Apache::Constants qw(:common :http)
43: Apache::lonnet()
44: HTML::TokeParser
45: GDBM_File
46:
47: =cut
48:
49: package Apache::loncoursedata;
50:
51: use strict;
52: use Apache::Constants qw(:common :http);
53: use Apache::lonnet();
1.13 stredwic 54: use Apache::lonhtmlcommon;
1.1 stredwic 55: use HTML::TokeParser;
56: use GDBM_File;
57:
58: =pod
59:
60: =head1 DOWNLOAD INFORMATION
61:
62: This section contains all the files that get data from other servers
63: and/or itself. There is one function that has a call to get remote
64: information but isn't included here which is ProcessTopLevelMap. The
65: usage was small enough to be ignored, but that portion may be moved
66: here in the future.
67:
68: =cut
69:
70: # ----- DOWNLOAD INFORMATION -------------------------------------------
71:
72: =pod
73:
1.3 stredwic 74: =item &DownloadClasslist()
1.1 stredwic 75:
76: Collects lastname, generation, middlename, firstname, PID, and section for each
77: student from their environment database. The list of students is built from
78: collecting a classlist for the course that is to be displayed.
79:
80: =over 4
81:
82: Input: $courseID, $c
83:
84: $courseID: The id of the course
85:
86: $c: The connection class that can determine if the browser has aborted. It
87: is used to short circuit this function so that it doesn't continue to
88: get information when there is no need.
89:
90: Output: \%classlist
91:
92: \%classlist: A pointer to a hash containing the following data:
93:
94: -A list of student name:domain (as keys) (known below as $name)
95:
96: -A hash pointer for each student containing lastname, generation, firstname,
97: middlename, and PID : Key is $name.'studentInformation'
98:
99: -A hash pointer to each students section data : Key is $name.section
100:
101: =back
102:
103: =cut
104:
1.3 stredwic 105: sub DownloadClasslist {
106: my ($courseID, $lastDownloadTime, $c)=@_;
1.1 stredwic 107: my ($courseDomain,$courseNumber)=split(/\_/,$courseID);
1.3 stredwic 108: my %classlist;
1.1 stredwic 109:
1.7 stredwic 110: my $modifiedTime = &GetFileTimestamp($courseDomain, $courseNumber,
111: 'classlist.db',
112: $Apache::lonnet::perlvar{'lonUsersDir'});
113:
114: if($lastDownloadTime ne 'Not downloaded' &&
115: $lastDownloadTime >= $modifiedTime && $modifiedTime >= 0) {
116: $classlist{'lastDownloadTime'}=time;
117: $classlist{'UpToDate'} = 'true';
118: return \%classlist;
119: }
1.3 stredwic 120:
121: %classlist=&Apache::lonnet::dump('classlist',$courseDomain, $courseNumber);
1.1 stredwic 122: my ($checkForError)=keys (%classlist);
123: if($checkForError =~ /^(con_lost|error|no_such_host)/i) {
124: return \%classlist;
125: }
126:
127: foreach my $name (keys(%classlist)) {
128: if($c->aborted()) {
129: $classlist{'error'}='aborted';
130: return \%classlist;
131: }
132:
133: my ($studentName,$studentDomain) = split(/\:/,$name);
134: # Download student environment data, specifically the full name and id.
135: my %studentInformation=&Apache::lonnet::get('environment',
136: ['lastname','generation',
137: 'firstname','middlename',
138: 'id'],
139: $studentDomain,
140: $studentName);
141: $classlist{$name.':studentInformation'}=\%studentInformation;
142:
143: if($c->aborted()) {
144: $classlist{'error'}='aborted';
145: return \%classlist;
146: }
147:
148: #Section
149: my %section=&Apache::lonnet::dump('roles',$studentDomain,$studentName);
1.3 stredwic 150: $classlist{$name.':sections'}=\%section;
1.1 stredwic 151: }
152:
1.3 stredwic 153: $classlist{'UpToDate'} = 'false';
154: $classlist{'lastDownloadTime'}=time;
155:
1.1 stredwic 156: return \%classlist;
157: }
158:
159: =pod
160:
1.4 stredwic 161: =item &DownloadCourseInformation()
1.1 stredwic 162:
163: Dump of all the course information for a single student. There is no
1.3 stredwic 164: pruning of data, it is all stored in a hash and returned. It also
165: checks the timestamp of the students course database file and only downloads
166: if it has been modified since the last download.
1.1 stredwic 167:
168: =over 4
169:
170: Input: $name, $courseID
171:
172: $name: student name:domain
173:
174: $courseID: The id of the course
175:
176: Output: \%courseData
177:
178: \%courseData: A hash pointer to the raw data from the student's course
179: database.
180:
181: =back
182:
183: =cut
184:
1.4 stredwic 185: sub DownloadCourseInformation {
1.12 stredwic 186: my ($namedata,$courseID,$lastDownloadTime,$WhatIWant)=@_;
1.3 stredwic 187: my %courseData;
1.4 stredwic 188: my ($name,$domain) = split(/\:/,$namedata);
1.1 stredwic 189:
1.7 stredwic 190: my $modifiedTime = &GetFileTimestamp($domain, $name,
191: $courseID.'.db',
192: $Apache::lonnet::perlvar{'lonUsersDir'});
193:
1.13 stredwic 194: if($lastDownloadTime >= $modifiedTime && $modifiedTime >= 0) {
195: $courseData{$namedata.':lastDownloadTime'}=time;
196: $courseData{$namedata.':UpToDate'} = 'true';
1.7 stredwic 197: return \%courseData;
198: }
1.3 stredwic 199:
1.4 stredwic 200: # Download course data
1.12 stredwic 201: if(!defined($WhatIWant)) {
202: $WhatIWant = '.';
203: }
1.19 ! stredwic 204: $WhatIWant = '.';
1.12 stredwic 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: }
550: push(@names,$name);
1.3 stredwic 551: my $studentInformation = $classlist->{$name.':studentInformation'},
552: my $sectionData = $classlist->{$name.':sections'},
553: my $date = $classlist->{$name},
554: my ($studentName,$studentDomain) = split(/\:/,$name);
555:
556: $cache->{$name.':username'}=$studentName;
557: $cache->{$name.':domain'}=$studentDomain;
1.10 stredwic 558: # Initialize timestamp for student
1.3 stredwic 559: if(!defined($cache->{$name.':lastDownloadTime'})) {
560: $cache->{$name.':lastDownloadTime'}='Not downloaded';
1.6 stredwic 561: $cache->{$name.':updateTime'}=' Not updated';
1.3 stredwic 562: }
563:
564: my ($checkForError)=keys(%$studentInformation);
565: if($checkForError =~ /^(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: } else {
571: $cache->{$name.':fullname'}=&ProcessFullName(
572: $studentInformation->{'lastname'},
573: $studentInformation->{'generation'},
574: $studentInformation->{'firstname'},
575: $studentInformation->{'middlename'});
576: $cache->{$name.':id'}=$studentInformation->{'id'};
577: }
578:
579: my ($end, $start)=split(':',$date);
580: $courseID=~s/\_/\//g;
581: $courseID=~s/^(\w)/\/$1/;
582:
583: my $sec='';
584: foreach my $key (keys (%$sectionData)) {
585: my $value = $sectionData->{$key};
586: if ($key=~/^$courseID(?:\/)*(\w+)*\_st$/) {
587: my $tempsection=$1;
588: if($key eq $courseID.'_st') {
589: $tempsection='';
590: }
591: my ($dummy,$roleend,$rolestart)=split(/\_/,$value);
592: if($roleend eq $end && $rolestart eq $start) {
593: $sec = $tempsection;
594: last;
595: }
596: }
597: }
598:
599: my $status='Expired';
600: if(((!$end) || time < $end) && ((!$start) || (time > $start))) {
601: $status='Active';
602: }
603: $cache->{$name.':Status'}=$status;
604: $cache->{$name.':section'}=$sec;
1.7 stredwic 605:
606: if($sec eq '' || !defined($sec) || $sec eq ' ') {
607: $sec = 'none';
608: }
609: if(defined($cache->{'sectionList'})) {
610: if($cache->{'sectionList'} !~ /(^$sec:|^$sec$|:$sec$|:$sec:)/) {
611: $cache->{'sectionList'} .= ':'.$sec;
612: }
613: } else {
614: $cache->{'sectionList'} = $sec;
615: }
1.1 stredwic 616: }
617:
1.3 stredwic 618: $cache->{'ClasslistTimestamp'}=time;
619: $cache->{'NamesOfStudents'}=join(':::',@names);
1.1 stredwic 620:
621: return @names;
622: }
623:
624: =pod
625:
626: =item &ProcessStudentData()
627:
628: Takes the course data downloaded for a student in
1.4 stredwic 629: &DownloadCourseInformation() and breaks it up into key value pairs
1.1 stredwic 630: to be stored in the cached data. The keys are comprised of the
631: $username:$domain:$keyFromCourseDatabase. The student username:domain is
632: stored away signifying that the student's information has been downloaded and
633: can be reused from cached data.
634:
635: =over 4
636:
637: Input: $cache, $courseData, $name
638:
639: $cache: A hash pointer to store data
640:
641: $courseData: A hash pointer that points to the course data downloaded for a
642: student.
643:
644: $name: username:domain
645:
646: Output: None
647:
648: *NOTE: There is no output, but an error message is stored away in the cache
649: data. This is checked in &FormatStudentData(). The key username:domain:error
650: will only exist if an error occured. The error is an error from
1.4 stredwic 651: &DownloadCourseInformation().
1.1 stredwic 652:
653: =back
654:
655: =cut
656:
657: sub ProcessStudentData {
658: my ($cache,$courseData,$name)=@_;
659:
1.13 stredwic 660: if(!&CheckDateStampError($courseData, $cache, $name)) {
661: return;
662: }
663:
664: foreach (keys %$courseData) {
665: $cache->{$_}=$courseData->{$_};
666: }
667:
668: return;
669: }
670:
671: sub ExtractStudentData {
672: my ($input, $output, $data, $name)=@_;
673:
674: if(!&CheckDateStampError($input, $data, $name)) {
1.3 stredwic 675: return;
676: }
677:
1.13 stredwic 678: my ($username,$domain)=split(':',$name);
679:
680: my $Version;
681: my $problemsCorrect = 0;
682: my $totalProblems = 0;
683: my $problemsSolved = 0;
684: my $numberOfParts = 0;
1.14 stredwic 685: my $totalAwarded = 0;
1.13 stredwic 686: foreach my $sequence (split(':', $data->{'orderedSequences'})) {
687: foreach my $problemID (split(':', $data->{$sequence.':problems'})) {
688: my $problem = $data->{$problemID.':problem'};
689: my $LatestVersion = $input->{$name.':version:'.$problem};
690:
691: # Output dashes for all the parts of this problem if there
692: # is no version information about the current problem.
693: if(!$LatestVersion) {
694: foreach my $part (split(/\:/,$data->{$sequence.':'.
695: $problemID.
696: ':parts'})) {
1.15 stredwic 697: $output->{$name.':'.$problemID.':'.$part.':tries'} = 0;
698: $output->{$name.':'.$problemID.':'.$part.':awarded'} = 0;
699: $output->{$name.':'.$problemID.':'.$part.':code'} = ' ';
1.13 stredwic 700: $totalProblems++;
701: }
702: $output->{$name.':'.$problemID.':NoVersion'} = 'true';
703: next;
704: }
705:
706: my %partData=undef;
707: # Initialize part data, display skips correctly
708: # Skip refers to when a student made no submissions on that
709: # part/problem.
710: foreach my $part (split(/\:/,$data->{$sequence.':'.
711: $problemID.
712: ':parts'})) {
713: $partData{$part.':tries'}=0;
714: $partData{$part.':code'}=' ';
715: $partData{$part.':awarded'}=0;
716: $partData{$part.':timestamp'}=0;
717: foreach my $response (split(':', $data->{$sequence.':'.
718: $problemID.':'.
719: $part.':responseIDs'})) {
720: $partData{$part.':'.$response.':submission'}='';
721: }
722: }
723:
724: # Looping through all the versions of each part, starting with the
725: # oldest version. Basically, it gets the most recent
726: # set of grade data for each part.
727: my @submissions = ();
728: for(my $Version=1; $Version<=$LatestVersion; $Version++) {
729: foreach my $part (split(/\:/,$data->{$sequence.':'.
730: $problemID.
731: ':parts'})) {
732:
733: if(!defined($input->{"$name:$Version:$problem".
734: ":resource.$part.solved"})) {
735: # No grade for this submission, so skip
736: next;
737: }
738:
739: my $tries=0;
740: my $code=' ';
741: my $awarded=0;
742:
743: $tries = $input->{$name.':'.$Version.':'.$problem.
744: ':resource.'.$part.'.tries'};
745: $awarded = $input->{$name.':'.$Version.':'.$problem.
746: ':resource.'.$part.'.awarded'};
747:
748: $partData{$part.':awarded'}=($awarded) ? $awarded : 0;
749: $partData{$part.':tries'}=($tries) ? $tries : 0;
750:
751: $partData{$part.':timestamp'}=$input->{$name.':'.$Version.':'.
752: $problem.
753: ':timestamp'};
754: if(!$input->{$name.':'.$Version.':'.$problem.':resource.'.$part.
755: '.previous'}) {
756: foreach my $response (split(':',
757: $data->{$sequence.':'.
758: $problemID.':'.
759: $part.':responseIDs'})) {
760: @submissions=($input->{$name.':'.$Version.':'.
761: $problem.
762: ':resource.'.$part.'.'.
763: $response.'.submission'},
764: @submissions);
765: }
766: }
767:
768: my $val = $input->{$name.':'.$Version.':'.$problem.
769: ':resource.'.$part.'.solved'};
770: if ($val eq 'correct_by_student') {$code = '*';}
771: elsif ($val eq 'correct_by_override') {$code = '+';}
772: elsif ($val eq 'incorrect_attempted') {$code = '.';}
773: elsif ($val eq 'incorrect_by_override'){$code = '-';}
774: elsif ($val eq 'excused') {$code = 'x';}
775: elsif ($val eq 'ungraded_attempted') {$code = '#';}
776: else {$code = ' ';}
777: $partData{$part.':code'}=$code;
778: }
779: }
780:
781: foreach my $part (split(/\:/,$data->{$sequence.':'.$problemID.
782: ':parts'})) {
783: $output->{$name.':'.$problemID.':'.$part.':wrong'} =
784: $partData{$part.':tries'};
785:
786: if($partData{$part.':code'} eq '*') {
787: $output->{$name.':'.$problemID.':'.$part.':wrong'}--;
788: $problemsCorrect++;
789: } elsif($partData{$part.':code'} eq '+') {
790: $output->{$name.':'.$problemID.':'.$part.':wrong'}--;
791: $problemsCorrect++;
792: }
793:
794: $output->{$name.':'.$problemID.':'.$part.':tries'} =
795: $partData{$part.':tries'};
796: $output->{$name.':'.$problemID.':'.$part.':code'} =
797: $partData{$part.':code'};
798: $output->{$name.':'.$problemID.':'.$part.':awarded'} =
799: $partData{$part.':awarded'};
1.14 stredwic 800: $totalAwarded += $partData{$part.':awarded'};
1.13 stredwic 801: $output->{$name.':'.$problemID.':'.$part.':timestamp'} =
802: $partData{$part.':timestamp'};
803: foreach my $response (split(':', $data->{$sequence.':'.
804: $problemID.':'.
805: $part.':responseIDs'})) {
806: $output->{$name.':'.$problemID.':'.$part.':'.$response.
807: ':submission'}=join(':::',@submissions);
808: }
1.3 stredwic 809:
1.13 stredwic 810: if($partData{$part.':code'} ne 'x') {
811: $totalProblems++;
812: }
813: }
1.1 stredwic 814: }
1.13 stredwic 815:
816: $output->{$name.':'.$sequence.':problemsCorrect'} = $problemsCorrect;
817: $problemsSolved += $problemsCorrect;
818: $problemsCorrect=0;
1.3 stredwic 819: }
820:
1.13 stredwic 821: $output->{$name.':problemsSolved'} = $problemsSolved;
822: $output->{$name.':totalProblems'} = $totalProblems;
1.14 stredwic 823: $output->{$name.':totalAwarded'} = $totalAwarded;
1.1 stredwic 824:
825: return;
1.4 stredwic 826: }
827:
828: sub LoadDiscussion {
1.13 stredwic 829: my ($courseID)=@_;
1.5 minaeibi 830: my %Discuss=();
831: my %contrib=&Apache::lonnet::dump(
832: $courseID,
833: $ENV{'course.'.$courseID.'.domain'},
834: $ENV{'course.'.$courseID.'.num'});
835:
836: #my %contrib=&DownloadCourseInformation($name, $courseID, 0);
837:
1.4 stredwic 838: foreach my $temp(keys %contrib) {
839: if ($temp=~/^version/) {
840: my $ver=$contrib{$temp};
841: my ($dummy,$prb)=split(':',$temp);
842: for (my $idx=1; $idx<=$ver; $idx++ ) {
843: my $name=$contrib{"$idx:$prb:sendername"};
1.5 minaeibi 844: $Discuss{"$name:$prb"}=$idx;
1.4 stredwic 845: }
846: }
847: }
1.5 minaeibi 848:
849: return \%Discuss;
1.1 stredwic 850: }
851:
852: # ----- END PROCESSING FUNCTIONS ---------------------------------------
853:
854: =pod
855:
856: =head1 HELPER FUNCTIONS
857:
858: These are just a couple of functions do various odd and end
859: jobs.
860:
861: =cut
862:
863: # ----- HELPER FUNCTIONS -----------------------------------------------
864:
1.13 stredwic 865: sub CheckDateStampError {
866: my ($courseData, $cache, $name)=@_;
867: if($courseData->{$name.':UpToDate'} eq 'true') {
868: $cache->{$name.':lastDownloadTime'} =
869: $courseData->{$name.':lastDownloadTime'};
870: if($courseData->{$name.':lastDownloadTime'} eq 'Not downloaded') {
871: $cache->{$name.':updateTime'} = ' Not updated';
872: } else {
873: $cache->{$name.':updateTime'}=
874: localtime($courseData->{$name.':lastDownloadTime'});
875: }
876: return 0;
877: }
878:
879: $cache->{$name.':lastDownloadTime'}=$courseData->{$name.':lastDownloadTime'};
880: if($courseData->{$name.':lastDownloadTime'} eq 'Not downloaded') {
881: $cache->{$name.':updateTime'} = ' Not updated';
882: } else {
883: $cache->{$name.':updateTime'}=
884: localtime($courseData->{$name.':lastDownloadTime'});
885: }
886:
887: if(defined($courseData->{$name.':error'})) {
888: $cache->{$name.':error'}=$courseData->{$name.':error'};
889: return 0;
890: }
891:
892: return 1;
893: }
894:
1.1 stredwic 895: =pod
896:
897: =item &ProcessFullName()
898:
899: Takes lastname, generation, firstname, and middlename (or some partial
900: set of this data) and returns the full name version as a string. Format
901: is Lastname generation, firstname middlename or a subset of this.
902:
903: =cut
904:
905: sub ProcessFullName {
906: my ($lastname, $generation, $firstname, $middlename)=@_;
907: my $Str = '';
908:
909: if($lastname ne '') {
910: $Str .= $lastname.' ';
911: if($generation ne '') {
912: $Str .= $generation;
913: } else {
914: chop($Str);
915: }
916: $Str .= ', ';
917: if($firstname ne '') {
918: $Str .= $firstname.' ';
919: }
920: if($middlename ne '') {
921: $Str .= $middlename;
922: } else {
923: chop($Str);
924: if($firstname eq '') {
925: chop($Str);
926: }
927: }
928: } else {
929: if($firstname ne '') {
930: $Str .= $firstname.' ';
931: }
932: if($middlename ne '') {
933: $Str .= $middlename.' ';
934: }
935: if($generation ne '') {
936: $Str .= $generation;
937: } else {
938: chop($Str);
939: }
940: }
941:
942: return $Str;
943: }
944:
945: =pod
946:
947: =item &TestCacheData()
948:
949: Determine if the cache database can be accessed with a tie. It waits up to
950: ten seconds before returning failure. This function exists to help with
951: the problems with stopping the data download. When an abort occurs and the
952: user quickly presses a form button and httpd child is created. This
953: child needs to wait for the other to finish (hopefully within ten seconds).
954:
955: =over 4
956:
957: Input: $ChartDB
958:
959: $ChartDB: The name of the cache database to be opened
960:
961: Output: -1, 0, 1
962:
963: -1: Couldn't tie database
964: 0: Use cached data
965: 1: New cache database created, use that.
966:
967: =back
968:
969: =cut
970:
971: sub TestCacheData {
972: my ($ChartDB,$isRecalculate,$totalDelay)=@_;
973: my $isCached=-1;
974: my %testData;
975: my $tieTries=0;
976:
977: if(!defined($totalDelay)) {
978: $totalDelay = 10;
979: }
980:
981: if ((-e "$ChartDB") && (!$isRecalculate)) {
982: $isCached = 1;
983: } else {
984: $isCached = 0;
985: }
986:
987: while($tieTries < $totalDelay) {
988: my $result=0;
989: if($isCached) {
1.10 stredwic 990: $result=tie(%testData,'GDBM_File',$ChartDB,&GDBM_READER(),0640);
1.1 stredwic 991: } else {
1.10 stredwic 992: $result=tie(%testData,'GDBM_File',$ChartDB,&GDBM_NEWDB(),0640);
1.1 stredwic 993: }
994: if($result) {
995: last;
996: }
997: $tieTries++;
998: sleep 1;
999: }
1000: if($tieTries >= $totalDelay) {
1001: return -1;
1002: }
1003:
1004: untie(%testData);
1005:
1006: return $isCached;
1007: }
1.2 stredwic 1008:
1.13 stredwic 1009: sub DownloadStudentCourseData {
1010: my ($students,$checkDate,$cacheDB,$extract,$status,$courseID,$r,$c)=@_;
1011:
1012: my $title = 'LON-CAPA Statistics';
1013: my $heading = 'Download and Process Course Data';
1014: my $studentCount = scalar(@$students);
1015: my %cache;
1016:
1.18 stredwic 1017:
1.13 stredwic 1018: my $WhatIWant;
1.18 stredwic 1019: $WhatIWant = '(^version:.+?$|';
1020: $WhatIWant .= '^\d+:.+?:(resource\.\d+\.';
1.13 stredwic 1021: $WhatIWant .= '(solved|tries|previous|awarded|(\d+\.submission))\s*$';
1022: $WhatIWant .= '|timestamp)';
1023: $WhatIWant .= ')';
1024:
1025: if($status eq 'true') {
1026: &Apache::lonhtmlcommon::Create_PrgWin($r, $title, $heading);
1027: }
1.17 stredwic 1028:
1029: my $displayString;
1030: my $count=0;
1.13 stredwic 1031: foreach (@$students) {
1032: if($c->aborted()) { return 'Aborted'; }
1033:
1034: if($status eq 'true') {
1.17 stredwic 1035: $count++;
1.13 stredwic 1036: my $displayString = $count.'/'.$studentCount.': '.$_;
1037: &Apache::lonhtmlcommon::Update_PrgWin($displayString, $r);
1038: }
1039:
1040: my $downloadTime='Not downloaded';
1041: if($checkDate eq 'true' &&
1042: tie(%cache,'GDBM_File',$cacheDB,&GDBM_READER(),0640)) {
1043: $downloadTime = $cache{$_.':lastDownloadTime'};
1044: untie(%cache);
1045: }
1046:
1047: if($c->aborted()) { return 'Aborted'; }
1048:
1049: if($downloadTime eq 'Not downloaded') {
1050: my $courseData =
1051: &DownloadCourseInformation($_, $courseID, $downloadTime,
1052: $WhatIWant);
1053: if(tie(%cache,'GDBM_File',$cacheDB,&GDBM_WRCREAT(),0640)) {
1054: foreach my $key (keys(%$courseData)) {
1055: if($key =~ /^(con_lost|error|no_such_host)/i) {
1056: $courseData->{$_.':error'} = 'No course data for '.$_;
1057: last;
1058: }
1059: }
1060: if($extract eq 'true') {
1061: &ExtractStudentData($courseData, \%cache, \%cache, $_);
1062: } else {
1063: &ProcessStudentData(\%cache, $courseData, $_);
1064: }
1065: untie(%cache);
1066: } else {
1067: next;
1068: }
1069: }
1070: }
1071: if($status eq 'true') { &Apache::lonhtmlcommon::Close_PrgWin($r); }
1072:
1073: return 'OK';
1074: }
1075:
1076: sub DownloadStudentCourseDataSeparate {
1077: my ($students,$checkDate,$cacheDB,$extract,$status,$courseID,$r,$c)=@_;
1078: my $residualFile = '/home/httpd/perl/tmp/'.$courseID.'DownloadFile.db';
1079: my $title = 'LON-CAPA Statistics';
1080: my $heading = 'Download Course Data';
1081:
1.18 stredwic 1082: # my $WhatIWant = '.';
1.13 stredwic 1083: my $WhatIWant;
1.18 stredwic 1084: $WhatIWant = '(^version:.+?$|';
1085: $WhatIWant .= '^\d+:.+?:(resource\.\d+\.';
1.13 stredwic 1086: $WhatIWant .= '(solved|tries|previous|awarded|(\d+\.submission))\s*$';
1087: $WhatIWant .= '|timestamp)';
1088: $WhatIWant .= ')';
1089:
1090: &CheckForResidualDownload($courseID, $cacheDB, $students, $c);
1091:
1092: my %cache;
1093:
1094: my $studentCount = scalar(@$students);
1095: if($status eq 'true') {
1096: &Apache::lonhtmlcommon::Create_PrgWin($r, $title, $heading);
1097: }
1.17 stredwic 1098: my $count=0;
1099: my $displayString='';
1.13 stredwic 1100: foreach (@$students) {
1101: if($c->aborted()) {
1102: return 'Aborted';
1103: }
1104:
1105: if($status eq 'true') {
1.17 stredwic 1106: $count++;
1107: $displayString = $count.'/'.$studentCount.': '.$_;
1.13 stredwic 1108: &Apache::lonhtmlcommon::Update_PrgWin($displayString, $r);
1109: }
1110:
1111: my $downloadTime='Not downloaded';
1112: if($checkDate eq 'true' &&
1113: tie(%cache,'GDBM_File',$cacheDB,&GDBM_READER(),0640)) {
1114: $downloadTime = $cache{$_.':lastDownloadTime'};
1115: untie(%cache);
1116: }
1117:
1118: if($c->aborted()) {
1119: return 'Aborted';
1120: }
1121:
1122: if($downloadTime eq 'Not downloaded') {
1123: my $error = 0;
1124: my $courseData =
1125: &DownloadCourseInformation($_, $courseID, $downloadTime,
1126: $WhatIWant);
1.18 stredwic 1127: my %downloadData;
1128: unless(tie(%downloadData,'GDBM_File',$residualFile,
1129: &GDBM_WRCREAT(),0640)) {
1130: return 'Failed to tie temporary download hash.';
1131: }
1.13 stredwic 1132: foreach my $key (keys(%$courseData)) {
1133: $downloadData{$key} = $courseData->{$key};
1134: if($key =~ /^(con_lost|error|no_such_host)/i) {
1135: $error = 1;
1136: last;
1137: }
1138: }
1139: if($error) {
1140: foreach my $deleteKey (keys(%$courseData)) {
1141: delete $downloadData{$deleteKey};
1142: }
1143: $downloadData{$_.':error'} = 'No course data for '.$_;
1144: }
1.18 stredwic 1145: untie(%downloadData);
1.13 stredwic 1146: }
1147: }
1148: if($status eq 'true') { &Apache::lonhtmlcommon::Close_PrgWin($r); }
1149:
1150: return &CheckForResidualDownload($cacheDB, 'true', 'true',
1151: $courseID, $r, $c);
1152: }
1153:
1154: sub CheckForResidualDownload {
1155: my ($cacheDB,$extract,$status,$courseID,$r,$c)=@_;
1156:
1157: my $residualFile = '/home/httpd/perl/tmp/'.$courseID.'DownloadFile.db';
1158: if(!-e $residualFile) {
1.18 stredwic 1159: return 'OK';
1.13 stredwic 1160: }
1161:
1162: my %downloadData;
1163: my %cache;
1.17 stredwic 1164: unless(tie(%downloadData,'GDBM_File',$residualFile,&GDBM_READER(),0640)) {
1165: return 'Can not tie database for check for residual download: tempDB';
1166: }
1167: unless(tie(%cache,'GDBM_File',$cacheDB,&GDBM_WRCREAT(),0640)) {
1168: untie(%downloadData);
1169: return 'Can not tie database for check for residual download: cacheDB';
1.13 stredwic 1170: }
1171:
1172: my @students=();
1173: my %checkStudent;
1.18 stredwic 1174: my $key;
1175: while(($key, undef) = each %downloadData) {
1176: my @temp = split(':', $key);
1.13 stredwic 1177: my $student = $temp[0].':'.$temp[1];
1178: if(!defined($checkStudent{$student})) {
1179: $checkStudent{$student}++;
1180: push(@students, $student);
1181: }
1182: }
1183:
1184: my $heading = 'Process Course Data';
1185: my $title = 'LON-CAPA Statistics';
1186: my $studentCount = scalar(@students);
1187: if($status eq 'true') {
1188: &Apache::lonhtmlcommon::Create_PrgWin($r, $title, $heading);
1189: }
1190:
1.19 ! stredwic 1191: my c$ount=1;
1.13 stredwic 1192: foreach my $name (@students) {
1193: last if($c->aborted());
1194:
1195: if($status eq 'true') {
1.19 ! stredwic 1196: my $displayString = $count.'/'.$studentCount.': '.$name;
1.13 stredwic 1197: &Apache::lonhtmlcommon::Update_PrgWin($displayString, $r);
1198: }
1199:
1200: if($extract eq 'true') {
1201: &ExtractStudentData(\%downloadData, \%cache, \%cache, $name);
1202: } else {
1203: &ProcessStudentData(\%cache, \%downloadData, $name);
1204: }
1205: $count++;
1206: }
1207:
1208: if($status eq 'true') { &Apache::lonhtmlcommon::Close_PrgWin($r); }
1209:
1210: untie(%cache);
1211: untie(%downloadData);
1212:
1213: if(!$c->aborted()) {
1214: my @files = ($residualFile);
1215: unlink(@files);
1216: }
1217:
1218: return 'OK';
1219: }
1220:
1.3 stredwic 1221: sub GetFileTimestamp {
1222: my ($studentDomain,$studentName,$filename,$root)=@_;
1223: $studentDomain=~s/\W//g;
1224: $studentName=~s/\W//g;
1225: my $subdir=$studentName.'__';
1226: $subdir =~ s/(.)(.)(.).*/$1\/$2\/$3/;
1227: my $proname="$studentDomain/$subdir/$studentName";
1228: $proname .= '/'.$filename;
1229: my @dir = &Apache::lonnet::dirlist($proname, $studentDomain, $studentName,
1230: $root);
1231: my $fileStat = $dir[0];
1232: my @stats = split('&', $fileStat);
1.13 stredwic 1233: if($stats[0] ne 'empty' && $stats[0] ne 'no_such_dir') {
1.3 stredwic 1234: return $stats[9];
1235: } else {
1236: return -1;
1237: }
1238: }
1.1 stredwic 1239:
1240: # ----- END HELPER FUNCTIONS --------------------------------------------
1241:
1242: 1;
1243: __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