Annotation of loncom/interface/loncoursedata.pm, revision 1.9
1.1 stredwic 1: # The LearningOnline Network with CAPA
2: # (Publication Handler
3: #
1.9 ! minaeibi 4: # $Id: loncoursedata.pm,v 1.8 2002/07/30 21:31:48 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 {
185: my ($namedata,$courseID,$lastDownloadTime)=@_;
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
200: %courseData=&Apache::lonnet::dump($courseID, $domain, $name);
1.3 stredwic 201: $courseData{'UpToDate'} = 'false';
202: $courseData{'lastDownloadTime'}=time;
1.1 stredwic 203: return \%courseData;
204: }
205:
206: # ----- END DOWNLOAD INFORMATION ---------------------------------------
207:
208: =pod
209:
210: =head1 PROCESSING FUNCTIONS
211:
212: These functions process all the data for all the students. Also, they
213: are the only functions that access the cache database for writing. Thus
214: they are the only functions that cache data. The downloading and caching
215: were separated to reduce problems with stopping downloading then can't
216: tie hash to database later.
217:
218: =cut
219:
220: # ----- PROCESSING FUNCTIONS ---------------------------------------
221:
222: =pod
223:
224: =item &ProcessTopResourceMap()
225:
226: Trace through the "big hash" created in rat/lonuserstate.pm::loadmap.
227: Basically, this function organizes a subset of the data and stores it in
228: cached data. The data stored is the problems, sequences, sequence titles,
229: parts of problems, and their ordering. Column width information is also
230: partially handled here on a per sequence basis.
231:
232: =over 4
233:
234: Input: $cache, $c
235:
236: $cache: A pointer to a hash to store the information
237:
238: $c: The connection class used to determine if an abort has been sent to the
239: browser
240:
241: Output: A string that contains an error message or "OK" if everything went
242: smoothly.
243:
244: =back
245:
246: =cut
247:
248: sub ProcessTopResourceMap {
249: my ($cache,$c)=@_;
250: my %hash;
251: my $fn=$ENV{'request.course.fn'};
252: if(-e "$fn.db") {
253: my $tieTries=0;
254: while($tieTries < 3) {
255: if($c->aborted()) {
256: return;
257: }
258: if(tie(%hash,'GDBM_File',"$fn.db",&GDBM_READER,0640)) {
259: last;
260: }
261: $tieTries++;
262: sleep 1;
263: }
264: if($tieTries >= 3) {
265: return 'Coursemap undefined.';
266: }
267: } else {
268: return 'Can not open Coursemap.';
269: }
270:
271: # Initialize state machine. Set information pointing to top level map.
272: my (@sequences, @currentResource, @finishResource);
273: my ($currentSequence, $currentResourceID, $lastResourceID);
274:
275: $currentResourceID=$hash{'ids_/res/'.$ENV{'request.course.uri'}};
276: push(@currentResource, $currentResourceID);
277: $lastResourceID=-1;
278: $currentSequence=-1;
279: my $topLevelSequenceNumber = $currentSequence;
280:
281: while(1) {
282: if($c->aborted()) {
283: last;
284: }
285: # HANDLE NEW SEQUENCE!
286: #if page || sequence
287: if(defined($hash{'map_pc_'.$hash{'src_'.$currentResourceID}})) {
288: push(@sequences, $currentSequence);
289: push(@currentResource, $currentResourceID);
290: push(@finishResource, $lastResourceID);
291:
292: $currentSequence=$hash{'map_pc_'.$hash{'src_'.$currentResourceID}};
293:
294: # Mark sequence as containing problems. If it doesn't, then
295: # it will be removed when processing for this sequence is
296: # complete. This allows the problems in a sequence
297: # to be outputed before problems in the subsequences
298: if(!defined($cache->{'orderedSequences'})) {
299: $cache->{'orderedSequences'}=$currentSequence;
300: } else {
301: $cache->{'orderedSequences'}.=':'.$currentSequence;
302: }
303:
304: $lastResourceID=$hash{'map_finish_'.
305: $hash{'src_'.$currentResourceID}};
306: $currentResourceID=$hash{'map_start_'.
307: $hash{'src_'.$currentResourceID}};
308:
309: if(!($currentResourceID) || !($lastResourceID)) {
310: $currentSequence=pop(@sequences);
311: $currentResourceID=pop(@currentResource);
312: $lastResourceID=pop(@finishResource);
313: if($currentSequence eq $topLevelSequenceNumber) {
314: last;
315: }
316: }
317: }
318:
319: # Handle gradable resources: exams, problems, etc
320: $currentResourceID=~/(\d+)\.(\d+)/;
321: my $partA=$1;
322: my $partB=$2;
323: if($hash{'src_'.$currentResourceID}=~
324: /\.(problem|exam|quiz|assess|survey|form)$/ &&
325: $partA eq $currentSequence) {
326: my $Problem = &Apache::lonnet::symbclean(
327: &Apache::lonnet::declutter($hash{'map_id_'.$partA}).
328: '___'.$partB.'___'.
329: &Apache::lonnet::declutter($hash{'src_'.
330: $currentResourceID}));
331:
332: $cache->{$currentResourceID.':problem'}=$Problem;
333: if(!defined($cache->{$currentSequence.':problems'})) {
334: $cache->{$currentSequence.':problems'}=$currentResourceID;
335: } else {
336: $cache->{$currentSequence.':problems'}.=
337: ':'.$currentResourceID;
338: }
339:
1.8 stredwic 340: $cache->{$currentResourceID.':source'} =
341: $hash{'src_'.$currentResourceID};
1.2 stredwic 342: my $meta=$hash{'src_'.$currentResourceID};
343: # $cache->{$currentResourceID.':title'}=
344: # &Apache::lonnet::metdata($meta,'title');
345: $cache->{$currentResourceID.':title'}=
346: $hash{'title_'.$currentResourceID};
1.9 ! minaeibi 347: $cache->{$currentResourceID.':source'}=
! 348: $hash{'src_'.$currentResourceID};
1.2 stredwic 349:
1.1 stredwic 350: # Get Parts for problem
1.8 stredwic 351: my %beenHere;
352: foreach (split(/\,/,&Apache::lonnet::metadata($meta,'packages'))) {
353: if(/^\w+response_\d+.*/) {
354: my (undef, $partId, $responseId) = split(/_/,$_);
355: if($beenHere{'p:'.$partId} == 0) {
356: $beenHere{'p:'.$partId}++;
357: if(!defined($cache->{$currentSequence.':'.
358: $currentResourceID.':parts'})) {
359: $cache->{$currentSequence.':'.$currentResourceID.
360: ':parts'}=$partId;
361: } else {
362: $cache->{$currentSequence.':'.$currentResourceID.
363: ':parts'}.=':'.$partId;
364: }
365: }
366: if($beenHere{'r:'.$partId.':'.$responseId} == 0) {
367: $beenHere{'r:'.$partId.':'.$responseId}++;
368: if(!defined($cache->{$currentSequence.':'.
369: $currentResourceID.':'.$partId.
370: ':responseIDs'})) {
371: $cache->{$currentSequence.':'.$currentResourceID.
372: ':'.$partId.':responseIDs'}=$responseId;
373: } else {
374: $cache->{$currentSequence.':'.$currentResourceID.
375: ':'.$partId.':responseIDs'}.=':'.
376: $responseId;
377: }
1.1 stredwic 378: }
1.8 stredwic 379: if(/^optionresponse/ &&
380: $beenHere{'o:'.$partId.':'.$currentResourceID} == 0) {
381: $beenHere{'o:'.$partId.$currentResourceID}++;
382: if(defined($cache->{'OptionResponses'})) {
383: $cache->{'OptionResponses'}.= ':::'.
384: $currentResourceID.':'.
385: $partId.':'.$responseId;
386: } else {
387: $cache->{'OptionResponses'}= $currentResourceID.
388: ':'.$partId.':'.$responseId;
1.2 stredwic 389: }
390: }
391: }
1.8 stredwic 392: }
393: }
1.1 stredwic 394:
395: # if resource == finish resource, then it is the end of a sequence/page
396: if($currentResourceID eq $lastResourceID) {
397: # pop off last resource of sequence
398: $currentResourceID=pop(@currentResource);
399: $lastResourceID=pop(@finishResource);
400:
401: if(defined($cache->{$currentSequence.':problems'})) {
402: # Capture sequence information here
403: $cache->{$currentSequence.':title'}=
404: $hash{'title_'.$currentResourceID};
1.2 stredwic 405: $cache->{$currentSequence.':source'}=
406: $hash{'src_'.$currentResourceID};
1.1 stredwic 407:
408: my $totalProblems=0;
409: foreach my $currentProblem (split(/\:/,
410: $cache->{$currentSequence.
411: ':problems'})) {
412: foreach (split(/\:/,$cache->{$currentSequence.':'.
413: $currentProblem.
414: ':parts'})) {
415: $totalProblems++;
416: }
417: }
418: my @titleLength=split(//,$cache->{$currentSequence.
419: ':title'});
420: # $extra is 3 for problems correct and 3 for space
421: # between problems correct and problem output
422: my $extra = 6;
423: if(($totalProblems + $extra) > (scalar @titleLength)) {
424: $cache->{$currentSequence.':columnWidth'}=
425: $totalProblems + $extra;
426: } else {
427: $cache->{$currentSequence.':columnWidth'}=
428: (scalar @titleLength);
429: }
430: } else {
431: # Remove sequence from list, if it contains no problems to
432: # display.
433: $cache->{'orderedSequences'}=~s/$currentSequence//;
434: $cache->{'orderedSequences'}=~s/::/:/g;
435: $cache->{'orderedSequences'}=~s/^:|:$//g;
436: }
437:
438: $currentSequence=pop(@sequences);
439: if($currentSequence eq $topLevelSequenceNumber) {
440: last;
441: }
442: }
443:
444: # MOVE!!!
445: # move to next resource
446: unless(defined($hash{'to_'.$currentResourceID})) {
447: # big problem, need to handle. Next is probably wrong
448: last;
449: }
450: my @nextResources=();
451: foreach (split(/\,/,$hash{'to_'.$currentResourceID})) {
452: push(@nextResources, $hash{'goesto_'.$_});
453: }
454: push(@currentResource, @nextResources);
455: # Set the next resource to be processed
456: $currentResourceID=pop(@currentResource);
457: }
458:
459: unless (untie(%hash)) {
460: &Apache::lonnet::logthis("<font color=blue>WARNING: ".
461: "Could not untie coursemap $fn (browse)".
462: ".</font>");
463: }
464:
465: return 'OK';
466: }
467:
468: =pod
469:
1.3 stredwic 470: =item &ProcessClasslist()
1.1 stredwic 471:
1.3 stredwic 472: Taking the class list dumped from &DownloadClasslist(), all the
1.1 stredwic 473: students and their non-class information is processed using the
474: &ProcessStudentInformation() function. A date stamp is also recorded for
475: when the data was processed.
476:
1.3 stredwic 477: Takes data downloaded for a student and breaks it up into managable pieces and
478: stored in cache data. The username, domain, class related date, PID,
479: full name, and section are all processed here.
480:
481:
1.1 stredwic 482: =over 4
483:
484: Input: $cache, $classlist, $courseID, $ChartDB, $c
485:
486: $cache: A hash pointer to store the data
487:
488: $classlist: The hash of data collected about a student from
1.3 stredwic 489: &DownloadClasslist(). The hash contains a list of students, a pointer
1.1 stredwic 490: to a hash of student information for each student, and each student's section
491: number.
492:
493: $courseID: The course ID
494:
495: $ChartDB: The name of the cache database file.
496:
497: $c: The connection class used to determine if an abort has been sent to the
498: browser
499:
500: Output: @names
501:
502: @names: An array of students whose information has been processed, and are to
503: be considered in an arbitrary order.
504:
505: =back
506:
507: =cut
508:
1.3 stredwic 509: sub ProcessClasslist {
510: my ($cache,$classlist,$courseID,$c)=@_;
1.1 stredwic 511: my @names=();
512:
1.3 stredwic 513: $cache->{'ClasslistTimeStamp'}=$classlist->{'lastDownloadTime'};
514: if($classlist->{'UpToDate'} eq 'true') {
515: return split(/:::/,$cache->{'NamesOfStudents'});;
516: }
517:
1.1 stredwic 518: foreach my $name (keys(%$classlist)) {
519: if($name =~ /\:section/ || $name =~ /\:studentInformation/ ||
1.3 stredwic 520: $name eq '' || $name eq 'UpToDate' || $name eq 'lastDownloadTime') {
1.1 stredwic 521: next;
522: }
523: if($c->aborted()) {
1.3 stredwic 524: return ();
1.1 stredwic 525: }
526: push(@names,$name);
1.3 stredwic 527: my $studentInformation = $classlist->{$name.':studentInformation'},
528: my $sectionData = $classlist->{$name.':sections'},
529: my $date = $classlist->{$name},
530: my ($studentName,$studentDomain) = split(/\:/,$name);
531:
532: $cache->{$name.':username'}=$studentName;
533: $cache->{$name.':domain'}=$studentDomain;
534: if(!defined($cache->{$name.':lastDownloadTime'})) {
535: $cache->{$name.':lastDownloadTime'}='Not downloaded';
1.6 stredwic 536: $cache->{$name.':updateTime'}=' Not updated';
1.3 stredwic 537: }
538:
539: my ($checkForError)=keys(%$studentInformation);
540: if($checkForError =~ /^(con_lost|error|no_such_host)/i) {
541: $cache->{$name.':error'}=
542: 'Could not download student environment data.';
543: $cache->{$name.':fullname'}='';
544: $cache->{$name.':id'}='';
545: } else {
546: $cache->{$name.':fullname'}=&ProcessFullName(
547: $studentInformation->{'lastname'},
548: $studentInformation->{'generation'},
549: $studentInformation->{'firstname'},
550: $studentInformation->{'middlename'});
551: $cache->{$name.':id'}=$studentInformation->{'id'};
552: }
553:
554: my ($end, $start)=split(':',$date);
555: $courseID=~s/\_/\//g;
556: $courseID=~s/^(\w)/\/$1/;
557:
558: my $sec='';
559: foreach my $key (keys (%$sectionData)) {
560: my $value = $sectionData->{$key};
561: if ($key=~/^$courseID(?:\/)*(\w+)*\_st$/) {
562: my $tempsection=$1;
563: if($key eq $courseID.'_st') {
564: $tempsection='';
565: }
566: my ($dummy,$roleend,$rolestart)=split(/\_/,$value);
567: if($roleend eq $end && $rolestart eq $start) {
568: $sec = $tempsection;
569: last;
570: }
571: }
572: }
573:
574: my $status='Expired';
575: if(((!$end) || time < $end) && ((!$start) || (time > $start))) {
576: $status='Active';
577: }
578: $cache->{$name.':Status'}=$status;
579: $cache->{$name.':section'}=$sec;
1.7 stredwic 580:
581: if($sec eq '' || !defined($sec) || $sec eq ' ') {
582: $sec = 'none';
583: }
584: if(defined($cache->{'sectionList'})) {
585: if($cache->{'sectionList'} !~ /(^$sec:|^$sec$|:$sec$|:$sec:)/) {
586: $cache->{'sectionList'} .= ':'.$sec;
587: }
588: } else {
589: $cache->{'sectionList'} = $sec;
590: }
1.1 stredwic 591: }
592:
1.3 stredwic 593: $cache->{'ClasslistTimestamp'}=time;
594: $cache->{'NamesOfStudents'}=join(':::',@names);
1.1 stredwic 595:
596: return @names;
597: }
598:
599: =pod
600:
601: =item &ProcessStudentData()
602:
603: Takes the course data downloaded for a student in
1.4 stredwic 604: &DownloadCourseInformation() and breaks it up into key value pairs
1.1 stredwic 605: to be stored in the cached data. The keys are comprised of the
606: $username:$domain:$keyFromCourseDatabase. The student username:domain is
607: stored away signifying that the student's information has been downloaded and
608: can be reused from cached data.
609:
610: =over 4
611:
612: Input: $cache, $courseData, $name
613:
614: $cache: A hash pointer to store data
615:
616: $courseData: A hash pointer that points to the course data downloaded for a
617: student.
618:
619: $name: username:domain
620:
621: Output: None
622:
623: *NOTE: There is no output, but an error message is stored away in the cache
624: data. This is checked in &FormatStudentData(). The key username:domain:error
625: will only exist if an error occured. The error is an error from
1.4 stredwic 626: &DownloadCourseInformation().
1.1 stredwic 627:
628: =back
629:
630: =cut
631:
632: sub ProcessStudentData {
633: my ($cache,$courseData,$name)=@_;
634:
1.3 stredwic 635: if($courseData->{'UpToDate'} eq 'true') {
636: $cache->{$name.':lastDownloadTime'}=$courseData->{'lastDownloadTime'};
1.6 stredwic 637: if($courseData->{'lastDownloadTime'} eq 'Not downloaded') {
638: $cache->{$name.':updateTime'} = ' Not updated';
639: } else {
640: $cache->{$name.':updateTime'}=
641: localtime($courseData->{'lastDownloadTime'});
642: }
1.3 stredwic 643: return;
644: }
645:
646: my @courseKeys = keys(%$courseData);
647:
648: foreach (@courseKeys) {
649: if(/^(con_lost|error|no_such_host)/i) {
650: $cache->{$name.':error'}='Could not download course data.';
651: return;
1.1 stredwic 652: }
1.3 stredwic 653: }
654:
655: $cache->{$name.':lastDownloadTime'}=$courseData->{'lastDownloadTime'};
1.6 stredwic 656: if($courseData->{'lastDownloadTime'} eq 'Not downloaded') {
657: $cache->{$name.':updateTime'} = ' Not updated';
658: } else {
659: $cache->{$name.':updateTime'}=
660: localtime($courseData->{'lastDownloadTime'});
661: }
1.3 stredwic 662: foreach (@courseKeys) {
663: $cache->{$name.':'.$_}=$courseData->{$_};
1.1 stredwic 664: }
665:
666: return;
1.4 stredwic 667: }
668:
669: sub LoadDiscussion {
1.5 minaeibi 670: my ( $courseID)=@_;
671: my %Discuss=();
672: my %contrib=&Apache::lonnet::dump(
673: $courseID,
674: $ENV{'course.'.$courseID.'.domain'},
675: $ENV{'course.'.$courseID.'.num'});
676:
677: #my %contrib=&DownloadCourseInformation($name, $courseID, 0);
678:
1.4 stredwic 679: foreach my $temp(keys %contrib) {
680: if ($temp=~/^version/) {
681: my $ver=$contrib{$temp};
682: my ($dummy,$prb)=split(':',$temp);
683: for (my $idx=1; $idx<=$ver; $idx++ ) {
684: my $name=$contrib{"$idx:$prb:sendername"};
1.5 minaeibi 685: $Discuss{"$name:$prb"}=$idx;
1.4 stredwic 686: }
687: }
688: }
1.5 minaeibi 689:
690: return \%Discuss;
1.1 stredwic 691: }
692:
693: # ----- END PROCESSING FUNCTIONS ---------------------------------------
694:
695: =pod
696:
697: =head1 HELPER FUNCTIONS
698:
699: These are just a couple of functions do various odd and end
700: jobs.
701:
702: =cut
703:
704: # ----- HELPER FUNCTIONS -----------------------------------------------
705:
706: =pod
707:
708: =item &ProcessFullName()
709:
710: Takes lastname, generation, firstname, and middlename (or some partial
711: set of this data) and returns the full name version as a string. Format
712: is Lastname generation, firstname middlename or a subset of this.
713:
714: =cut
715:
716: sub ProcessFullName {
717: my ($lastname, $generation, $firstname, $middlename)=@_;
718: my $Str = '';
719:
720: if($lastname ne '') {
721: $Str .= $lastname.' ';
722: if($generation ne '') {
723: $Str .= $generation;
724: } else {
725: chop($Str);
726: }
727: $Str .= ', ';
728: if($firstname ne '') {
729: $Str .= $firstname.' ';
730: }
731: if($middlename ne '') {
732: $Str .= $middlename;
733: } else {
734: chop($Str);
735: if($firstname eq '') {
736: chop($Str);
737: }
738: }
739: } else {
740: if($firstname ne '') {
741: $Str .= $firstname.' ';
742: }
743: if($middlename ne '') {
744: $Str .= $middlename.' ';
745: }
746: if($generation ne '') {
747: $Str .= $generation;
748: } else {
749: chop($Str);
750: }
751: }
752:
753: return $Str;
754: }
755:
756: =pod
757:
758: =item &TestCacheData()
759:
760: Determine if the cache database can be accessed with a tie. It waits up to
761: ten seconds before returning failure. This function exists to help with
762: the problems with stopping the data download. When an abort occurs and the
763: user quickly presses a form button and httpd child is created. This
764: child needs to wait for the other to finish (hopefully within ten seconds).
765:
766: =over 4
767:
768: Input: $ChartDB
769:
770: $ChartDB: The name of the cache database to be opened
771:
772: Output: -1, 0, 1
773:
774: -1: Couldn't tie database
775: 0: Use cached data
776: 1: New cache database created, use that.
777:
778: =back
779:
780: =cut
781:
782: sub TestCacheData {
783: my ($ChartDB,$isRecalculate,$totalDelay)=@_;
784: my $isCached=-1;
785: my %testData;
786: my $tieTries=0;
787:
788: if(!defined($totalDelay)) {
789: $totalDelay = 10;
790: }
791:
792: if ((-e "$ChartDB") && (!$isRecalculate)) {
793: $isCached = 1;
794: } else {
795: $isCached = 0;
796: }
797:
798: while($tieTries < $totalDelay) {
799: my $result=0;
800: if($isCached) {
801: $result=tie(%testData,'GDBM_File',$ChartDB,&GDBM_READER,0640);
802: } else {
803: $result=tie(%testData,'GDBM_File',$ChartDB,&GDBM_NEWDB,0640);
804: }
805: if($result) {
806: last;
807: }
808: $tieTries++;
809: sleep 1;
810: }
811: if($tieTries >= $totalDelay) {
812: return -1;
813: }
814:
815: untie(%testData);
816:
817: return $isCached;
818: }
1.2 stredwic 819:
1.3 stredwic 820: sub GetFileTimestamp {
821: my ($studentDomain,$studentName,$filename,$root)=@_;
822: $studentDomain=~s/\W//g;
823: $studentName=~s/\W//g;
824: my $subdir=$studentName.'__';
825: $subdir =~ s/(.)(.)(.).*/$1\/$2\/$3/;
826: my $proname="$studentDomain/$subdir/$studentName";
827: $proname .= '/'.$filename;
828: my @dir = &Apache::lonnet::dirlist($proname, $studentDomain, $studentName,
829: $root);
830: my $fileStat = $dir[0];
831: my @stats = split('&', $fileStat);
832: if(@stats) {
833: return $stats[9];
834: } else {
835: return -1;
836: }
837: }
1.1 stredwic 838:
839: # ----- END HELPER FUNCTIONS --------------------------------------------
840:
841: 1;
842: __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