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