Annotation of loncom/interface/loncoursedata.pm, revision 1.2
1.1 stredwic 1: # The LearningOnline Network with CAPA
2: # (Publication Handler
3: #
1.2 ! stredwic 4: # $Id: loncoursedata.pm,v 1.1 2002/07/09 15:43:49 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:
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:
1.2 ! stredwic 312: my $meta=$hash{'src_'.$currentResourceID};
! 313: # $cache->{$currentResourceID.':title'}=
! 314: # &Apache::lonnet::metdata($meta,'title');
! 315: $cache->{$currentResourceID.':title'}=
! 316: $hash{'title_'.$currentResourceID};
! 317:
1.1 stredwic 318: # Get Parts for problem
319: foreach (split(/\,/,&Apache::lonnet::metadata($meta,'keys'))) {
320: if($_=~/^stores\_(\d+)\_tries$/) {
321: my $Part=&Apache::lonnet::metadata($meta,$_.'.part');
322: if(!defined($cache->{$currentSequence.':'.
323: $currentResourceID.':parts'})) {
324: $cache->{$currentSequence.':'.$currentResourceID.
325: ':parts'}=$Part;
326: } else {
327: $cache->{$currentSequence.':'.$currentResourceID.
328: ':parts'}.=':'.$Part;
329: }
1.2 ! stredwic 330: foreach (split(/\,/,
! 331: &Apache::lonnet::metadata($meta,'packages'))) {
! 332: if($_=~/^optionresponse\_($Part)\_(\w+)$/) {
! 333: if(defined($cache->{'OptionResponses'})) {
! 334: $cache->{'OptionResponses'}.= ':::'.
! 335: $hash{'src_'.$currentResourceID}.'::'.
! 336: $hash{'title_'.$currentResourceID}.'::'.
! 337: $Part.'::'.$Problem;
! 338: } else {
! 339: $cache->{'OptionResponses'}=
! 340: $hash{'src_'.$currentResourceID}.'::'.
! 341: $hash{'title_'.$currentResourceID}.'::'.
! 342: $Part.'::'.$Problem;
! 343: }
! 344: }
! 345: }
! 346: }
1.1 stredwic 347: }
348: }
349:
350: # if resource == finish resource, then it is the end of a sequence/page
351: if($currentResourceID eq $lastResourceID) {
352: # pop off last resource of sequence
353: $currentResourceID=pop(@currentResource);
354: $lastResourceID=pop(@finishResource);
355:
356: if(defined($cache->{$currentSequence.':problems'})) {
357: # Capture sequence information here
358: $cache->{$currentSequence.':title'}=
359: $hash{'title_'.$currentResourceID};
1.2 ! stredwic 360: $cache->{$currentSequence.':source'}=
! 361: $hash{'src_'.$currentResourceID};
1.1 stredwic 362:
363: my $totalProblems=0;
364: foreach my $currentProblem (split(/\:/,
365: $cache->{$currentSequence.
366: ':problems'})) {
367: foreach (split(/\:/,$cache->{$currentSequence.':'.
368: $currentProblem.
369: ':parts'})) {
370: $totalProblems++;
371: }
372: }
373: my @titleLength=split(//,$cache->{$currentSequence.
374: ':title'});
375: # $extra is 3 for problems correct and 3 for space
376: # between problems correct and problem output
377: my $extra = 6;
378: if(($totalProblems + $extra) > (scalar @titleLength)) {
379: $cache->{$currentSequence.':columnWidth'}=
380: $totalProblems + $extra;
381: } else {
382: $cache->{$currentSequence.':columnWidth'}=
383: (scalar @titleLength);
384: }
385: } else {
386: # Remove sequence from list, if it contains no problems to
387: # display.
388: $cache->{'orderedSequences'}=~s/$currentSequence//;
389: $cache->{'orderedSequences'}=~s/::/:/g;
390: $cache->{'orderedSequences'}=~s/^:|:$//g;
391: }
392:
393: $currentSequence=pop(@sequences);
394: if($currentSequence eq $topLevelSequenceNumber) {
395: last;
396: }
397: }
398:
399: # MOVE!!!
400: # move to next resource
401: unless(defined($hash{'to_'.$currentResourceID})) {
402: # big problem, need to handle. Next is probably wrong
403: last;
404: }
405: my @nextResources=();
406: foreach (split(/\,/,$hash{'to_'.$currentResourceID})) {
407: push(@nextResources, $hash{'goesto_'.$_});
408: }
409: push(@currentResource, @nextResources);
410: # Set the next resource to be processed
411: $currentResourceID=pop(@currentResource);
412: }
413:
414: unless (untie(%hash)) {
415: &Apache::lonnet::logthis("<font color=blue>WARNING: ".
416: "Could not untie coursemap $fn (browse)".
417: ".</font>");
418: }
419:
420: return 'OK';
421: }
422:
423: =pod
424:
425: =item &ProcessSection()
426:
427: Determine the section number for a student for the class. A student can have
428: multiple sections for the same class. The correct one is chosen.
429:
430: =over 4
431:
432: Input: $sectionData, $courseid, $ActiveFlag
433:
434: $sectionData: A pointer to a hash containing all section data for this
435: student for the class
436:
437: $courseid: The course ID.
438:
439: $ActiveFlag: The student's active status (Active/Expired)
440:
441: Output: $oldsection, $cursection, or -1
442:
443: $oldsection and $cursection and sections number that will be displayed in the
444: chart.
445:
446: -1 is returned if an error occurs.
447:
448: =back
449:
450: =cut
451:
452: sub ProcessSection {
453: my ($sectionData,$courseid,$ActiveFlag)=@_;
454: $courseid=~s/\_/\//g;
455: $courseid=~s/^(\w)/\/$1/;
456:
457: my $cursection='-1';
458: my $oldsection='-1';
459: my $status='Expired';
460: my $section='';
461: foreach my $key (keys (%$sectionData)) {
462: my $value = $sectionData->{$key};
463: if ($key=~/^$courseid(?:\/)*(\w+)*\_st$/) {
464: $section=$1;
465: if($key eq $courseid.'_st') {
466: $section='';
467: }
1.2 ! stredwic 468:
1.1 stredwic 469: my ($dummy,$end,$start)=split(/\_/,$value);
470: my $now=time;
1.2 ! stredwic 471: my $notactive=0;
! 472: if ($start) {
! 473: if($now<$start) {
! 474: $notactive=1;
! 475: }
! 476: }
! 477: if($end) {
! 478: if ($now>$end) {
! 479: $notactive=1;
! 480: }
! 481: }
! 482: if($notactive == 0) {
! 483: $status='Active';
! 484: $cursection=$section;
! 485: last;
! 486: }
! 487: if($notactive == 1) {
! 488: $oldsection=$section;
! 489: }
1.1 stredwic 490: }
491: }
492: if($status eq $ActiveFlag) {
1.2 ! stredwic 493: if($cursection eq '-1') {
! 494: return $oldsection;
! 495: }
! 496: return $cursection;
1.1 stredwic 497: }
498: if($ActiveFlag eq 'Any') {
1.2 ! stredwic 499: if($cursection eq '-1') {
! 500: return $oldsection;
! 501: }
! 502: return $cursection;
1.1 stredwic 503: }
504: return '-1';
505: }
506:
507: =pod
508:
509: =item &ProcessNamePIDSection()
510:
511: Takes data downloaded for a student and breaks it up into managable pieces and
512: stored in cache data. The username, domain, class related date, PID,
513: full name, and section are all processed here.
514:
515: =over 4
516:
517: Input: $cache, $studentInformation, $section, $date, $name, $courseID
518:
519: $cache: A hash pointer to store the data
520:
521: $studentInformation: Student information is what was requested in
522: &DownloadPrerequistedData(). See that function for what data is requested.
523:
524: $section: A hash pointer to class section related information.
525:
526: $date: A composite of the start and end date for this class for this
527: student. Format: end:start
528:
529: $name: the username:domain information
530:
531: $courseID: The course ID
532:
533: Output: None
534:
535: *NOTE: There is no return value, but if an error occurs a key is added to
536: the cache data with the value being the error message. The key is
537: username:domain:error. It will only exist if an error occurs.
538:
539: =back
540:
541: =cut
542:
543: sub ProcessStudentNamePIDSection {
544: my ($cache,$studentInformation,$section,$date,$name,$courseID,$status)=@_;
545: my ($studentName,$studentDomain) = split(/\:/,$name);
546:
547: $cache->{$name.':username'}=$studentName;
548: $cache->{$name.':domain'}=$studentDomain;
549: $cache->{$name.':date'}=$date;
550:
551: my ($checkForError)=keys(%$studentInformation);
552: if($checkForError =~ /^(con_lost|error|no_such_host)/i) {
553: $cache->{$name.':error'}=
554: 'Could not download student environment data.';
555: $cache->{$name.':fullname'}='';
556: $cache->{$name.':id'}='';
557: } else {
558: $cache->{$name.':fullname'}=&ProcessFullName(
559: $studentInformation->{'lastname'},
560: $studentInformation->{'generation'},
561: $studentInformation->{'firstname'},
562: $studentInformation->{'middlename'});
563: $cache->{$name.':id'}=$studentInformation->{'id'};
564: }
565:
566: my $sec=&ProcessSection($section, $courseID, $status);
567: if($sec != -1) {
1.2 ! stredwic 568: $cache->{$name.':section'}=$sec;
1.1 stredwic 569: } else {
1.2 ! stredwic 570: $cache->{$name.':section'}='';
1.1 stredwic 571: }
572:
573: return;
574: }
575:
576: =pod
577:
578: =item &ProcessClassList()
579:
580: Taking the class list dumped from &DownloadPrerequisiteData(), all the
581: students and their non-class information is processed using the
582: &ProcessStudentInformation() function. A date stamp is also recorded for
583: when the data was processed.
584:
585: =over 4
586:
587: Input: $cache, $classlist, $courseID, $ChartDB, $c
588:
589: $cache: A hash pointer to store the data
590:
591: $classlist: The hash of data collected about a student from
592: &DownloadPrerequisteData(). The hash contains a list of students, a pointer
593: to a hash of student information for each student, and each student's section
594: number.
595:
596: $courseID: The course ID
597:
598: $ChartDB: The name of the cache database file.
599:
600: $c: The connection class used to determine if an abort has been sent to the
601: browser
602:
603: Output: @names
604:
605: @names: An array of students whose information has been processed, and are to
606: be considered in an arbitrary order.
607:
608: =back
609:
610: =cut
611:
612: sub ProcessClassList {
613: my ($cache,$classlist,$courseID,$status,$c)=@_;
614: my @names=();
615:
616: foreach my $name (keys(%$classlist)) {
617: if($name =~ /\:section/ || $name =~ /\:studentInformation/ ||
618: $name eq '') {
619: next;
620: }
621: if($c->aborted()) {
622: last;
623: }
624: push(@names,$name);
625: &ProcessStudentNamePIDSection($cache,
626: $classlist->{$name.':studentInformation'},
627: $classlist->{$name.':section'},
628: $classlist->{$name},
629: $name,$courseID,$status);
630: }
631:
632: # Time of download
633: $cache->{'time'}=localtime();
634:
635: return @names;
636: }
637:
638: =pod
639:
640: =item &ProcessStudentData()
641:
642: Takes the course data downloaded for a student in
643: &DownloadStudentCourseInformation() and breaks it up into key value pairs
644: to be stored in the cached data. The keys are comprised of the
645: $username:$domain:$keyFromCourseDatabase. The student username:domain is
646: stored away signifying that the student's information has been downloaded and
647: can be reused from cached data.
648:
649: =over 4
650:
651: Input: $cache, $courseData, $name
652:
653: $cache: A hash pointer to store data
654:
655: $courseData: A hash pointer that points to the course data downloaded for a
656: student.
657:
658: $name: username:domain
659:
660: Output: None
661:
662: *NOTE: There is no output, but an error message is stored away in the cache
663: data. This is checked in &FormatStudentData(). The key username:domain:error
664: will only exist if an error occured. The error is an error from
665: &DownloadStudentCourseInformation().
666:
667: =back
668:
669: =cut
670:
671: sub ProcessStudentData {
672: my ($cache,$courseData,$name)=@_;
673:
674: my ($checkForError) = keys(%$courseData);
675: if($checkForError =~ /^(con_lost|error|no_such_host)/i) {
676: $cache->{$name.':error'}='Could not download course data.';
677: } else {
678: foreach my $key (keys (%$courseData)) {
679: $cache->{$name.':'.$key}=$courseData->{$key};
680: }
681: if(defined($cache->{'NamesOfStudents'})) {
682: $cache->{'NamesOfStudents'}.=':::'.$name;
683: } else {
684: $cache->{'NamesOfStudents'}=$name;
685: }
686: }
687:
688: return;
689: }
690:
691: # ----- END PROCESSING FUNCTIONS ---------------------------------------
692:
693: =pod
694:
695: =head1 HELPER FUNCTIONS
696:
697: These are just a couple of functions do various odd and end
698: jobs.
699:
700: =cut
701:
702: # ----- HELPER FUNCTIONS -----------------------------------------------
703:
704: =pod
705:
706: =item &ProcessFullName()
707:
708: Takes lastname, generation, firstname, and middlename (or some partial
709: set of this data) and returns the full name version as a string. Format
710: is Lastname generation, firstname middlename or a subset of this.
711:
712: =cut
713:
714: sub ProcessFullName {
715: my ($lastname, $generation, $firstname, $middlename)=@_;
716: my $Str = '';
717:
718: if($lastname ne '') {
719: $Str .= $lastname.' ';
720: if($generation ne '') {
721: $Str .= $generation;
722: } else {
723: chop($Str);
724: }
725: $Str .= ', ';
726: if($firstname ne '') {
727: $Str .= $firstname.' ';
728: }
729: if($middlename ne '') {
730: $Str .= $middlename;
731: } else {
732: chop($Str);
733: if($firstname eq '') {
734: chop($Str);
735: }
736: }
737: } else {
738: if($firstname ne '') {
739: $Str .= $firstname.' ';
740: }
741: if($middlename ne '') {
742: $Str .= $middlename.' ';
743: }
744: if($generation ne '') {
745: $Str .= $generation;
746: } else {
747: chop($Str);
748: }
749: }
750:
751: return $Str;
752: }
753:
754: =pod
755:
756: =item &TestCacheData()
757:
758: Determine if the cache database can be accessed with a tie. It waits up to
759: ten seconds before returning failure. This function exists to help with
760: the problems with stopping the data download. When an abort occurs and the
761: user quickly presses a form button and httpd child is created. This
762: child needs to wait for the other to finish (hopefully within ten seconds).
763:
764: =over 4
765:
766: Input: $ChartDB
767:
768: $ChartDB: The name of the cache database to be opened
769:
770: Output: -1, 0, 1
771:
772: -1: Couldn't tie database
773: 0: Use cached data
774: 1: New cache database created, use that.
775:
776: =back
777:
778: =cut
779:
780: sub TestCacheData {
781: my ($ChartDB,$isRecalculate,$totalDelay)=@_;
782: my $isCached=-1;
783: my %testData;
784: my $tieTries=0;
785:
786: if(!defined($totalDelay)) {
787: $totalDelay = 10;
788: }
789:
790: if ((-e "$ChartDB") && (!$isRecalculate)) {
791: $isCached = 1;
792: } else {
793: $isCached = 0;
794: }
795:
796: while($tieTries < $totalDelay) {
797: my $result=0;
798: if($isCached) {
799: $result=tie(%testData,'GDBM_File',$ChartDB,&GDBM_READER,0640);
800: } else {
801: $result=tie(%testData,'GDBM_File',$ChartDB,&GDBM_NEWDB,0640);
802: }
803: if($result) {
804: last;
805: }
806: $tieTries++;
807: sleep 1;
808: }
809: if($tieTries >= $totalDelay) {
810: return -1;
811: }
812:
813: untie(%testData);
814:
815: return $isCached;
816: }
1.2 ! stredwic 817:
! 818: #sub CheckStatus {
! 819: # my ($name, $data, $status)=@_;
! 820:
! 821: # if($status eq 'Any') {
! 822: # my $section = ' ';
! 823: # foreach (split(':',$data->{$name.':Sections'})) {
! 824: # if($data->{$name.':'.$_.'Status'} eq 'Active') {
! 825: # return $_;
! 826: # }
! 827: # $section = $_;
! 828: # }
! 829: # return $_;
! 830: # }
! 831:
! 832: # foreach (split(':',$data->{$name.':Sections'})) {
! 833: # if($data->{$name.':'.$_.'Status'} eq $status) {
! 834: # return $_;
! 835: # }
! 836: # }
! 837:
! 838: # foreach (split(':',$data->{$name.':Sections'})) {
! 839: # if($data->{$name.':'.$_.'Status'} eq 'Any') {
! 840: # return $_;
! 841: # }
! 842: # }
! 843:
! 844: # return 'not found';
! 845: #}
1.1 stredwic 846:
847: # ----- END HELPER FUNCTIONS --------------------------------------------
848:
849: 1;
850: __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