Annotation of loncom/interface/loncoursedata.pm, revision 1.12
1.1 stredwic 1: # The LearningOnline Network with CAPA
2: # (Publication Handler
3: #
1.12 ! stredwic 4: # $Id: loncoursedata.pm,v 1.11 2002/08/03 18:47:24 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();
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:
1.3 stredwic 73: =item &DownloadClasslist()
1.1 stredwic 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:
1.3 stredwic 104: sub DownloadClasslist {
105: my ($courseID, $lastDownloadTime, $c)=@_;
1.1 stredwic 106: my ($courseDomain,$courseNumber)=split(/\_/,$courseID);
1.3 stredwic 107: my %classlist;
1.1 stredwic 108:
1.7 stredwic 109: my $modifiedTime = &GetFileTimestamp($courseDomain, $courseNumber,
110: 'classlist.db',
111: $Apache::lonnet::perlvar{'lonUsersDir'});
112:
113: if($lastDownloadTime ne 'Not downloaded' &&
114: $lastDownloadTime >= $modifiedTime && $modifiedTime >= 0) {
115: $classlist{'lastDownloadTime'}=time;
116: $classlist{'UpToDate'} = 'true';
117: return \%classlist;
118: }
1.3 stredwic 119:
120: %classlist=&Apache::lonnet::dump('classlist',$courseDomain, $courseNumber);
1.1 stredwic 121: my ($checkForError)=keys (%classlist);
122: if($checkForError =~ /^(con_lost|error|no_such_host)/i) {
123: return \%classlist;
124: }
125:
126: foreach my $name (keys(%classlist)) {
127: if($c->aborted()) {
128: $classlist{'error'}='aborted';
129: return \%classlist;
130: }
131:
132: my ($studentName,$studentDomain) = split(/\:/,$name);
133: # Download student environment data, specifically the full name and id.
134: my %studentInformation=&Apache::lonnet::get('environment',
135: ['lastname','generation',
136: 'firstname','middlename',
137: 'id'],
138: $studentDomain,
139: $studentName);
140: $classlist{$name.':studentInformation'}=\%studentInformation;
141:
142: if($c->aborted()) {
143: $classlist{'error'}='aborted';
144: return \%classlist;
145: }
146:
147: #Section
148: my %section=&Apache::lonnet::dump('roles',$studentDomain,$studentName);
1.3 stredwic 149: $classlist{$name.':sections'}=\%section;
1.1 stredwic 150: }
151:
1.3 stredwic 152: $classlist{'UpToDate'} = 'false';
153: $classlist{'lastDownloadTime'}=time;
154:
1.1 stredwic 155: return \%classlist;
156: }
157:
158: =pod
159:
1.4 stredwic 160: =item &DownloadCourseInformation()
1.1 stredwic 161:
162: Dump of all the course information for a single student. There is no
1.3 stredwic 163: pruning of data, it is all stored in a hash and returned. It also
164: checks the timestamp of the students course database file and only downloads
165: if it has been modified since the last download.
1.1 stredwic 166:
167: =over 4
168:
169: Input: $name, $courseID
170:
171: $name: student name:domain
172:
173: $courseID: The id of the course
174:
175: Output: \%courseData
176:
177: \%courseData: A hash pointer to the raw data from the student's course
178: database.
179:
180: =back
181:
182: =cut
183:
1.4 stredwic 184: sub DownloadCourseInformation {
1.12 ! stredwic 185: my ($namedata,$courseID,$lastDownloadTime,$WhatIWant)=@_;
1.3 stredwic 186: my %courseData;
1.4 stredwic 187: my ($name,$domain) = split(/\:/,$namedata);
1.1 stredwic 188:
1.7 stredwic 189: my $modifiedTime = &GetFileTimestamp($domain, $name,
190: $courseID.'.db',
191: $Apache::lonnet::perlvar{'lonUsersDir'});
192:
193: if($lastDownloadTime >= $modifiedTime) {
194: $courseData{'lastDownloadTime'}=time;
195: $courseData{'UpToDate'} = 'true';
196: return \%courseData;
197: }
1.3 stredwic 198:
1.4 stredwic 199: # Download course data
1.12 ! stredwic 200: if(!defined($WhatIWant)) {
! 201: $WhatIWant = '.';
! 202: }
! 203: %courseData=&Apache::lonnet::dump($courseID, $domain, $name, $WhatIWant);
1.3 stredwic 204: $courseData{'UpToDate'} = 'false';
205: $courseData{'lastDownloadTime'}=time;
1.1 stredwic 206: return \%courseData;
207: }
208:
209: # ----- END DOWNLOAD INFORMATION ---------------------------------------
210:
211: =pod
212:
213: =head1 PROCESSING FUNCTIONS
214:
215: These functions process all the data for all the students. Also, they
216: are the only functions that access the cache database for writing. Thus
217: they are the only functions that cache data. The downloading and caching
218: were separated to reduce problems with stopping downloading then can't
219: tie hash to database later.
220:
221: =cut
222:
223: # ----- PROCESSING FUNCTIONS ---------------------------------------
224:
225: =pod
226:
227: =item &ProcessTopResourceMap()
228:
229: Trace through the "big hash" created in rat/lonuserstate.pm::loadmap.
230: Basically, this function organizes a subset of the data and stores it in
231: cached data. The data stored is the problems, sequences, sequence titles,
232: parts of problems, and their ordering. Column width information is also
233: partially handled here on a per sequence basis.
234:
235: =over 4
236:
237: Input: $cache, $c
238:
239: $cache: A pointer to a hash to store the information
240:
241: $c: The connection class used to determine if an abort has been sent to the
242: browser
243:
244: Output: A string that contains an error message or "OK" if everything went
245: smoothly.
246:
247: =back
248:
249: =cut
250:
251: sub ProcessTopResourceMap {
1.11 stredwic 252: my ($cache,$c)=@_;
1.1 stredwic 253: my %hash;
254: my $fn=$ENV{'request.course.fn'};
255: if(-e "$fn.db") {
256: my $tieTries=0;
257: while($tieTries < 3) {
258: if($c->aborted()) {
259: return;
260: }
1.10 stredwic 261: if(tie(%hash,'GDBM_File',"$fn.db",&GDBM_READER(),0640)) {
1.1 stredwic 262: last;
263: }
264: $tieTries++;
265: sleep 1;
266: }
267: if($tieTries >= 3) {
268: return 'Coursemap undefined.';
269: }
270: } else {
271: return 'Can not open Coursemap.';
272: }
273:
274: # Initialize state machine. Set information pointing to top level map.
275: my (@sequences, @currentResource, @finishResource);
276: my ($currentSequence, $currentResourceID, $lastResourceID);
277:
278: $currentResourceID=$hash{'ids_/res/'.$ENV{'request.course.uri'}};
279: push(@currentResource, $currentResourceID);
280: $lastResourceID=-1;
281: $currentSequence=-1;
282: my $topLevelSequenceNumber = $currentSequence;
283:
1.12 ! stredwic 284: my $problemCount=0;
! 285: my $problemCount2=0;
1.11 stredwic 286: my %sequenceRecord;
1.12 ! stredwic 287: my $sequenceCount=0;
! 288: my $sequenceCount2=0;
1.1 stredwic 289: while(1) {
290: if($c->aborted()) {
291: last;
292: }
293: # HANDLE NEW SEQUENCE!
294: #if page || sequence
1.11 stredwic 295: if(defined($hash{'map_pc_'.$hash{'src_'.$currentResourceID}}) &&
296: !defined($sequenceRecord{$currentResourceID})) {
1.12 ! stredwic 297: $sequenceCount++;
1.11 stredwic 298: $sequenceRecord{$currentResourceID}++;
1.1 stredwic 299: push(@sequences, $currentSequence);
300: push(@currentResource, $currentResourceID);
301: push(@finishResource, $lastResourceID);
302:
303: $currentSequence=$hash{'map_pc_'.$hash{'src_'.$currentResourceID}};
304:
305: # Mark sequence as containing problems. If it doesn't, then
306: # it will be removed when processing for this sequence is
307: # complete. This allows the problems in a sequence
308: # to be outputed before problems in the subsequences
309: if(!defined($cache->{'orderedSequences'})) {
310: $cache->{'orderedSequences'}=$currentSequence;
311: } else {
312: $cache->{'orderedSequences'}.=':'.$currentSequence;
313: }
314:
315: $lastResourceID=$hash{'map_finish_'.
316: $hash{'src_'.$currentResourceID}};
317: $currentResourceID=$hash{'map_start_'.
318: $hash{'src_'.$currentResourceID}};
319:
320: if(!($currentResourceID) || !($lastResourceID)) {
321: $currentSequence=pop(@sequences);
322: $currentResourceID=pop(@currentResource);
323: $lastResourceID=pop(@finishResource);
324: if($currentSequence eq $topLevelSequenceNumber) {
325: last;
326: }
327: }
1.12 ! stredwic 328: next;
1.1 stredwic 329: }
330:
331: # Handle gradable resources: exams, problems, etc
332: $currentResourceID=~/(\d+)\.(\d+)/;
333: my $partA=$1;
334: my $partB=$2;
1.12 ! stredwic 335: if($hash{'src_'.$currentResourceID}=~/\.problem$/) {
! 336: $problemCount++;
! 337: }
1.1 stredwic 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})) {
1.12 ! stredwic 343: $problemCount2++;
1.11 stredwic 344: $sequenceRecord{$currentSequence.':'.$currentResourceID}++;
1.1 stredwic 345: my $Problem = &Apache::lonnet::symbclean(
346: &Apache::lonnet::declutter($hash{'map_id_'.$partA}).
347: '___'.$partB.'___'.
348: &Apache::lonnet::declutter($hash{'src_'.
349: $currentResourceID}));
350:
351: $cache->{$currentResourceID.':problem'}=$Problem;
352: if(!defined($cache->{$currentSequence.':problems'})) {
353: $cache->{$currentSequence.':problems'}=$currentResourceID;
354: } else {
355: $cache->{$currentSequence.':problems'}.=
356: ':'.$currentResourceID;
357: }
358:
1.2 stredwic 359: my $meta=$hash{'src_'.$currentResourceID};
360: # $cache->{$currentResourceID.':title'}=
361: # &Apache::lonnet::metdata($meta,'title');
362: $cache->{$currentResourceID.':title'}=
363: $hash{'title_'.$currentResourceID};
1.9 minaeibi 364: $cache->{$currentResourceID.':source'}=
365: $hash{'src_'.$currentResourceID};
1.2 stredwic 366:
1.1 stredwic 367: # Get Parts for problem
1.8 stredwic 368: my %beenHere;
369: foreach (split(/\,/,&Apache::lonnet::metadata($meta,'packages'))) {
370: if(/^\w+response_\d+.*/) {
371: my (undef, $partId, $responseId) = split(/_/,$_);
372: if($beenHere{'p:'.$partId} == 0) {
373: $beenHere{'p:'.$partId}++;
374: if(!defined($cache->{$currentSequence.':'.
375: $currentResourceID.':parts'})) {
376: $cache->{$currentSequence.':'.$currentResourceID.
377: ':parts'}=$partId;
378: } else {
379: $cache->{$currentSequence.':'.$currentResourceID.
380: ':parts'}.=':'.$partId;
381: }
382: }
383: if($beenHere{'r:'.$partId.':'.$responseId} == 0) {
384: $beenHere{'r:'.$partId.':'.$responseId}++;
385: if(!defined($cache->{$currentSequence.':'.
386: $currentResourceID.':'.$partId.
387: ':responseIDs'})) {
388: $cache->{$currentSequence.':'.$currentResourceID.
389: ':'.$partId.':responseIDs'}=$responseId;
390: } else {
391: $cache->{$currentSequence.':'.$currentResourceID.
392: ':'.$partId.':responseIDs'}.=':'.
393: $responseId;
394: }
1.1 stredwic 395: }
1.8 stredwic 396: if(/^optionresponse/ &&
397: $beenHere{'o:'.$partId.':'.$currentResourceID} == 0) {
398: $beenHere{'o:'.$partId.$currentResourceID}++;
399: if(defined($cache->{'OptionResponses'})) {
400: $cache->{'OptionResponses'}.= ':::'.
401: $currentResourceID.':'.
402: $partId.':'.$responseId;
403: } else {
404: $cache->{'OptionResponses'}= $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'})) {
1.12 ! stredwic 419: $sequenceCount2++;
1.1 stredwic 420: # Capture sequence information here
421: $cache->{$currentSequence.':title'}=
422: $hash{'title_'.$currentResourceID};
1.2 stredwic 423: $cache->{$currentSequence.':source'}=
424: $hash{'src_'.$currentResourceID};
1.1 stredwic 425:
426: my $totalProblems=0;
427: foreach my $currentProblem (split(/\:/,
428: $cache->{$currentSequence.
429: ':problems'})) {
430: foreach (split(/\:/,$cache->{$currentSequence.':'.
431: $currentProblem.
432: ':parts'})) {
433: $totalProblems++;
434: }
435: }
436: my @titleLength=split(//,$cache->{$currentSequence.
437: ':title'});
438: # $extra is 3 for problems correct and 3 for space
439: # between problems correct and problem output
440: my $extra = 6;
441: if(($totalProblems + $extra) > (scalar @titleLength)) {
442: $cache->{$currentSequence.':columnWidth'}=
443: $totalProblems + $extra;
444: } else {
445: $cache->{$currentSequence.':columnWidth'}=
446: (scalar @titleLength);
447: }
448: } else {
449: # Remove sequence from list, if it contains no problems to
450: # display.
451: $cache->{'orderedSequences'}=~s/$currentSequence//;
452: $cache->{'orderedSequences'}=~s/::/:/g;
453: $cache->{'orderedSequences'}=~s/^:|:$//g;
454: }
455:
456: $currentSequence=pop(@sequences);
457: if($currentSequence eq $topLevelSequenceNumber) {
458: last;
459: }
1.11 stredwic 460: }
1.1 stredwic 461:
462: # MOVE!!!
463: # move to next resource
464: unless(defined($hash{'to_'.$currentResourceID})) {
465: # big problem, need to handle. Next is probably wrong
1.11 stredwic 466: my $errorMessage = 'Big problem in ';
467: $errorMessage .= 'loncoursedata::ProcessTopLevelMap.';
468: $errorMessage .= ' bighash to_$currentResourceID not defined!';
469: &Apache::lonnet::logthis($errorMessage);
1.1 stredwic 470: last;
471: }
472: my @nextResources=();
473: foreach (split(/\,/,$hash{'to_'.$currentResourceID})) {
1.11 stredwic 474: if(!defined($sequenceRecord{$currentSequence.':'.
475: $hash{'goesto_'.$_}})) {
476: push(@nextResources, $hash{'goesto_'.$_});
477: }
1.1 stredwic 478: }
479: push(@currentResource, @nextResources);
480: # Set the next resource to be processed
481: $currentResourceID=pop(@currentResource);
482: }
483:
1.12 ! stredwic 484: $cache->{'jasoncount'}=$problemCount;
! 485: $cache->{'jasoncount2'}=$problemCount2;
! 486: $cache->{'jasonseq'}=$sequenceCount;
! 487: $cache->{'jasonseq2'}=$sequenceCount2;
1.1 stredwic 488: unless (untie(%hash)) {
489: &Apache::lonnet::logthis("<font color=blue>WARNING: ".
490: "Could not untie coursemap $fn (browse)".
491: ".</font>");
492: }
493:
494: return 'OK';
495: }
496:
497: =pod
498:
1.3 stredwic 499: =item &ProcessClasslist()
1.1 stredwic 500:
1.3 stredwic 501: Taking the class list dumped from &DownloadClasslist(), all the
1.1 stredwic 502: students and their non-class information is processed using the
503: &ProcessStudentInformation() function. A date stamp is also recorded for
504: when the data was processed.
505:
1.3 stredwic 506: Takes data downloaded for a student and breaks it up into managable pieces and
507: stored in cache data. The username, domain, class related date, PID,
508: full name, and section are all processed here.
509:
510:
1.1 stredwic 511: =over 4
512:
513: Input: $cache, $classlist, $courseID, $ChartDB, $c
514:
515: $cache: A hash pointer to store the data
516:
517: $classlist: The hash of data collected about a student from
1.3 stredwic 518: &DownloadClasslist(). The hash contains a list of students, a pointer
1.1 stredwic 519: to a hash of student information for each student, and each student's section
520: number.
521:
522: $courseID: The course ID
523:
524: $ChartDB: The name of the cache database file.
525:
526: $c: The connection class used to determine if an abort has been sent to the
527: browser
528:
529: Output: @names
530:
531: @names: An array of students whose information has been processed, and are to
532: be considered in an arbitrary order.
533:
534: =back
535:
536: =cut
537:
1.3 stredwic 538: sub ProcessClasslist {
539: my ($cache,$classlist,$courseID,$c)=@_;
1.1 stredwic 540: my @names=();
541:
1.3 stredwic 542: $cache->{'ClasslistTimeStamp'}=$classlist->{'lastDownloadTime'};
543: if($classlist->{'UpToDate'} eq 'true') {
544: return split(/:::/,$cache->{'NamesOfStudents'});;
545: }
546:
1.1 stredwic 547: foreach my $name (keys(%$classlist)) {
548: if($name =~ /\:section/ || $name =~ /\:studentInformation/ ||
1.3 stredwic 549: $name eq '' || $name eq 'UpToDate' || $name eq 'lastDownloadTime') {
1.1 stredwic 550: next;
551: }
552: if($c->aborted()) {
1.3 stredwic 553: return ();
1.1 stredwic 554: }
555: push(@names,$name);
1.3 stredwic 556: my $studentInformation = $classlist->{$name.':studentInformation'},
557: my $sectionData = $classlist->{$name.':sections'},
558: my $date = $classlist->{$name},
559: my ($studentName,$studentDomain) = split(/\:/,$name);
560:
561: $cache->{$name.':username'}=$studentName;
562: $cache->{$name.':domain'}=$studentDomain;
1.10 stredwic 563: # Initialize timestamp for student
1.3 stredwic 564: if(!defined($cache->{$name.':lastDownloadTime'})) {
565: $cache->{$name.':lastDownloadTime'}='Not downloaded';
1.6 stredwic 566: $cache->{$name.':updateTime'}=' Not updated';
1.3 stredwic 567: }
568:
569: my ($checkForError)=keys(%$studentInformation);
570: if($checkForError =~ /^(con_lost|error|no_such_host)/i) {
571: $cache->{$name.':error'}=
572: 'Could not download student environment data.';
573: $cache->{$name.':fullname'}='';
574: $cache->{$name.':id'}='';
575: } else {
576: $cache->{$name.':fullname'}=&ProcessFullName(
577: $studentInformation->{'lastname'},
578: $studentInformation->{'generation'},
579: $studentInformation->{'firstname'},
580: $studentInformation->{'middlename'});
581: $cache->{$name.':id'}=$studentInformation->{'id'};
582: }
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.3 stredwic 665: if($courseData->{'UpToDate'} eq 'true') {
666: $cache->{$name.':lastDownloadTime'}=$courseData->{'lastDownloadTime'};
1.6 stredwic 667: if($courseData->{'lastDownloadTime'} eq 'Not downloaded') {
668: $cache->{$name.':updateTime'} = ' Not updated';
669: } else {
670: $cache->{$name.':updateTime'}=
671: localtime($courseData->{'lastDownloadTime'});
672: }
1.3 stredwic 673: return;
674: }
675:
676: my @courseKeys = keys(%$courseData);
677:
678: foreach (@courseKeys) {
679: if(/^(con_lost|error|no_such_host)/i) {
680: $cache->{$name.':error'}='Could not download course data.';
681: return;
1.1 stredwic 682: }
1.3 stredwic 683: }
684:
685: $cache->{$name.':lastDownloadTime'}=$courseData->{'lastDownloadTime'};
1.6 stredwic 686: if($courseData->{'lastDownloadTime'} eq 'Not downloaded') {
687: $cache->{$name.':updateTime'} = ' Not updated';
688: } else {
689: $cache->{$name.':updateTime'}=
690: localtime($courseData->{'lastDownloadTime'});
691: }
1.3 stredwic 692: foreach (@courseKeys) {
693: $cache->{$name.':'.$_}=$courseData->{$_};
1.1 stredwic 694: }
695:
696: return;
1.4 stredwic 697: }
698:
699: sub LoadDiscussion {
1.5 minaeibi 700: my ( $courseID)=@_;
701: my %Discuss=();
702: my %contrib=&Apache::lonnet::dump(
703: $courseID,
704: $ENV{'course.'.$courseID.'.domain'},
705: $ENV{'course.'.$courseID.'.num'});
706:
707: #my %contrib=&DownloadCourseInformation($name, $courseID, 0);
708:
1.4 stredwic 709: foreach my $temp(keys %contrib) {
710: if ($temp=~/^version/) {
711: my $ver=$contrib{$temp};
712: my ($dummy,$prb)=split(':',$temp);
713: for (my $idx=1; $idx<=$ver; $idx++ ) {
714: my $name=$contrib{"$idx:$prb:sendername"};
1.5 minaeibi 715: $Discuss{"$name:$prb"}=$idx;
1.4 stredwic 716: }
717: }
718: }
1.5 minaeibi 719:
720: return \%Discuss;
1.1 stredwic 721: }
722:
723: # ----- END PROCESSING FUNCTIONS ---------------------------------------
724:
725: =pod
726:
727: =head1 HELPER FUNCTIONS
728:
729: These are just a couple of functions do various odd and end
730: jobs.
731:
732: =cut
733:
734: # ----- HELPER FUNCTIONS -----------------------------------------------
735:
736: =pod
737:
738: =item &ProcessFullName()
739:
740: Takes lastname, generation, firstname, and middlename (or some partial
741: set of this data) and returns the full name version as a string. Format
742: is Lastname generation, firstname middlename or a subset of this.
743:
744: =cut
745:
746: sub ProcessFullName {
747: my ($lastname, $generation, $firstname, $middlename)=@_;
748: my $Str = '';
749:
750: if($lastname ne '') {
751: $Str .= $lastname.' ';
752: if($generation ne '') {
753: $Str .= $generation;
754: } else {
755: chop($Str);
756: }
757: $Str .= ', ';
758: if($firstname ne '') {
759: $Str .= $firstname.' ';
760: }
761: if($middlename ne '') {
762: $Str .= $middlename;
763: } else {
764: chop($Str);
765: if($firstname eq '') {
766: chop($Str);
767: }
768: }
769: } else {
770: if($firstname ne '') {
771: $Str .= $firstname.' ';
772: }
773: if($middlename ne '') {
774: $Str .= $middlename.' ';
775: }
776: if($generation ne '') {
777: $Str .= $generation;
778: } else {
779: chop($Str);
780: }
781: }
782:
783: return $Str;
784: }
785:
786: =pod
787:
788: =item &TestCacheData()
789:
790: Determine if the cache database can be accessed with a tie. It waits up to
791: ten seconds before returning failure. This function exists to help with
792: the problems with stopping the data download. When an abort occurs and the
793: user quickly presses a form button and httpd child is created. This
794: child needs to wait for the other to finish (hopefully within ten seconds).
795:
796: =over 4
797:
798: Input: $ChartDB
799:
800: $ChartDB: The name of the cache database to be opened
801:
802: Output: -1, 0, 1
803:
804: -1: Couldn't tie database
805: 0: Use cached data
806: 1: New cache database created, use that.
807:
808: =back
809:
810: =cut
811:
812: sub TestCacheData {
813: my ($ChartDB,$isRecalculate,$totalDelay)=@_;
814: my $isCached=-1;
815: my %testData;
816: my $tieTries=0;
817:
818: if(!defined($totalDelay)) {
819: $totalDelay = 10;
820: }
821:
822: if ((-e "$ChartDB") && (!$isRecalculate)) {
823: $isCached = 1;
824: } else {
825: $isCached = 0;
826: }
827:
828: while($tieTries < $totalDelay) {
829: my $result=0;
830: if($isCached) {
1.10 stredwic 831: $result=tie(%testData,'GDBM_File',$ChartDB,&GDBM_READER(),0640);
1.1 stredwic 832: } else {
1.10 stredwic 833: $result=tie(%testData,'GDBM_File',$ChartDB,&GDBM_NEWDB(),0640);
1.1 stredwic 834: }
835: if($result) {
836: last;
837: }
838: $tieTries++;
839: sleep 1;
840: }
841: if($tieTries >= $totalDelay) {
842: return -1;
843: }
844:
845: untie(%testData);
846:
847: return $isCached;
848: }
1.2 stredwic 849:
1.3 stredwic 850: sub GetFileTimestamp {
851: my ($studentDomain,$studentName,$filename,$root)=@_;
852: $studentDomain=~s/\W//g;
853: $studentName=~s/\W//g;
854: my $subdir=$studentName.'__';
855: $subdir =~ s/(.)(.)(.).*/$1\/$2\/$3/;
856: my $proname="$studentDomain/$subdir/$studentName";
857: $proname .= '/'.$filename;
858: my @dir = &Apache::lonnet::dirlist($proname, $studentDomain, $studentName,
859: $root);
860: my $fileStat = $dir[0];
861: my @stats = split('&', $fileStat);
862: if(@stats) {
863: return $stats[9];
864: } else {
865: return -1;
866: }
867: }
1.1 stredwic 868:
869: # ----- END HELPER FUNCTIONS --------------------------------------------
870:
871: 1;
872: __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