loncom/interface/loncoursedata.pm - view

File: [LON-CAPA] / loncom / interface / loncoursedata.pm
Revision 1.6: download - view: text, annotated - select for diffs
Thu Jul 25 21:23:51 2002 UTC (21 years, 10 months ago) by stredwic
Branches: MAIN
CVS tags: HEAD

Updating lonstudentassessment to add in features of lonchart.  Now the
data display is like lonchart with formatted columns of data.  The next
step will be to add in the column removal check boxes and a multiselect
box for sections.

1: # The LearningOnline Network with CAPA 2: # (Publication Handler 3: # 4: # $Id: loncoursedata.pm,v 1.6 2002/07/25 21:23:51 stredwic Exp $ 5: # 6: # Copyright Michigan State University Board of Trustees 7: # 8: # This file is part of the LearningOnline Network with CAPA (LON-CAPA). 9: # 10: # LON-CAPA is free software; you can redistribute it and/or modify 11: # it under the terms of the GNU General Public License as published by 12: # the Free Software Foundation; either version 2 of the License, or 13: # (at your option) any later version. 14: # 15: # LON-CAPA is distributed in the hope that it will be useful, 16: # but WITHOUT ANY WARRANTY; without even the implied warranty of 17: # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 18: # GNU General Public License for more details. 19: # 20: # You should have received a copy of the GNU General Public License 21: # along with LON-CAPA; if not, write to the Free Software 22: # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA 23: # 24: # /home/httpd/html/adm/gpl.txt 25: # 26: # http://www.lon-capa.org/ 27: # 28: ### 29: 30: =pod 31: 32: =head1 NAME 33: 34: loncoursedata 35: 36: =head1 SYNOPSIS 37: 38: Set of functions that download and process student information. 39: 40: =head1 PACKAGES USED 41: 42: Apache::Constants qw(:common :http) 43: Apache::lonnet() 44: HTML::TokeParser 45: GDBM_File 46: 47: =cut 48: 49: package Apache::loncoursedata; 50: 51: use strict; 52: use Apache::Constants qw(:common :http); 53: use Apache::lonnet(); 54: use HTML::TokeParser; 55: use GDBM_File; 56: 57: =pod 58: 59: =head1 DOWNLOAD INFORMATION 60: 61: This section contains all the files that get data from other servers 62: and/or itself. There is one function that has a call to get remote 63: information but isn't included here which is ProcessTopLevelMap. The 64: usage was small enough to be ignored, but that portion may be moved 65: here in the future. 66: 67: =cut 68: 69: # ----- DOWNLOAD INFORMATION ------------------------------------------- 70: 71: =pod 72: 73: =item &DownloadClasslist() 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 DownloadClasslist { 105: my ($courseID, $lastDownloadTime, $c)=@_; 106: my ($courseDomain,$courseNumber)=split(/\_/,$courseID); 107: my %classlist; 108: 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); 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); 149: $classlist{$name.':sections'}=\%section; 150: } 151: 152: $classlist{'UpToDate'} = 'false'; 153: $classlist{'lastDownloadTime'}=time; 154: 155: return \%classlist; 156: } 157: 158: =pod 159: 160: =item &DownloadCourseInformation() 161: 162: Dump of all the course information for a single student. There is no 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. 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 DownloadCourseInformation { 185: my ($namedata,$courseID,$lastDownloadTime)=@_; 186: my %courseData; 187: my ($name,$domain) = split(/\:/,$namedata); 188: 189: # my $modifiedTime = &GetFileTimestamp($domain, $name, 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: 198: # Download course data 199: %courseData=&Apache::lonnet::dump($courseID, $domain, $name); 200: $courseData{'UpToDate'} = 'false'; 201: $courseData{'lastDownloadTime'}=time; 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: 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: 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: } 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: } 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}; 387: $cache->{$currentSequence.':source'}= 388: $hash{'src_'.$currentResourceID}; 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 &ProcessClasslist() 453: 454: Taking the class list dumped from &DownloadClasslist(), all the 455: students and their non-class information is processed using the 456: &ProcessStudentInformation() function. A date stamp is also recorded for 457: when the data was processed. 458: 459: Takes data downloaded for a student and breaks it up into managable pieces and 460: stored in cache data. The username, domain, class related date, PID, 461: full name, and section are all processed here. 462: 463: 464: =over 4 465: 466: Input: $cache, $classlist, $courseID, $ChartDB, $c 467: 468: $cache: A hash pointer to store the data 469: 470: $classlist: The hash of data collected about a student from 471: &DownloadClasslist(). The hash contains a list of students, a pointer 472: to a hash of student information for each student, and each student's section 473: number. 474: 475: $courseID: The course ID 476: 477: $ChartDB: The name of the cache database file. 478: 479: $c: The connection class used to determine if an abort has been sent to the 480: browser 481: 482: Output: @names 483: 484: @names: An array of students whose information has been processed, and are to 485: be considered in an arbitrary order. 486: 487: =back 488: 489: =cut 490: 491: sub ProcessClasslist { 492: my ($cache,$classlist,$courseID,$c)=@_; 493: my @names=(); 494: 495: $cache->{'ClasslistTimeStamp'}=$classlist->{'lastDownloadTime'}; 496: if($classlist->{'UpToDate'} eq 'true') { 497: return split(/:::/,$cache->{'NamesOfStudents'});; 498: } 499: 500: foreach my $name (keys(%$classlist)) { 501: if($name =~ /\:section/ || $name =~ /\:studentInformation/ || 502: $name eq '' || $name eq 'UpToDate' || $name eq 'lastDownloadTime') { 503: next; 504: } 505: if($c->aborted()) { 506: return (); 507: } 508: push(@names,$name); 509: my $studentInformation = $classlist->{$name.':studentInformation'}, 510: my $sectionData = $classlist->{$name.':sections'}, 511: my $date = $classlist->{$name}, 512: my ($studentName,$studentDomain) = split(/\:/,$name); 513: 514: $cache->{$name.':username'}=$studentName; 515: $cache->{$name.':domain'}=$studentDomain; 516: if(!defined($cache->{$name.':lastDownloadTime'})) { 517: $cache->{$name.':lastDownloadTime'}='Not downloaded'; 518: $cache->{$name.':updateTime'}=' Not updated'; 519: } 520: 521: my ($checkForError)=keys(%$studentInformation); 522: if($checkForError =~ /^(con_lost|error|no_such_host)/i) { 523: $cache->{$name.':error'}= 524: 'Could not download student environment data.'; 525: $cache->{$name.':fullname'}=''; 526: $cache->{$name.':id'}=''; 527: } else { 528: $cache->{$name.':fullname'}=&ProcessFullName( 529: $studentInformation->{'lastname'}, 530: $studentInformation->{'generation'}, 531: $studentInformation->{'firstname'}, 532: $studentInformation->{'middlename'}); 533: $cache->{$name.':id'}=$studentInformation->{'id'}; 534: } 535: 536: my ($end, $start)=split(':',$date); 537: $courseID=~s/\_/\//g; 538: $courseID=~s/^(\w)/\/$1/; 539: 540: my $sec=''; 541: foreach my $key (keys (%$sectionData)) { 542: my $value = $sectionData->{$key}; 543: if ($key=~/^$courseID(?:\/)*(\w+)*\_st$/) { 544: my $tempsection=$1; 545: if($key eq $courseID.'_st') { 546: $tempsection=''; 547: } 548: my ($dummy,$roleend,$rolestart)=split(/\_/,$value); 549: if($roleend eq $end && $rolestart eq $start) { 550: $sec = $tempsection; 551: last; 552: } 553: } 554: } 555: 556: my $status='Expired'; 557: if(((!$end) || time < $end) && ((!$start) || (time > $start))) { 558: $status='Active'; 559: } 560: $cache->{$name.':Status'}=$status; 561: $cache->{$name.':section'}=$sec; 562: } 563: 564: $cache->{'ClasslistTimestamp'}=time; 565: $cache->{'NamesOfStudents'}=join(':::',@names); 566: 567: return @names; 568: } 569: 570: =pod 571: 572: =item &ProcessStudentData() 573: 574: Takes the course data downloaded for a student in 575: &DownloadCourseInformation() and breaks it up into key value pairs 576: to be stored in the cached data. The keys are comprised of the 577: $username:$domain:$keyFromCourseDatabase. The student username:domain is 578: stored away signifying that the student's information has been downloaded and 579: can be reused from cached data. 580: 581: =over 4 582: 583: Input: $cache, $courseData, $name 584: 585: $cache: A hash pointer to store data 586: 587: $courseData: A hash pointer that points to the course data downloaded for a 588: student. 589: 590: $name: username:domain 591: 592: Output: None 593: 594: *NOTE: There is no output, but an error message is stored away in the cache 595: data. This is checked in &FormatStudentData(). The key username:domain:error 596: will only exist if an error occured. The error is an error from 597: &DownloadCourseInformation(). 598: 599: =back 600: 601: =cut 602: 603: sub ProcessStudentData { 604: my ($cache,$courseData,$name)=@_; 605: 606: if($courseData->{'UpToDate'} eq 'true') { 607: $cache->{$name.':lastDownloadTime'}=$courseData->{'lastDownloadTime'}; 608: if($courseData->{'lastDownloadTime'} eq 'Not downloaded') { 609: $cache->{$name.':updateTime'} = ' Not updated'; 610: } else { 611: $cache->{$name.':updateTime'}= 612: localtime($courseData->{'lastDownloadTime'}); 613: } 614: return; 615: } 616: 617: my @courseKeys = keys(%$courseData); 618: 619: foreach (@courseKeys) { 620: if(/^(con_lost|error|no_such_host)/i) { 621: $cache->{$name.':error'}='Could not download course data.'; 622: return; 623: } 624: } 625: 626: $cache->{$name.':lastDownloadTime'}=$courseData->{'lastDownloadTime'}; 627: if($courseData->{'lastDownloadTime'} eq 'Not downloaded') { 628: $cache->{$name.':updateTime'} = ' Not updated'; 629: } else { 630: $cache->{$name.':updateTime'}= 631: localtime($courseData->{'lastDownloadTime'}); 632: } 633: foreach (@courseKeys) { 634: $cache->{$name.':'.$_}=$courseData->{$_}; 635: } 636: 637: return; 638: } 639: 640: sub LoadDiscussion { 641: my ( $courseID)=@_; 642: my %Discuss=(); 643: my %contrib=&Apache::lonnet::dump( 644: $courseID, 645: $ENV{'course.'.$courseID.'.domain'}, 646: $ENV{'course.'.$courseID.'.num'}); 647: 648: #my %contrib=&DownloadCourseInformation($name, $courseID, 0); 649: 650: foreach my $temp(keys %contrib) { 651: if ($temp=~/^version/) { 652: my $ver=$contrib{$temp}; 653: my ($dummy,$prb)=split(':',$temp); 654: for (my $idx=1; $idx<=$ver; $idx++ ) { 655: my $name=$contrib{"$idx:$prb:sendername"}; 656: $Discuss{"$name:$prb"}=$idx; 657: } 658: } 659: } 660: 661: return \%Discuss; 662: } 663: 664: # ----- END PROCESSING FUNCTIONS --------------------------------------- 665: 666: =pod 667: 668: =head1 HELPER FUNCTIONS 669: 670: These are just a couple of functions do various odd and end 671: jobs. 672: 673: =cut 674: 675: # ----- HELPER FUNCTIONS ----------------------------------------------- 676: 677: =pod 678: 679: =item &ProcessFullName() 680: 681: Takes lastname, generation, firstname, and middlename (or some partial 682: set of this data) and returns the full name version as a string. Format 683: is Lastname generation, firstname middlename or a subset of this. 684: 685: =cut 686: 687: sub ProcessFullName { 688: my ($lastname, $generation, $firstname, $middlename)=@_; 689: my $Str = ''; 690: 691: if($lastname ne '') { 692: $Str .= $lastname.' '; 693: if($generation ne '') { 694: $Str .= $generation; 695: } else { 696: chop($Str); 697: } 698: $Str .= ', '; 699: if($firstname ne '') { 700: $Str .= $firstname.' '; 701: } 702: if($middlename ne '') { 703: $Str .= $middlename; 704: } else { 705: chop($Str); 706: if($firstname eq '') { 707: chop($Str); 708: } 709: } 710: } else { 711: if($firstname ne '') { 712: $Str .= $firstname.' '; 713: } 714: if($middlename ne '') { 715: $Str .= $middlename.' '; 716: } 717: if($generation ne '') { 718: $Str .= $generation; 719: } else { 720: chop($Str); 721: } 722: } 723: 724: return $Str; 725: } 726: 727: =pod 728: 729: =item &TestCacheData() 730: 731: Determine if the cache database can be accessed with a tie. It waits up to 732: ten seconds before returning failure. This function exists to help with 733: the problems with stopping the data download. When an abort occurs and the 734: user quickly presses a form button and httpd child is created. This 735: child needs to wait for the other to finish (hopefully within ten seconds). 736: 737: =over 4 738: 739: Input: $ChartDB 740: 741: $ChartDB: The name of the cache database to be opened 742: 743: Output: -1, 0, 1 744: 745: -1: Couldn't tie database 746: 0: Use cached data 747: 1: New cache database created, use that. 748: 749: =back 750: 751: =cut 752: 753: sub TestCacheData { 754: my ($ChartDB,$isRecalculate,$totalDelay)=@_; 755: my $isCached=-1; 756: my %testData; 757: my $tieTries=0; 758: 759: if(!defined($totalDelay)) { 760: $totalDelay = 10; 761: } 762: 763: if ((-e "$ChartDB") && (!$isRecalculate)) { 764: $isCached = 1; 765: } else { 766: $isCached = 0; 767: } 768: 769: while($tieTries < $totalDelay) { 770: my $result=0; 771: if($isCached) { 772: $result=tie(%testData,'GDBM_File',$ChartDB,&GDBM_READER,0640); 773: } else { 774: $result=tie(%testData,'GDBM_File',$ChartDB,&GDBM_NEWDB,0640); 775: } 776: if($result) { 777: last; 778: } 779: $tieTries++; 780: sleep 1; 781: } 782: if($tieTries >= $totalDelay) { 783: return -1; 784: } 785: 786: untie(%testData); 787: 788: return $isCached; 789: } 790: 791: sub GetFileTimestamp { 792: my ($studentDomain,$studentName,$filename,$root)=@_; 793: $studentDomain=~s/\W//g; 794: $studentName=~s/\W//g; 795: my $subdir=$studentName.'__'; 796: $subdir =~ s/(.)(.)(.).*/$1\/$2\/$3/; 797: my $proname="$studentDomain/$subdir/$studentName"; 798: $proname .= '/'.$filename; 799: my @dir = &Apache::lonnet::dirlist($proname, $studentDomain, $studentName, 800: $root); 801: my $fileStat = $dir[0]; 802: my @stats = split('&', $fileStat); 803: if(@stats) { 804: return $stats[9]; 805: } else { 806: return -1; 807: } 808: } 809: 810: # ----- END HELPER FUNCTIONS -------------------------------------------- 811: 812: 1; 813: __END__