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