1: # The LearningOnline Network with CAPA
2: # (Publication Handler
3: #
4: # $Id: loncoursedata.pm,v 1.1 2002/07/09 15:43:49 stredwic Exp $
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();
54: use HTML::TokeParser;
55: use GDBM_File;
56:
57: =pod
58:
59: =head1 DOWNLOAD INFORMATION
60:
61: This section contains all the files that get data from other servers
62: and/or itself. There is one function that has a call to get remote
63: information but isn't included here which is ProcessTopLevelMap. The
64: usage was small enough to be ignored, but that portion may be moved
65: here in the future.
66:
67: =cut
68:
69: # ----- DOWNLOAD INFORMATION -------------------------------------------
70:
71: =pod
72:
73: =item &DownloadNamePIDSection()
74:
75: Collects lastname, generation, middlename, firstname, PID, and section for each
76: student from their environment database. The list of students is built from
77: collecting a classlist for the course that is to be displayed.
78:
79: =over 4
80:
81: Input: $courseID, $c
82:
83: $courseID: The id of the course
84:
85: $c: The connection class that can determine if the browser has aborted. It
86: is used to short circuit this function so that it doesn't continue to
87: get information when there is no need.
88:
89: Output: \%classlist
90:
91: \%classlist: A pointer to a hash containing the following data:
92:
93: -A list of student name:domain (as keys) (known below as $name)
94:
95: -A hash pointer for each student containing lastname, generation, firstname,
96: middlename, and PID : Key is $name.'studentInformation'
97:
98: -A hash pointer to each students section data : Key is $name.section
99:
100: =back
101:
102: =cut
103:
104: sub DownloadStudentNamePIDSection {
105: my ($courseID, $c)=@_;
106: my ($courseDomain,$courseNumber)=split(/\_/,$courseID);
107:
108: my %classlist=&Apache::lonnet::dump('classlist',$courseDomain,
109: $courseNumber);
110: my ($checkForError)=keys (%classlist);
111: if($checkForError =~ /^(con_lost|error|no_such_host)/i) {
112: return \%classlist;
113: }
114:
115: foreach my $name (keys(%classlist)) {
116: if($c->aborted()) {
117: $classlist{'error'}='aborted';
118: return \%classlist;
119: }
120:
121: my ($studentName,$studentDomain) = split(/\:/,$name);
122: # Download student environment data, specifically the full name and id.
123: my %studentInformation=&Apache::lonnet::get('environment',
124: ['lastname','generation',
125: 'firstname','middlename',
126: 'id'],
127: $studentDomain,
128: $studentName);
129: $classlist{$name.':studentInformation'}=\%studentInformation;
130:
131: if($c->aborted()) {
132: $classlist{'error'}='aborted';
133: return \%classlist;
134: }
135:
136: #Section
137: my %section=&Apache::lonnet::dump('roles',$studentDomain,$studentName);
138: $classlist{$name.':section'}=\%section;
139: }
140:
141: return \%classlist;
142: }
143:
144: =pod
145:
146: =item &DownloadStudentCourseInformation()
147:
148: Dump of all the course information for a single student. There is no
149: pruning of data, it is all stored in a hash and returned.
150:
151: =over 4
152:
153: Input: $name, $courseID
154:
155: $name: student name:domain
156:
157: $courseID: The id of the course
158:
159: Output: \%courseData
160:
161: \%courseData: A hash pointer to the raw data from the student's course
162: database.
163:
164: =back
165:
166: =cut
167:
168: sub DownloadStudentCourseInformation {
169: my ($name,$courseID)=@_;
170: my ($studentName,$studentDomain) = split(/\:/,$name);
171:
172: # Download student course data
173: my %courseData=&Apache::lonnet::dump($courseID,$studentDomain,
174: $studentName);
175: return \%courseData;
176: }
177:
178: # ----- END DOWNLOAD INFORMATION ---------------------------------------
179:
180: =pod
181:
182: =head1 PROCESSING FUNCTIONS
183:
184: These functions process all the data for all the students. Also, they
185: are the only functions that access the cache database for writing. Thus
186: they are the only functions that cache data. The downloading and caching
187: were separated to reduce problems with stopping downloading then can't
188: tie hash to database later.
189:
190: =cut
191:
192: # ----- PROCESSING FUNCTIONS ---------------------------------------
193:
194: =pod
195:
196: =item &ProcessTopResourceMap()
197:
198: Trace through the "big hash" created in rat/lonuserstate.pm::loadmap.
199: Basically, this function organizes a subset of the data and stores it in
200: cached data. The data stored is the problems, sequences, sequence titles,
201: parts of problems, and their ordering. Column width information is also
202: partially handled here on a per sequence basis.
203:
204: =over 4
205:
206: Input: $cache, $c
207:
208: $cache: A pointer to a hash to store the information
209:
210: $c: The connection class used to determine if an abort has been sent to the
211: browser
212:
213: Output: A string that contains an error message or "OK" if everything went
214: smoothly.
215:
216: =back
217:
218: =cut
219:
220: sub ProcessTopResourceMap {
221: my ($cache,$c)=@_;
222: my %hash;
223: my $fn=$ENV{'request.course.fn'};
224: if(-e "$fn.db") {
225: my $tieTries=0;
226: while($tieTries < 3) {
227: if($c->aborted()) {
228: return;
229: }
230: if(tie(%hash,'GDBM_File',"$fn.db",&GDBM_READER,0640)) {
231: last;
232: }
233: $tieTries++;
234: sleep 1;
235: }
236: if($tieTries >= 3) {
237: return 'Coursemap undefined.';
238: }
239: } else {
240: return 'Can not open Coursemap.';
241: }
242:
243: # Initialize state machine. Set information pointing to top level map.
244: my (@sequences, @currentResource, @finishResource);
245: my ($currentSequence, $currentResourceID, $lastResourceID);
246:
247: $currentResourceID=$hash{'ids_/res/'.$ENV{'request.course.uri'}};
248: push(@currentResource, $currentResourceID);
249: $lastResourceID=-1;
250: $currentSequence=-1;
251: my $topLevelSequenceNumber = $currentSequence;
252:
253: while(1) {
254: if($c->aborted()) {
255: last;
256: }
257: # HANDLE NEW SEQUENCE!
258: #if page || sequence
259: if(defined($hash{'map_pc_'.$hash{'src_'.$currentResourceID}})) {
260: push(@sequences, $currentSequence);
261: push(@currentResource, $currentResourceID);
262: push(@finishResource, $lastResourceID);
263:
264: $currentSequence=$hash{'map_pc_'.$hash{'src_'.$currentResourceID}};
265:
266: # Mark sequence as containing problems. If it doesn't, then
267: # it will be removed when processing for this sequence is
268: # complete. This allows the problems in a sequence
269: # to be outputed before problems in the subsequences
270: if(!defined($cache->{'orderedSequences'})) {
271: $cache->{'orderedSequences'}=$currentSequence;
272: } else {
273: $cache->{'orderedSequences'}.=':'.$currentSequence;
274: }
275:
276: $lastResourceID=$hash{'map_finish_'.
277: $hash{'src_'.$currentResourceID}};
278: $currentResourceID=$hash{'map_start_'.
279: $hash{'src_'.$currentResourceID}};
280:
281: if(!($currentResourceID) || !($lastResourceID)) {
282: $currentSequence=pop(@sequences);
283: $currentResourceID=pop(@currentResource);
284: $lastResourceID=pop(@finishResource);
285: if($currentSequence eq $topLevelSequenceNumber) {
286: last;
287: }
288: }
289: }
290:
291: # Handle gradable resources: exams, problems, etc
292: $currentResourceID=~/(\d+)\.(\d+)/;
293: my $partA=$1;
294: my $partB=$2;
295: if($hash{'src_'.$currentResourceID}=~
296: /\.(problem|exam|quiz|assess|survey|form)$/ &&
297: $partA eq $currentSequence) {
298: my $Problem = &Apache::lonnet::symbclean(
299: &Apache::lonnet::declutter($hash{'map_id_'.$partA}).
300: '___'.$partB.'___'.
301: &Apache::lonnet::declutter($hash{'src_'.
302: $currentResourceID}));
303:
304: $cache->{$currentResourceID.':problem'}=$Problem;
305: if(!defined($cache->{$currentSequence.':problems'})) {
306: $cache->{$currentSequence.':problems'}=$currentResourceID;
307: } else {
308: $cache->{$currentSequence.':problems'}.=
309: ':'.$currentResourceID;
310: }
311:
312: # Get Parts for problem
313: my $meta=$hash{'src_'.$currentResourceID};
314: foreach (split(/\,/,&Apache::lonnet::metadata($meta,'keys'))) {
315: if($_=~/^stores\_(\d+)\_tries$/) {
316: my $Part=&Apache::lonnet::metadata($meta,$_.'.part');
317: if(!defined($cache->{$currentSequence.':'.
318: $currentResourceID.':parts'})) {
319: $cache->{$currentSequence.':'.$currentResourceID.
320: ':parts'}=$Part;
321: } else {
322: $cache->{$currentSequence.':'.$currentResourceID.
323: ':parts'}.=':'.$Part;
324: }
325: }
326: }
327: }
328:
329: # if resource == finish resource, then it is the end of a sequence/page
330: if($currentResourceID eq $lastResourceID) {
331: # pop off last resource of sequence
332: $currentResourceID=pop(@currentResource);
333: $lastResourceID=pop(@finishResource);
334:
335: if(defined($cache->{$currentSequence.':problems'})) {
336: # Capture sequence information here
337: $cache->{$currentSequence.':title'}=
338: $hash{'title_'.$currentResourceID};
339:
340: my $totalProblems=0;
341: foreach my $currentProblem (split(/\:/,
342: $cache->{$currentSequence.
343: ':problems'})) {
344: foreach (split(/\:/,$cache->{$currentSequence.':'.
345: $currentProblem.
346: ':parts'})) {
347: $totalProblems++;
348: }
349: }
350: my @titleLength=split(//,$cache->{$currentSequence.
351: ':title'});
352: # $extra is 3 for problems correct and 3 for space
353: # between problems correct and problem output
354: my $extra = 6;
355: if(($totalProblems + $extra) > (scalar @titleLength)) {
356: $cache->{$currentSequence.':columnWidth'}=
357: $totalProblems + $extra;
358: } else {
359: $cache->{$currentSequence.':columnWidth'}=
360: (scalar @titleLength);
361: }
362: } else {
363: # Remove sequence from list, if it contains no problems to
364: # display.
365: $cache->{'orderedSequences'}=~s/$currentSequence//;
366: $cache->{'orderedSequences'}=~s/::/:/g;
367: $cache->{'orderedSequences'}=~s/^:|:$//g;
368: }
369:
370: $currentSequence=pop(@sequences);
371: if($currentSequence eq $topLevelSequenceNumber) {
372: last;
373: }
374: }
375:
376: # MOVE!!!
377: # move to next resource
378: unless(defined($hash{'to_'.$currentResourceID})) {
379: # big problem, need to handle. Next is probably wrong
380: last;
381: }
382: my @nextResources=();
383: foreach (split(/\,/,$hash{'to_'.$currentResourceID})) {
384: push(@nextResources, $hash{'goesto_'.$_});
385: }
386: push(@currentResource, @nextResources);
387: # Set the next resource to be processed
388: $currentResourceID=pop(@currentResource);
389: }
390:
391: unless (untie(%hash)) {
392: &Apache::lonnet::logthis("<font color=blue>WARNING: ".
393: "Could not untie coursemap $fn (browse)".
394: ".</font>");
395: }
396:
397: return 'OK';
398: }
399:
400: =pod
401:
402: =item &ProcessSection()
403:
404: Determine the section number for a student for the class. A student can have
405: multiple sections for the same class. The correct one is chosen.
406:
407: =over 4
408:
409: Input: $sectionData, $courseid, $ActiveFlag
410:
411: $sectionData: A pointer to a hash containing all section data for this
412: student for the class
413:
414: $courseid: The course ID.
415:
416: $ActiveFlag: The student's active status (Active/Expired)
417:
418: Output: $oldsection, $cursection, or -1
419:
420: $oldsection and $cursection and sections number that will be displayed in the
421: chart.
422:
423: -1 is returned if an error occurs.
424:
425: =back
426:
427: =cut
428:
429: sub ProcessSection {
430: my ($sectionData,$courseid,$ActiveFlag)=@_;
431: $courseid=~s/\_/\//g;
432: $courseid=~s/^(\w)/\/$1/;
433:
434: my $cursection='-1';
435: my $oldsection='-1';
436: my $status='Expired';
437: my $section='';
438: foreach my $key (keys (%$sectionData)) {
439: my $value = $sectionData->{$key};
440: if ($key=~/^$courseid(?:\/)*(\w+)*\_st$/) {
441: $section=$1;
442: if($key eq $courseid.'_st') {
443: $section='';
444: }
445: my ($dummy,$end,$start)=split(/\_/,$value);
446: my $now=time;
447: my $notactive=0;
448: if ($start) {
449: if($now<$start) {
450: $notactive=1;
451: }
452: }
453: if($end) {
454: if ($now>$end) {
455: $notactive=1;
456: }
457: }
458: if($notactive == 0) {
459: $status='Active';
460: $cursection=$section;
461: last;
462: }
463: if($notactive == 1) {
464: $oldsection=$section;
465: }
466: }
467: }
468: if($status eq $ActiveFlag) {
469: if($cursection eq '-1') {
470: return $oldsection;
471: }
472: return $cursection;
473: }
474: if($ActiveFlag eq 'Any') {
475: if($cursection eq '-1') {
476: return $oldsection;
477: }
478: return $cursection;
479: }
480: return '-1';
481: }
482:
483: =pod
484:
485: =item &ProcessNamePIDSection()
486:
487: Takes data downloaded for a student and breaks it up into managable pieces and
488: stored in cache data. The username, domain, class related date, PID,
489: full name, and section are all processed here.
490:
491: =over 4
492:
493: Input: $cache, $studentInformation, $section, $date, $name, $courseID
494:
495: $cache: A hash pointer to store the data
496:
497: $studentInformation: Student information is what was requested in
498: &DownloadPrerequistedData(). See that function for what data is requested.
499:
500: $section: A hash pointer to class section related information.
501:
502: $date: A composite of the start and end date for this class for this
503: student. Format: end:start
504:
505: $name: the username:domain information
506:
507: $courseID: The course ID
508:
509: Output: None
510:
511: *NOTE: There is no return value, but if an error occurs a key is added to
512: the cache data with the value being the error message. The key is
513: username:domain:error. It will only exist if an error occurs.
514:
515: =back
516:
517: =cut
518:
519: sub ProcessStudentNamePIDSection {
520: my ($cache,$studentInformation,$section,$date,$name,$courseID,$status)=@_;
521: my ($studentName,$studentDomain) = split(/\:/,$name);
522:
523: $cache->{$name.':username'}=$studentName;
524: $cache->{$name.':domain'}=$studentDomain;
525: $cache->{$name.':date'}=$date;
526:
527: my ($checkForError)=keys(%$studentInformation);
528: if($checkForError =~ /^(con_lost|error|no_such_host)/i) {
529: $cache->{$name.':error'}=
530: 'Could not download student environment data.';
531: $cache->{$name.':fullname'}='';
532: $cache->{$name.':id'}='';
533: } else {
534: $cache->{$name.':fullname'}=&ProcessFullName(
535: $studentInformation->{'lastname'},
536: $studentInformation->{'generation'},
537: $studentInformation->{'firstname'},
538: $studentInformation->{'middlename'});
539: $cache->{$name.':id'}=$studentInformation->{'id'};
540: }
541:
542: # Get student's section number
543: my $sec=&ProcessSection($section, $courseID, $status);
544: if($sec != -1) {
545: $cache->{$name.':section'}=$sec;
546: } else {
547: $cache->{$name.':section'}='';
548: }
549:
550: return;
551: }
552:
553: =pod
554:
555: =item &ProcessClassList()
556:
557: Taking the class list dumped from &DownloadPrerequisiteData(), all the
558: students and their non-class information is processed using the
559: &ProcessStudentInformation() function. A date stamp is also recorded for
560: when the data was processed.
561:
562: =over 4
563:
564: Input: $cache, $classlist, $courseID, $ChartDB, $c
565:
566: $cache: A hash pointer to store the data
567:
568: $classlist: The hash of data collected about a student from
569: &DownloadPrerequisteData(). The hash contains a list of students, a pointer
570: to a hash of student information for each student, and each student's section
571: number.
572:
573: $courseID: The course ID
574:
575: $ChartDB: The name of the cache database file.
576:
577: $c: The connection class used to determine if an abort has been sent to the
578: browser
579:
580: Output: @names
581:
582: @names: An array of students whose information has been processed, and are to
583: be considered in an arbitrary order.
584:
585: =back
586:
587: =cut
588:
589: sub ProcessClassList {
590: my ($cache,$classlist,$courseID,$status,$c)=@_;
591: my @names=();
592:
593: foreach my $name (keys(%$classlist)) {
594: if($name =~ /\:section/ || $name =~ /\:studentInformation/ ||
595: $name eq '') {
596: next;
597: }
598: if($c->aborted()) {
599: last;
600: }
601: push(@names,$name);
602: &ProcessStudentNamePIDSection($cache,
603: $classlist->{$name.':studentInformation'},
604: $classlist->{$name.':section'},
605: $classlist->{$name},
606: $name,$courseID,$status);
607: }
608:
609: # Time of download
610: $cache->{'time'}=localtime();
611:
612: return @names;
613: }
614:
615: =pod
616:
617: =item &ProcessStudentData()
618:
619: Takes the course data downloaded for a student in
620: &DownloadStudentCourseInformation() and breaks it up into key value pairs
621: to be stored in the cached data. The keys are comprised of the
622: $username:$domain:$keyFromCourseDatabase. The student username:domain is
623: stored away signifying that the student's information has been downloaded and
624: can be reused from cached data.
625:
626: =over 4
627:
628: Input: $cache, $courseData, $name
629:
630: $cache: A hash pointer to store data
631:
632: $courseData: A hash pointer that points to the course data downloaded for a
633: student.
634:
635: $name: username:domain
636:
637: Output: None
638:
639: *NOTE: There is no output, but an error message is stored away in the cache
640: data. This is checked in &FormatStudentData(). The key username:domain:error
641: will only exist if an error occured. The error is an error from
642: &DownloadStudentCourseInformation().
643:
644: =back
645:
646: =cut
647:
648: sub ProcessStudentData {
649: my ($cache,$courseData,$name)=@_;
650:
651: my ($checkForError) = keys(%$courseData);
652: if($checkForError =~ /^(con_lost|error|no_such_host)/i) {
653: $cache->{$name.':error'}='Could not download course data.';
654: } else {
655: foreach my $key (keys (%$courseData)) {
656: $cache->{$name.':'.$key}=$courseData->{$key};
657: }
658: if(defined($cache->{'NamesOfStudents'})) {
659: $cache->{'NamesOfStudents'}.=':::'.$name;
660: } else {
661: $cache->{'NamesOfStudents'}=$name;
662: }
663: }
664:
665: return;
666: }
667:
668: # ----- END PROCESSING FUNCTIONS ---------------------------------------
669:
670: =pod
671:
672: =head1 HELPER FUNCTIONS
673:
674: These are just a couple of functions do various odd and end
675: jobs.
676:
677: =cut
678:
679: # ----- HELPER FUNCTIONS -----------------------------------------------
680:
681: =pod
682:
683: =item &ProcessFullName()
684:
685: Takes lastname, generation, firstname, and middlename (or some partial
686: set of this data) and returns the full name version as a string. Format
687: is Lastname generation, firstname middlename or a subset of this.
688:
689: =cut
690:
691: sub ProcessFullName {
692: my ($lastname, $generation, $firstname, $middlename)=@_;
693: my $Str = '';
694:
695: if($lastname ne '') {
696: $Str .= $lastname.' ';
697: if($generation ne '') {
698: $Str .= $generation;
699: } else {
700: chop($Str);
701: }
702: $Str .= ', ';
703: if($firstname ne '') {
704: $Str .= $firstname.' ';
705: }
706: if($middlename ne '') {
707: $Str .= $middlename;
708: } else {
709: chop($Str);
710: if($firstname eq '') {
711: chop($Str);
712: }
713: }
714: } else {
715: if($firstname ne '') {
716: $Str .= $firstname.' ';
717: }
718: if($middlename ne '') {
719: $Str .= $middlename.' ';
720: }
721: if($generation ne '') {
722: $Str .= $generation;
723: } else {
724: chop($Str);
725: }
726: }
727:
728: return $Str;
729: }
730:
731: =pod
732:
733: =item &TestCacheData()
734:
735: Determine if the cache database can be accessed with a tie. It waits up to
736: ten seconds before returning failure. This function exists to help with
737: the problems with stopping the data download. When an abort occurs and the
738: user quickly presses a form button and httpd child is created. This
739: child needs to wait for the other to finish (hopefully within ten seconds).
740:
741: =over 4
742:
743: Input: $ChartDB
744:
745: $ChartDB: The name of the cache database to be opened
746:
747: Output: -1, 0, 1
748:
749: -1: Couldn't tie database
750: 0: Use cached data
751: 1: New cache database created, use that.
752:
753: =back
754:
755: =cut
756:
757: sub TestCacheData {
758: my ($ChartDB,$isRecalculate,$totalDelay)=@_;
759: my $isCached=-1;
760: my %testData;
761: my $tieTries=0;
762:
763: if(!defined($totalDelay)) {
764: $totalDelay = 10;
765: }
766:
767: if ((-e "$ChartDB") && (!$isRecalculate)) {
768: $isCached = 1;
769: } else {
770: $isCached = 0;
771: }
772:
773: while($tieTries < $totalDelay) {
774: my $result=0;
775: if($isCached) {
776: $result=tie(%testData,'GDBM_File',$ChartDB,&GDBM_READER,0640);
777: } else {
778: $result=tie(%testData,'GDBM_File',$ChartDB,&GDBM_NEWDB,0640);
779: }
780: if($result) {
781: last;
782: }
783: $tieTries++;
784: sleep 1;
785: }
786: if($tieTries >= $totalDelay) {
787: return -1;
788: }
789:
790: untie(%testData);
791:
792: return $isCached;
793: }
794:
795: # ----- END HELPER FUNCTIONS --------------------------------------------
796:
797: 1;
798: __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