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