loncom/interface/lonnavmaps.pm - view

File: [LON-CAPA] / loncom / interface / lonnavmaps.pm
Revision 1.210: download - view: text, annotated - select for diffs
Wed Jun 25 16:45:54 2003 UTC (20 years, 11 months ago) by bowersj2
Branches: MAIN
CVS tags: HEAD

Been missing a </td> on the end of every row in the navmaps.
This may have been contributing to the general slowness of the
navmaps, where Mozilla was rendering it *far* more slowly then the
server was generating it.

1: # The LearningOnline Network with CAPA 2: # Navigate Maps Handler 3: # 4: # $Id: lonnavmaps.pm,v 1.210 2003/06/25 16:45:54 bowersj2 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: # (Page Handler 29: # 30: # (TeX Content Handler 31: # 32: # 05/29/00,05/30 Gerd Kortemeyer) 33: # 08/30,08/31,09/06,09/14,09/15,09/16,09/19,09/20,09/21,09/23, 34: # 10/02,10/10,10/14,10/16,10/18,10/19,10/31,11/6,11/14,11/16 Gerd Kortemeyer) 35: # 36: # 3/1/1,6/1,17/1,29/1,30/1,2/8,9/21,9/24,9/25 Gerd Kortemeyer 37: # YEAR=2002 38: # 1/1 Gerd Kortemeyer 39: # Oct-Nov Jeremy Bowers 40: # YEAR=2003 41: # Jeremy Bowers ... lots of days 42: 43: package Apache::lonnavmaps; 44: 45: use strict; 46: use Apache::Constants qw(:common :http); 47: use Apache::loncommon(); 48: use Apache::lonmenu(); 49: use POSIX qw (floor strftime); 50: use Data::Dumper; # for debugging, not always used 51: 52: # symbolic constants 53: sub SYMB { return 1; } 54: sub URL { return 2; } 55: sub NOTHING { return 3; } 56: 57: # Some data 58: 59: my $resObj = "Apache::lonnavmaps::resource"; 60: 61: # Keep these mappings in sync with lonquickgrades, which uses the colors 62: # instead of the icons. 63: my %statusIconMap = 64: ( $resObj->NETWORK_FAILURE => '', 65: $resObj->NOTHING_SET => '', 66: $resObj->CORRECT => 'navmap.correct.gif', 67: $resObj->EXCUSED => 'navmap.correct.gif', 68: $resObj->PAST_DUE_NO_ANSWER => 'navmap.wrong.gif', 69: $resObj->PAST_DUE_ANSWER_LATER => 'navmap.wrong.gif', 70: $resObj->ANSWER_OPEN => 'navmap.wrong.gif', 71: $resObj->OPEN_LATER => '', 72: $resObj->TRIES_LEFT => 'navmap.open.gif', 73: $resObj->INCORRECT => 'navmap.wrong.gif', 74: $resObj->OPEN => 'navmap.open.gif', 75: $resObj->ATTEMPTED => 'navmap.ellipsis.gif', 76: $resObj->ANSWER_SUBMITTED => '' ); 77: 78: my %iconAltTags = 79: ( 'navmap.correct.gif' => 'Correct', 80: 'navmap.wrong.gif' => 'Incorrect', 81: 'navmap.open.gif' => 'Open' ); 82: 83: # Defines a status->color mapping, null string means don't color 84: my %colormap = 85: ( $resObj->NETWORK_FAILURE => '', 86: $resObj->CORRECT => '', 87: $resObj->EXCUSED => '#3333FF', 88: $resObj->PAST_DUE_ANSWER_LATER => '', 89: $resObj->PAST_DUE_NO_ANSWER => '', 90: $resObj->ANSWER_OPEN => '#006600', 91: $resObj->OPEN_LATER => '', 92: $resObj->TRIES_LEFT => '', 93: $resObj->INCORRECT => '', 94: $resObj->OPEN => '', 95: $resObj->NOTHING_SET => '', 96: $resObj->ATTEMPTED => '', 97: $resObj->ANSWER_SUBMITTED => '' 98: ); 99: # And a special case in the nav map; what to do when the assignment 100: # is not yet done and due in less then 24 hours 101: my $hurryUpColor = "#FF0000"; 102: 103: sub handler { 104: my $r = shift; 105: real_handler($r); 106: } 107: 108: sub real_handler { 109: my $r = shift; 110: 111: # Handle header-only request 112: if ($r->header_only) { 113: if ($ENV{'browser.mathml'}) { 114: $r->content_type('text/xml'); 115: } else { 116: $r->content_type('text/html'); 117: } 118: $r->send_http_header; 119: return OK; 120: } 121: 122: # Send header, don't cache this page 123: if ($ENV{'browser.mathml'}) { 124: $r->content_type('text/xml'); 125: } else { 126: $r->content_type('text/html'); 127: } 128: &Apache::loncommon::no_cache($r); 129: $r->send_http_header; 130: 131: # Create the nav map 132: my $navmap = Apache::lonnavmaps::navmap->new( 133: $ENV{"request.course.fn"}.".db", 134: $ENV{"request.course.fn"}."_parms.db", 1, 1); 135: 136: 137: if (!defined($navmap)) { 138: my $requrl = $r->uri; 139: $ENV{'user.error.msg'} = "$requrl:bre:0:0:Course not initialized"; 140: return HTTP_NOT_ACCEPTABLE; 141: } 142: 143: $r->print("<html><head>\n"); 144: $r->print("<title>Navigate Course Contents</title>"); 145: # ------------------------------------------------------------ Get query string 146: &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},['register']); 147: 148: # ----------------------------------------------------- Force menu registration 149: my $addentries=''; 150: if ($ENV{'form.register'}) { 151: $addentries=' onLoad="'.&Apache::lonmenu::loadevents(). 152: '" onUnload="'.&Apache::lonmenu::unloadevents().'"'; 153: $r->print(&Apache::lonmenu::registerurl(1)); 154: } 155: 156: # Header 157: $r->print('</head>'. 158: &Apache::loncommon::bodytag('Navigate Course Contents','', 159: $addentries,'','',$ENV{'form.register'})); 160: $r->print('<script>window.focus();</script>'); 161: 162: $r->rflush(); 163: 164: # Now that we've displayed some stuff to the user, init the navmap 165: $navmap->init(); 166: 167: $r->rflush(); 168: 169: # Check that it's defined 170: if (!($navmap->courseMapDefined())) { 171: $r->print('<font size="+2" color="red">Coursemap undefined.</font>' . 172: '</body></html>'); 173: return OK; 174: } 175: 176: # See if there's only one map in the top-level, if we don't 177: # already have a filter... if so, automatically display it 178: if ($ENV{QUERY_STRING} !~ /filter/) { 179: my $iterator = $navmap->getIterator(undef, undef, undef, 0); 180: my $depth = 1; 181: $iterator->next(); 182: my $curRes = $iterator->next(); 183: my $sequenceCount = 0; 184: my $sequenceId; 185: while ($depth > 0) { 186: if ($curRes == $iterator->BEGIN_MAP()) { $depth++; } 187: if ($curRes == $iterator->END_MAP()) { $depth--; } 188: 189: if (ref($curRes) && $curRes->is_sequence()) { 190: $sequenceCount++; 191: $sequenceId = $curRes->map_pc(); 192: } 193: 194: $curRes = $iterator->next(); 195: } 196: 197: if ($sequenceCount == 1) { 198: # The automatic iterator creation in the render call 199: # will pick this up. We know the condition because 200: # the defined($ENV{'form.filter'}) also ensures this 201: # is a fresh call. 202: $ENV{'form.filter'} = "$sequenceId"; 203: } 204: } 205: 206: my $jumpToFirstHomework = 0; 207: # Check to see if the student is jumping to next open, do-able problem 208: if ($ENV{QUERY_STRING} eq 'jumpToFirstHomework') { 209: $jumpToFirstHomework = 1; 210: # Find the next homework problem that they can do. 211: my $iterator = $navmap->getIterator(undef, undef, undef, 1); 212: my $depth = 1; 213: $iterator->next(); 214: my $curRes = $iterator->next(); 215: my $foundDoableProblem = 0; 216: my $problemRes; 217: 218: while ($depth > 0 && !$foundDoableProblem) { 219: if ($curRes == $iterator->BEGIN_MAP()) { $depth++; } 220: if ($curRes == $iterator->END_MAP()) { $depth--; } 221: 222: if (ref($curRes) && $curRes->is_problem()) { 223: my $status = $curRes->status(); 224: if ($curRes->completable()) { 225: $problemRes = $curRes; 226: $foundDoableProblem = 1; 227: 228: # Pop open all previous maps 229: my $stack = $iterator->getStack(); 230: pop @$stack; # last resource in the stack is the problem 231: # itself, which we don't need in the map stack 232: my @mapPcs = map {$_->map_pc()} @$stack; 233: $ENV{'form.filter'} = join(',', @mapPcs); 234: 235: # Mark as both "here" and "jump" 236: $ENV{'form.postsymb'} = $curRes->symb(); 237: } 238: } 239: } continue { 240: $curRes = $iterator->next(); 241: } 242: 243: # If we found no problems, print a note to that effect. 244: if (!$foundDoableProblem) { 245: $r->print("<font size='+2'>All homework assignments have been completed.</font><br /><br />"); 246: } 247: } else { 248: $r->print("<a href='navmaps?jumpToFirstHomework'>" . 249: "Go To My First Homework Problem</a>    "); 250: } 251: 252: my $suppressEmptySequences = 0; 253: my $filterFunc = undef; 254: my $resource_no_folder_link = 0; 255: 256: # Display only due homework. 257: my $showOnlyHomework = 0; 258: if ($ENV{QUERY_STRING} eq 'showOnlyHomework') { 259: $showOnlyHomework = 1; 260: $suppressEmptySequences = 1; 261: $filterFunc = sub { my $res = shift; 262: return $res->completable() || $res->is_map(); 263: }; 264: $r->print("<p><font size='+2'>Uncompleted Homework</font></p>"); 265: $ENV{'form.filter'} = ''; 266: $ENV{'form.condition'} = 1; 267: $resource_no_folder_link = 1; 268: } else { 269: $r->print("<a href='navmaps?showOnlyHomework'>" . 270: "Show Only Uncompleted Homework</a>    "); 271: } 272: 273: # renderer call 274: my $renderArgs = { 'cols' => [0,1,2,3], 275: 'url' => '/adm/navmaps', 276: 'navmap' => $navmap, 277: 'suppressNavmap' => 1, 278: 'suppressEmptySequences' => $suppressEmptySequences, 279: 'filterFunc' => $filterFunc, 280: 'resource_no_folder_link' => $resource_no_folder_link, 281: 'r' => $r}; 282: my $render = render($renderArgs); 283: $navmap->untieHashes(); 284: 285: # If no resources were printed, print a reassuring message so the 286: # user knows there was no error. 287: if ($renderArgs->{'counter'} == 0) { 288: if ($showOnlyHomework) { 289: $r->print("<p><font size='+1'>All homework is currently completed.</font></p>"); 290: } else { # both jumpToFirstHomework and normal use the same: course must be empty 291: $r->print("<p><font size='+1'>This course is empty.</font></p>"); 292: } 293: } 294: 295: $r->print("</body></html>"); 296: $r->rflush(); 297: 298: return OK; 299: } 300: 301: # Convenience functions: Returns a string that adds or subtracts 302: # the second argument from the first hash, appropriate for the 303: # query string that determines which folders to recurse on 304: sub addToFilter { 305: my $hashIn = shift; 306: my $addition = shift; 307: my %hash = %$hashIn; 308: $hash{$addition} = 1; 309: 310: return join (",", keys(%hash)); 311: } 312: 313: sub removeFromFilter { 314: my $hashIn = shift; 315: my $subtraction = shift; 316: my %hash = %$hashIn; 317: 318: delete $hash{$subtraction}; 319: return join(",", keys(%hash)); 320: } 321: 322: # Convenience function: Given a stack returned from getStack on the iterator, 323: # return the correct src() value. 324: # Later, this should add an anchor when we start putting anchors in pages. 325: sub getLinkForResource { 326: my $stack = shift; 327: my $res; 328: 329: # Check to see if there are any pages in the stack 330: foreach $res (@$stack) { 331: if (defined($res) && $res->is_page()) { 332: return $res->src(); 333: } 334: } 335: 336: # Failing that, return the src of the last resource that is defined 337: # (when we first recurse on a map, it puts an undefined resource 338: # on the bottom because $self->{HERE} isn't defined yet, and we 339: # want the src for the map anyhow) 340: foreach (@$stack) { 341: if (defined($_)) { $res = $_; } 342: } 343: 344: return $res->src(); 345: } 346: 347: # Convenience function: This seperates the logic of how to create 348: # the problem text strings ("Due: DATE", "Open: DATE", "Not yet assigned", 349: # etc.) into a seperate function. It takes a resource object as the 350: # first parameter, and the part number of the resource as the second. 351: # It's basically a big switch statement on the status of the resource. 352: 353: sub getDescription { 354: my $res = shift; 355: my $part = shift; 356: my $status = $res->status($part); 357: 358: if ($status == $res->NETWORK_FAILURE) { 359: return "Having technical difficulties; please check status later"; 360: } 361: if ($status == $res->NOTHING_SET) { 362: return "Not currently assigned."; 363: } 364: if ($status == $res->OPEN_LATER) { 365: return "Open " . timeToHumanString($res->opendate($part)); 366: } 367: if ($status == $res->OPEN) { 368: if ($res->duedate($part)) { 369: return "Due " . timeToHumanString($res->duedate($part)); 370: } else { 371: return "Open, no due date"; 372: } 373: } 374: if ($status == $res->PAST_DUE_ANSWER_LATER) { 375: return "Answer open " . timeToHumanString($res->answerdate($part)); 376: } 377: if ($status == $res->PAST_DUE_NO_ANSWER) { 378: return "Was due " . timeToHumanString($res->duedate($part)); 379: } 380: if ($status == $res->ANSWER_OPEN) { 381: return "Answer available"; 382: } 383: if ($status == $res->EXCUSED) { 384: return "Excused by instructor"; 385: } 386: if ($status == $res->ATTEMPTED) { 387: return "Answer submitted, not yet graded."; 388: } 389: if ($status == $res->TRIES_LEFT) { 390: my $tries = $res->tries($part); 391: my $maxtries = $res->maxtries($part); 392: my $triesString = ""; 393: if ($tries && $maxtries) { 394: $triesString = "<font size=\"-1\"><i>($tries of $maxtries tries used)</i></font>"; 395: if ($maxtries > 1 && $maxtries - $tries == 1) { 396: $triesString = "<b>$triesString</b>"; 397: } 398: } 399: if ($res->duedate()) { 400: return "Due " . timeToHumanString($res->duedate($part)) . 401: " $triesString"; 402: } else { 403: return "No due date $triesString"; 404: } 405: } 406: if ($status == $res->ANSWER_SUBMITTED) { 407: return 'Answer submitted'; 408: } 409: } 410: 411: # Convenience function, so others can use it: Is the problem due in less then 412: # 24 hours, and still can be done? 413: 414: sub dueInLessThen24Hours { 415: my $res = shift; 416: my $part = shift; 417: my $status = $res->status($part); 418: 419: return ($status == $res->OPEN() || 420: $status == $res->TRIES_LEFT()) && 421: $res->duedate() && $res->duedate() < time()+(24*60*60) && 422: $res->duedate() > time(); 423: } 424: 425: # Convenience function, so others can use it: Is there only one try remaining for the 426: # part, with more then one try to begin with, not due yet and still can be done? 427: sub lastTry { 428: my $res = shift; 429: my $part = shift; 430: 431: my $tries = $res->tries($part); 432: my $maxtries = $res->maxtries($part); 433: return $tries && $maxtries && $maxtries > 1 && 434: $maxtries - $tries == 1 && $res->duedate() && 435: $res->duedate() > time(); 436: } 437: 438: # This puts a human-readable name on the ENV variable. 439: 440: sub advancedUser { 441: return $ENV{'request.role.adv'}; 442: } 443: 444: 445: # timeToHumanString takes a time number and converts it to a 446: # human-readable representation, meant to be used in the following 447: # manner: 448: # print "Due $timestring" 449: # print "Open $timestring" 450: # print "Answer available $timestring" 451: # Very, very, very, VERY English-only... goodness help a localizer on 452: # this func... 453: sub timeToHumanString { 454: my ($time) = @_; 455: # zero, '0' and blank are bad times 456: if (!$time) { 457: return 'never'; 458: } 459: 460: my $now = time(); 461: 462: my @time = localtime($time); 463: my @now = localtime($now); 464: 465: # Positive = future 466: my $delta = $time - $now; 467: 468: my $minute = 60; 469: my $hour = 60 * $minute; 470: my $day = 24 * $hour; 471: my $week = 7 * $day; 472: my $inPast = 0; 473: 474: # Logic in comments: 475: # Is it now? (extremely unlikely) 476: if ( $delta == 0 ) { 477: return "this instant"; 478: } 479: 480: if ($delta < 0) { 481: $inPast = 1; 482: $delta = -$delta; 483: } 484: 485: if ( $delta > 0 ) { 486: 487: my $tense = $inPast ? " ago" : ""; 488: my $prefix = $inPast ? "" : "in "; 489: 490: # Less then a minute 491: if ( $delta < $minute ) { 492: if ($delta == 1) { return "${prefix}1 second$tense"; } 493: return "$prefix$delta seconds$tense"; 494: } 495: 496: # Less then an hour 497: if ( $delta < $hour ) { 498: # If so, use minutes 499: my $minutes = floor($delta / 60); 500: if ($minutes == 1) { return "${prefix}1 minute$tense"; } 501: return "$prefix$minutes minutes$tense"; 502: } 503: 504: # Is it less then 24 hours away? If so, 505: # display hours + minutes 506: if ( $delta < $hour * 24) { 507: my $hours = floor($delta / $hour); 508: my $minutes = floor(($delta % $hour) / $minute); 509: my $hourString = "$hours hours"; 510: my $minuteString = ", $minutes minutes"; 511: if ($hours == 1) { 512: $hourString = "1 hour"; 513: } 514: if ($minutes == 1) { 515: $minuteString = ", 1 minute"; 516: } 517: if ($minutes == 0) { 518: $minuteString = ""; 519: } 520: return "$prefix$hourString$minuteString$tense"; 521: } 522: 523: # Less then 5 days away, display day of the week and 524: # HH:MM 525: if ( $delta < $day * 5 ) { 526: my $timeStr = strftime("%A, %b %e at %I:%M %P", localtime($time)); 527: $timeStr =~ s/12:00 am/midnight/; 528: $timeStr =~ s/12:00 pm/noon/; 529: return ($inPast ? "last " : "next ") . 530: $timeStr; 531: } 532: 533: # Is it this year? 534: if ( $time[5] == $now[5]) { 535: # Return on Month Day, HH:MM meridian 536: my $timeStr = strftime("on %A, %b %e at %I:%M %P", localtime($time)); 537: $timeStr =~ s/12:00 am/midnight/; 538: $timeStr =~ s/12:00 pm/noon/; 539: return $timeStr; 540: } 541: 542: # Not this year, so show the year 543: my $timeStr = strftime("on %A, %b %e %G at %I:%M %P", localtime($time)); 544: $timeStr =~ s/12:00 am/midnight/; 545: $timeStr =~ s/12:00 pm/noon/; 546: return $timeStr; 547: } 548: } 549: 550: 551: =pod 552: 553: =head1 NAME 554: 555: Apache::lonnavmap - Subroutines to handle and render the navigation maps 556: 557: =head1 SYNOPSIS 558: 559: The main handler generates the navigational listing for the course, 560: the other objects export this information in a usable fashion for 561: other modules. 562: 563: =head1 Subroutine: render 564: 565: The navmap renderer package provides a sophisticated rendering of the 566: standard navigation maps interface into HTML. The provided nav map 567: handler is actually just a glorified call to this. 568: 569: Because of the large number of parameters this function presents, 570: instead of passing it arguments as is normal, pass it in an anonymous 571: hash with the given options. This is because there is no obvious order 572: you may wish to override these in and a hash is easier to read and 573: understand then "undef, undef, undef, 1, undef, undef, renderButton, 574: undef, 0" when you mostly want default behaviors. 575: 576: The package provides a function called 'render', called as 577: Apache::lonnavmaps::render({}). 578: 579: =head2 Overview of Columns 580: 581: The renderer will build an HTML table for the navmap and return 582: it. The table is consists of several columns, and a row for each 583: resource (or possibly each part). You tell the renderer how many 584: columns to create and what to place in each column, optionally using 585: one or more of the prepared columns, and the renderer will assemble 586: the table. 587: 588: Any additional generally useful column types should be placed in the 589: renderer code here, so anybody can use it anywhere else. Any code 590: specific to the current application (such as the addition of <input> 591: elements in a column) should be placed in the code of the thing using 592: the renderer. 593: 594: At the core of the renderer is the array reference COLS (see Example 595: section below for how to pass this correctly). The COLS array will 596: consist of entries of one of two types of things: Either an integer 597: representing one of the pre-packaged column types, or a sub reference 598: that takes a resource reference, a part number, and a reference to the 599: argument hash passed to the renderer, and returns a string that will 600: be inserted into the HTML representation as it. 601: 602: The pre-packaged column names are refered to by constants in the 603: Apache::lonnavmaps namespace. The following currently exist: 604: 605: =over 4 606: 607: =item * B<resource>: 608: 609: The general info about the resource: Link, icon for the type, etc. The 610: first column in the standard nav map display. This column also accepts 611: the following parameters in the renderer hash: 612: 613: =over 4 614: 615: =item * B<resource_nolink>: 616: 617: If true, the resource will not be linked. Default: false, resource 618: will have links. 619: 620: =item * B<resource_part_count>: 621: 622: If true (default), the resource will show a part count if the full 623: part list is not displayed. If false, the resource will never show a 624: part count. 625: 626: =item * B<resource_no_folder_link>: 627: 628: If true, the resource's folder will not be clickable to open or close 629: it. Default is false. True implies printCloseAll is false, since you 630: can't close or open folders when this is on anyhow. 631: 632: =back 633: 634: =item B<communication_status>: 635: 636: Whether there is discussion on the resource, email for the user, or 637: (lumped in here) perl errors in the execution of the problem. This is 638: the second column in the main nav map. 639: 640: =item B<quick_status>: 641: 642: An icon for the status of a problem, with four possible states: 643: Correct, incorrect, open, or none (not open yet, not a problem). The 644: third column of the standard navmap. 645: 646: =item B<long_status>: 647: 648: A text readout of the details of the current status of the problem, 649: such as "Due in 22 hours". The fourth column of the standard navmap. 650: 651: =back 652: 653: If you add any others please be sure to document them here. 654: 655: An example of a column renderer that will show the ID number of a 656: resource, along with the part name if any: 657: 658: sub { 659: my ($resource, $part, $params) = @_; 660: if ($part) { return '<td>' . $resource->{ID} . ' ' . $part . '</td>'; } 661: return '<td>' . $resource->{ID} . '</td>'; 662: } 663: 664: Note these functions are responsible for the TD tags, which allow them 665: to override vertical and horizontal alignment, etc. 666: 667: =head2 Parameters 668: 669: Most of these parameters are only useful if you are *not* using the 670: folder interface (i.e., the default first column), which is probably 671: the common case. If you are using this interface, then you should be 672: able to get away with just using 'cols' (to specify the columns 673: shown), 'url' (necessary for the folders to link to the current screen 674: correctly), and possibly 'queryString' if your app calls for it. In 675: that case, maintaining the state of the folders will be done 676: automatically. 677: 678: =over 4 679: 680: =item * B<iterator>: 681: 682: A reference to a fresh ::iterator to use from the navmaps. The 683: rendering will reflect the options passed to the iterator, so you can 684: use that to just render a certain part of the course, if you like. If 685: one is not passed, the renderer will attempt to construct one from 686: ENV{'form.filter'} and ENV{'form.condition'} information, plus the 687: 'iterator_map' parameter if any. 688: 689: =item * B<iterator_map>: 690: 691: If you are letting the renderer do the iterator handling, you can 692: instruct the renderer to render only a particular map by passing it 693: the source of the map you want to process, like 694: '/res/103/jerf/navmap.course.sequence'. 695: 696: =item * B<navmap>: 697: 698: A reference to a navmap, used only if an iterator is not passed in. If 699: this is necessary to make an iterator but it is not passed in, a new 700: one will be constructed based on ENV info. This is useful to do basic 701: error checking before passing it off to render. 702: 703: =item * B<r>: 704: 705: The standard Apache response object. This must be passed to the 706: renderer or the course hash will be locked. 707: 708: =item * B<cols>: 709: 710: An array reference 711: 712: =item * B<showParts>: 713: 714: A flag. If yes (default), a line for the resource itself, and a line 715: for each part will be displayed. If not, only one line for each 716: resource will be displayed. 717: 718: =item * B<condenseParts>: 719: 720: A flag. If yes (default), if all parts of the problem have the same 721: status and that status is Nothing Set, Correct, or Network Failure, 722: then only one line will be displayed for that resource anyhow. If no, 723: all parts will always be displayed. If showParts is 0, this is 724: ignored. 725: 726: =item * B<jumpCount>: 727: 728: A string identifying the URL to place the anchor 'curloc' at. Default 729: to no anchor at all. It is the responsibility of the renderer user to 730: ensure that the #curloc is in the URL. By default, determined through 731: the use of the ENV{} 'jump' information, and should normally "just 732: work" correctly. 733: 734: =item * B<here>: 735: 736: A Symb identifying where to place the 'here' marker. Default empty, 737: which means no marker. 738: 739: =item * B<indentString>: 740: 741: A string identifying the indentation string to use. By default, this 742: is a 25 pixel whitespace image with no alt text. 743: 744: =item * B<queryString>: 745: 746: A string which will be prepended to the query string used when the 747: folders are opened or closed. 748: 749: =item * B<url>: 750: 751: The url the folders will link to, which should be the current 752: page. Required if the resource info column is shown. 753: 754: =item * B<currentJumpIndex>: 755: 756: Describes the currently-open row number to cause the browser to jump 757: to, because the user just opened that folder. By default, pulled from 758: the Jump information in the ENV{'form.*'}. 759: 760: =item * B<printKey>: 761: 762: If true, print the key that appears on the top of the standard 763: navmaps. Default is false. 764: 765: =item * B<printCloseAll>: 766: 767: If true, print the "Close all folders" or "open all folders" 768: links. Default is true. 769: 770: =item * B<filterFunc>: 771: 772: A function that takes the resource object as its only parameter and 773: returns a true or false value. If true, the resource is displayed. If 774: false, it is simply skipped in the display. By default, all resources 775: are shown. 776: 777: =item * B<suppressEmptySequences>: 778: 779: If you're using a filter function, and displaying sequences to orient 780: the user, then frequently some sequences will be empty. Setting this to 781: true will cause those sequences not to display, so as not to confuse the 782: user into thinking that if the sequence is there there should be things 783: under it. 784: 785: =item * B<suppressNavmaps>: 786: 787: If true, will not display Navigate Content resources. Default to 788: false. 789: 790: =back 791: 792: =head2 Additional Info 793: 794: In addition to the parameters you can pass to the renderer, which will 795: be passed through unchange to the column renderers, the renderer will 796: generate the following information which your renderer may find 797: useful: 798: 799: If you want to know how many rows were printed, the 'counter' element 800: of the hash passed into the render function will contain the 801: count. You may want to check whether any resources were printed at 802: all. 803: 804: =over 4 805: 806: =back 807: 808: =cut 809: 810: sub resource { return 0; } 811: sub communication_status { return 1; } 812: sub quick_status { return 2; } 813: sub long_status { return 3; } 814: 815: # Data for render_resource 816: 817: sub render_resource { 818: my ($resource, $part, $params) = @_; 819: 820: my $nonLinkedText = ''; # stuff after resource title not in link 821: 822: my $link = $params->{"resourceLink"}; 823: my $src = $resource->src(); 824: my $it = $params->{"iterator"}; 825: my $filter = $it->{FILTER}; 826: 827: my $title = $resource->compTitle(); 828: if ($src =~ /^\/uploaded\//) { 829: $nonLinkedText=$title; 830: $title = ''; 831: } 832: my $partLabel = ""; 833: my $newBranchText = ""; 834: 835: # If this is a new branch, label it so 836: if ($params->{'isNewBranch'}) { 837: $newBranchText = "<img src='/adm/lonIcons/branch.gif' border='0' />"; 838: } 839: 840: # links to open and close the folder 841: my $linkopen = "<a href='$link'>"; 842: my $linkclose = "</a>"; 843: 844: # Default icon: unknown page 845: my $icon = "<img src='/adm/lonIcons/unknown.gif' alt='' border='0' />"; 846: 847: if ($resource->is_problem()) { 848: if ($part eq '0' || $params->{'condensed'}) { 849: $icon = '<img src="/adm/lonIcons/problem.gif" alt="" border="0" />'; 850: } else { 851: $icon = $params->{'indentString'}; 852: } 853: } else { 854: my $curfext= (split (/\./,$resource->src))[-1]; 855: my $embstyle = &Apache::loncommon::fileembstyle($curfext); 856: # The unless conditional that follows is a bit of overkill 857: if (!(!defined($embstyle) || $embstyle eq 'unk' || $embstyle eq 'hdn')) { 858: $icon = "<img src='/adm/lonIcons/$curfext.gif' alt='' border='0' />"; 859: } 860: } 861: 862: # Display the correct map icon to open or shut map 863: if ($resource->is_map()) { 864: my $mapId = $resource->map_pc(); 865: my $nowOpen = !defined($filter->{$mapId}); 866: if ($it->{CONDITION}) { 867: $nowOpen = !$nowOpen; 868: } 869: 870: my $folderType = $resource->is_sequence() ? 'folder' : 'page'; 871: 872: if (!$params->{'resource_no_folder_link'}) { 873: $icon = "navmap.$folderType." . ($nowOpen ? 'closed' : 'open') . '.gif'; 874: $icon = "<img src='/adm/lonIcons/$icon' alt='' border='0' />"; 875: 876: $linkopen = "<a href='" . $params->{'url'} . '?' . 877: $params->{'queryString'} . '&filter='; 878: $linkopen .= ($nowOpen xor $it->{CONDITION}) ? 879: addToFilter($filter, $mapId) : 880: removeFromFilter($filter, $mapId); 881: $linkopen .= "&condition=" . $it->{CONDITION} . '&hereType=' 882: . $params->{'hereType'} . '&here=' . 883: &Apache::lonnet::escape($params->{'here'}) . 884: '&jump=' . 885: &Apache::lonnet::escape($resource->symb()) . 886: "&folderManip=1'>"; 887: } else { 888: # Don't allow users to manipulate folder 889: $icon = "navmap.$folderType." . ($nowOpen ? 'closed' : 'open') . 890: '.nomanip.gif'; 891: $icon = "<img src='/adm/lonIcons/$icon' alt='' border='0' />"; 892: 893: $linkopen = ""; 894: $linkclose = ""; 895: } 896: } 897: 898: if ($resource->randomout()) { 899: $nonLinkedText .= ' <i>(hidden)</i> '; 900: } 901: 902: # We're done preparing and finally ready to start the rendering 903: my $result = "<td align='left' valign='center'>"; 904: 905: my $indentLevel = $params->{'indentLevel'}; 906: if ($newBranchText) { $indentLevel--; } 907: 908: # print indentation 909: for (my $i = 0; $i < $indentLevel; $i++) { 910: $result .= $params->{'indentString'}; 911: } 912: 913: # Decide what to display 914: $result .= "$newBranchText$linkopen$icon$linkclose"; 915: 916: my $curMarkerBegin = ''; 917: my $curMarkerEnd = ''; 918: 919: # Is this the current resource? 920: if (!$params->{'displayedHereMarker'} && 921: $resource->symb() eq $params->{'here'} ) { 922: $curMarkerBegin = '<font color="red" size="+2">> </font>'; 923: $curMarkerEnd = '<font color="red" size="+2"><</font>'; 924: $params->{'displayedHereMarker'} = 1; 925: } 926: 927: if ($resource->is_problem() && $part ne '0' && 928: !$params->{'condensed'}) { 929: $partLabel = " (Part $part)"; 930: $title = ""; 931: } 932: 933: if ($params->{'condensed'} && $resource->countParts() > 1) { 934: $nonLinkedText .= ' (' . $resource->countParts() . ' parts)'; 935: } 936: 937: if (!$params->{'resource_nolink'} && $src !~ /^\/uploaded\// && 938: !$resource->is_sequence()) { 939: $result .= " $curMarkerBegin<a href='$link'>$title$partLabel</a>$curMarkerEnd $nonLinkedText</td>"; 940: } else { 941: $result .= " $curMarkerBegin$title$partLabel$curMarkerEnd $nonLinkedText</td>"; 942: } 943: 944: return $result; 945: } 946: 947: sub render_communication_status { 948: my ($resource, $part, $params) = @_; 949: my $discussionHTML = ""; my $feedbackHTML = ""; my $errorHTML = ""; 950: 951: my $link = $params->{"resourceLink"}; 952: my $linkopen = "<a href='$link'>"; 953: my $linkclose = "</a>"; 954: 955: if ($resource->hasDiscussion()) { 956: $discussionHTML = $linkopen . 957: '<img border="0" src="/adm/lonMisc/chat.gif" />' . 958: $linkclose; 959: } 960: 961: if ($resource->getFeedback()) { 962: my $feedback = $resource->getFeedback(); 963: foreach (split(/\,/, $feedback)) { 964: if ($_) { 965: $feedbackHTML .= ' <a href="/adm/email?display=' 966: . &Apache::lonnet::escape($_) . '">' 967: . '<img src="/adm/lonMisc/feedback.gif" ' 968: . 'border="0" /></a>'; 969: } 970: } 971: } 972: 973: if ($resource->getErrors()) { 974: my $errors = $resource->getErrors(); 975: foreach (split(/,/, $errors)) { 976: if ($_) { 977: $errorHTML .= ' <a href="/adm/email?display=' 978: . &Apache::lonnet::escape($_) . '">' 979: . '<img src="/adm/lonMisc/bomb.gif" ' 980: . 'border="0" /></a>'; 981: } 982: } 983: } 984: 985: if ($params->{'multipart'} && $part != '0') { 986: $discussionHTML = $feedbackHTML = $errorHTML = ''; 987: } 988: 989: return "<td width=\"75\" align=\"left\" valign=\"center\">$discussionHTML$feedbackHTML$errorHTML </td>"; 990: 991: } 992: sub render_quick_status { 993: my ($resource, $part, $params) = @_; 994: my $result = ""; 995: my $firstDisplayed = !$params->{'condensed'} && 996: $params->{'multipart'} && $part eq "0"; 997: 998: my $link = $params->{"resourceLink"}; 999: my $linkopen = "<a href='$link'>"; 1000: my $linkclose = "</a>"; 1001: 1002: if ($resource->is_problem() && 1003: !$firstDisplayed) { 1004: my $icon = $statusIconMap{$resource->status($part)}; 1005: my $alt = $iconAltTags{$icon}; 1006: if ($icon) { 1007: $result .= "<td width='30' valign='center' width='50' align='right'>$linkopen<img width='25' height='25' src='/adm/lonIcons/$icon' border='0' alt='$alt' />$linkclose</td>\n"; 1008: } else { 1009: $result .= "<td width='30'> </td>\n"; 1010: } 1011: } else { # not problem, no icon 1012: $result .= "<td width='30'> </td>\n"; 1013: } 1014: 1015: return $result; 1016: } 1017: sub render_long_status { 1018: my ($resource, $part, $params) = @_; 1019: my $result = "<td align='right' valign='center'>\n"; 1020: my $firstDisplayed = !$params->{'condensed'} && 1021: $params->{'multipart'} && $part eq "0"; 1022: 1023: my $color; 1024: if ($resource->is_problem() && ($resource->countParts() <= 1) ) { 1025: $color = $colormap{$resource->status}; 1026: 1027: if (dueInLessThen24Hours($resource, $part) || 1028: lastTry($resource, $part)) { 1029: $color = $hurryUpColor; 1030: } 1031: } 1032: 1033: if ($resource->kind() eq "res" && 1034: $resource->is_problem() && 1035: !$firstDisplayed) { 1036: if ($color) {$result .= "<font color=\"$color\"><b>"; } 1037: $result .= getDescription($resource, $part); 1038: if ($color) {$result .= "</b></font>"; } 1039: } 1040: if ($resource->is_map() && advancedUser() && $resource->randompick()) { 1041: $result .= '(randomly select ' . $resource->randompick() .')'; 1042: } 1043: 1044: $result .= "</td>\n"; 1045: 1046: return $result; 1047: } 1048: 1049: my @preparedColumns = (\&render_resource, \&render_communication_status, 1050: \&render_quick_status, \&render_long_status); 1051: 1052: sub setDefault { 1053: my ($val, $default) = @_; 1054: if (!defined($val)) { return $default; } 1055: return $val; 1056: } 1057: 1058: sub render { 1059: my $args = shift; 1060: &Apache::loncommon::get_unprocessed_cgi($ENV{QUERY_STRING}); 1061: my $result = ''; 1062: 1063: # Configure the renderer. 1064: my $cols = $args->{'cols'}; 1065: if (!defined($cols)) { 1066: # no columns, no nav maps. 1067: return ''; 1068: } 1069: my $mustCloseNavMap = 0; 1070: my $navmap; 1071: if (defined($args->{'navmap'})) { 1072: $navmap = $args->{'navmap'}; 1073: } 1074: 1075: my $r = $args->{'r'}; 1076: my $queryString = $args->{'queryString'}; 1077: my $jump = $args->{'jump'}; 1078: my $here = $args->{'here'}; 1079: my $suppressNavmap = setDefault($args->{'suppressNavmap'}, 0); 1080: my $currentJumpDelta = 2; # change this to change how many resources are displayed 1081: # before the current resource when using #current 1082: 1083: # If we were passed 'here' information, we are not rendering 1084: # after a folder manipulation, and we were not passed an 1085: # iterator, make sure we open the folders to show the "here" 1086: # marker 1087: my $filterHash = {}; 1088: # Figure out what we're not displaying 1089: foreach (split(/\,/, $ENV{"form.filter"})) { 1090: if ($_) { 1091: $filterHash->{$_} = "1"; 1092: } 1093: } 1094: 1095: # Filter: Remember filter function and add our own filter: Refuse 1096: # to show hidden resources unless the user can see them. 1097: my $userCanSeeHidden = advancedUser(); 1098: my $filterFunc = setDefault($args->{'filterFunc'}, 1099: sub {return 1;}); 1100: if (!$userCanSeeHidden) { 1101: # Without renaming the filterfunc, the server seems to go into 1102: # an infinite loop 1103: my $oldFilterFunc = $filterFunc; 1104: $filterFunc = sub { my $res = shift; return !$res->randomout() && 1105: &$oldFilterFunc($res);}; 1106: } 1107: 1108: my $condition = 0; 1109: if ($ENV{'form.condition'}) { 1110: $condition = 1; 1111: } 1112: 1113: if (!$ENV{'form.folderManip'} && !defined($args->{'iterator'})) { 1114: # Step 1: Check to see if we have a navmap 1115: if (!defined($navmap)) { 1116: $navmap = Apache::lonnavmaps::navmap->new( 1117: $ENV{"request.course.fn"}.".db", 1118: $ENV{"request.course.fn"}."_parms.db", 1, 1); 1119: $mustCloseNavMap = 1; 1120: } 1121: $navmap->init(); 1122: 1123: # Step two: Locate what kind of here marker is necessary 1124: # Determine where the "here" marker is and where the screen jumps to. 1125: 1126: if ($ENV{'form.postsymb'}) { 1127: $here = $jump = $ENV{'form.postsymb'}; 1128: } elsif ($ENV{'form.postdata'}) { 1129: # couldn't find a symb, is there a URL? 1130: my $currenturl = $ENV{'form.postdata'}; 1131: #$currenturl=~s/^http\:\/\///; 1132: #$currenturl=~s/^[^\/]+//; 1133: 1134: $here = $jump = &Apache::lonnet::symbread($currenturl); 1135: } 1136: 1137: # Step three: Ensure the folders are open 1138: my $mapIterator = $navmap->getIterator(undef, undef, undef, 1); 1139: my $depth = 1; 1140: $mapIterator->next(); # discard the first BEGIN_MAP 1141: my $curRes = $mapIterator->next(); 1142: my $found = 0; 1143: 1144: # We only need to do this if we need to open the maps to show the 1145: # current position. This will change the counter so we can't count 1146: # for the jump marker with this loop. 1147: while ($depth > 0 && !$found) { 1148: if ($curRes == $mapIterator->BEGIN_MAP()) { $depth++; } 1149: if ($curRes == $mapIterator->END_MAP()) { $depth--; } 1150: 1151: if (ref($curRes) && $curRes->symb() eq $here) { 1152: my $mapStack = $mapIterator->getStack(); 1153: 1154: # Ensure the parent maps are open 1155: for my $map (@{$mapStack}) { 1156: if ($condition) { 1157: undef $filterHash->{$map->map_pc()}; 1158: } else { 1159: $filterHash->{$map->map_pc()} = 1; 1160: } 1161: } 1162: $found = 1; 1163: } 1164: 1165: $curRes = $mapIterator->next(); 1166: } 1167: } 1168: 1169: if ( !defined($args->{'iterator'}) && $ENV{'form.folderManip'} ) { # we came from a user's manipulation of the nav page 1170: # If this is a click on a folder or something, we want to preserve the "here" 1171: # from the querystring, and get the new "jump" marker 1172: $here = $ENV{'form.here'}; 1173: $jump = $ENV{'form.jump'}; 1174: } 1175: 1176: my $it = $args->{'iterator'}; 1177: if (!defined($it)) { 1178: # Construct a default iterator based on $ENV{'form.'} information 1179: 1180: # Step 1: Check to see if we have a navmap 1181: if (!defined($navmap)) { 1182: $navmap = Apache::lonnavmaps::navmap->new($r, 1183: $ENV{"request.course.fn"}.".db", 1184: $ENV{"request.course.fn"}."_parms.db", 1, 1); 1185: $mustCloseNavMap = 1; 1186: } 1187: # Paranoia: Make sure it's ready 1188: $navmap->init(); 1189: 1190: # See if we're being passed a specific map 1191: if ($args->{'iterator_map'}) { 1192: my $map = $args->{'iterator_map'}; 1193: $map = $navmap->getResourceByUrl($map); 1194: my $firstResource = $map->map_start(); 1195: my $finishResource = $map->map_finish(); 1196: 1197: $args->{'iterator'} = $it = $navmap->getIterator($firstResource, $finishResource, $filterHash, $condition); 1198: } else { 1199: $args->{'iterator'} = $it = $navmap->getIterator(undef, undef, $filterHash, $condition); 1200: } 1201: } 1202: 1203: # (re-)Locate the jump point, if any 1204: # Note this does not take filtering or hidden into account... need 1205: # to be fixed? 1206: my $mapIterator = $navmap->getIterator(undef, undef, $filterHash, 0); 1207: my $depth = 1; 1208: $mapIterator->next(); 1209: my $curRes = $mapIterator->next(); 1210: my $foundJump = 0; 1211: my $counter = 0; 1212: 1213: while ($depth > 0 && !$foundJump) { 1214: if ($curRes == $mapIterator->BEGIN_MAP()) { $depth++; } 1215: if ($curRes == $mapIterator->END_MAP()) { $depth--; } 1216: if (ref($curRes)) { $counter++; } 1217: 1218: if (ref($curRes) && $jump eq $curRes->symb()) { 1219: 1220: # This is why we have to use the main iterator instead of the 1221: # potentially faster DFS: The count has to be the same, so 1222: # the order has to be the same, which DFS won't give us. 1223: $args->{'currentJumpIndex'} = $counter; 1224: $foundJump = 1; 1225: } 1226: 1227: $curRes = $mapIterator->next(); 1228: } 1229: 1230: my $showParts = setDefault($args->{'showParts'}, 1); 1231: my $condenseParts = setDefault($args->{'condenseParts'}, 1); 1232: # keeps track of when the current resource is found, 1233: # so we can back up a few and put the anchor above the 1234: # current resource 1235: my $printKey = $args->{'printKey'}; 1236: my $printCloseAll = $args->{'printCloseAll'}; 1237: if (!defined($printCloseAll)) { $printCloseAll = 1; } 1238: 1239: # Print key? 1240: if ($printKey) { 1241: $result .= '<table border="0" cellpadding="2" cellspacing="0">'; 1242: my $date=localtime; 1243: $result.='<tr><td align="right" valign="bottom">Key:  </td>'; 1244: if ($navmap->{LAST_CHECK}) { 1245: $result .= 1246: '<img src="/adm/lonMisc/chat.gif"> New discussion since '. 1247: strftime("%A, %b %e at %I:%M %P", localtime($navmap->{LAST_CHECK})). 1248: '</td><td align="center" valign="bottom">  '. 1249: '<img src="/adm/lonMisc/feedback.gif"> New message (click to open)<p>'. 1250: '</td>'; 1251: } else { 1252: $result .= '<td align="center" valign="bottom">  '. 1253: '<img src="/adm/lonMisc/chat.gif"> Discussions</td><td align="center" valign="bottom">'. 1254: '  <img src="/adm/lonMisc/feedback.gif"> New message (click to open)'. 1255: '</td>'; 1256: } 1257: 1258: $result .= '</tr></table>'; 1259: } 1260: 1261: if ($printCloseAll && !$args->{'resource_no_folder_link'}) { 1262: if ($condition) { 1263: $result.="<a href=\"navmaps?condition=0&filter=&$queryString" . 1264: "&here=" . Apache::lonnet::escape($here) . 1265: "\">Close All Folders</a>"; 1266: } else { 1267: $result.="<a href=\"navmaps?condition=1&filter=&$queryString" . 1268: "&here=" . Apache::lonnet::escape($here) . 1269: "\">Open All Folders</a>"; 1270: } 1271: $result .= "<br /><br />\n"; 1272: } 1273: 1274: if ($r) { 1275: $r->print($result); 1276: $r->rflush(); 1277: $result = ""; 1278: } 1279: # End parameter setting 1280: 1281: # Data 1282: $result .= '<table cellspacing="0" cellpadding="3" border="0" bgcolor="#FFFFFF">' ."\n"; 1283: my $res = "Apache::lonnavmaps::resource"; 1284: my %condenseStatuses = 1285: ( $res->NETWORK_FAILURE => 1, 1286: $res->NOTHING_SET => 1, 1287: $res->CORRECT => 1 ); 1288: my @backgroundColors = ("#FFFFFF", "#F6F6F6"); 1289: 1290: # Shared variables 1291: $args->{'counter'} = 0; # counts the rows 1292: $args->{'indentLevel'} = 0; 1293: $args->{'isNewBranch'} = 0; 1294: $args->{'condensed'} = 0; 1295: $args->{'indentString'} = setDefault($args->{'indentString'}, "<img src='/adm/lonIcons/whitespace1.gif' width='25' height='1' alt='' border='0' />"); 1296: $args->{'displayedHereMarker'} = 0; 1297: 1298: # If we're suppressing empty sequences, look for them here. Use DFS for speed, 1299: # since structure actually doesn't matter, except what map has what resources. 1300: if ($args->{'suppressEmptySequences'}) { 1301: my $dfsit = Apache::lonnavmaps::DFSiterator->new($navmap, 1302: $it->{FIRST_RESOURCE}, 1303: $it->{FINISH_RESOURCE}, 1304: {}, undef, 1); 1305: $depth = 0; 1306: $dfsit->next(); 1307: my $curRes = $dfsit->next(); 1308: while ($depth > -1) { 1309: if ($curRes == $dfsit->BEGIN_MAP()) { $depth++; } 1310: if ($curRes == $dfsit->END_MAP()) { $depth--; } 1311: 1312: if (ref($curRes)) { 1313: # Parallel pre-processing: Do sequences have non-filtered-out children? 1314: if ($curRes->is_map()) { 1315: $curRes->{DATA}->{HAS_VISIBLE_CHILDREN} = 0; 1316: # Sequences themselves do not count as visible children, 1317: # unless those sequences also have visible children. 1318: # This means if a sequence appears, there's a "promise" 1319: # that there's something under it if you open it, somewhere. 1320: } else { 1321: # Not a sequence: if it's filtered, ignore it, otherwise 1322: # rise up the stack and mark the sequences as having children 1323: if (&$filterFunc($curRes)) { 1324: for my $sequence (@{$dfsit->getStack()}) { 1325: $sequence->{DATA}->{HAS_VISIBLE_CHILDREN} = 1; 1326: } 1327: } 1328: } 1329: } 1330: } continue { 1331: $curRes = $dfsit->next(); 1332: } 1333: } 1334: 1335: my $displayedJumpMarker = 0; 1336: # Set up iteration. 1337: $depth = 1; 1338: $it->next(); # discard initial BEGIN_MAP 1339: $curRes = $it->next(); 1340: my $now = time(); 1341: my $in24Hours = $now + 24 * 60 * 60; 1342: my $rownum = 0; 1343: 1344: # export "here" marker information 1345: $args->{'here'} = $here; 1346: 1347: while ($depth > 0) { 1348: if ($curRes == $it->BEGIN_MAP()) { $depth++; } 1349: if ($curRes == $it->END_MAP()) { $depth--; } 1350: 1351: # Maintain indentation level. 1352: if ($curRes == $it->BEGIN_MAP() || 1353: $curRes == $it->BEGIN_BRANCH() ) { 1354: $args->{'indentLevel'}++; 1355: } 1356: if ($curRes == $it->END_MAP() || 1357: $curRes == $it->END_BRANCH() ) { 1358: $args->{'indentLevel'}--; 1359: } 1360: # Notice new branches 1361: if ($curRes == $it->BEGIN_BRANCH()) { 1362: $args->{'isNewBranch'} = 1; 1363: } 1364: 1365: # If this isn't an actual resource, continue on 1366: if (!ref($curRes)) { 1367: next; 1368: } 1369: 1370: # If this has been filtered out, continue on 1371: if (!(&$filterFunc($curRes))) { 1372: $args->{'isNewBranch'} = 0; # Don't falsely remember this 1373: next; 1374: } 1375: 1376: # If this is an empty sequence and we're filtering them, continue on 1377: if ($curRes->is_map() && $args->{'suppressEmptySequences'} && 1378: !$curRes->{DATA}->{HAS_VISIBLE_CHILDREN}) { 1379: next; 1380: } 1381: 1382: # If we're suppressing navmaps and this is a navmap, continue on 1383: if ($suppressNavmap && $curRes->src() =~ /^\/adm\/navmaps/) { 1384: next; 1385: } 1386: 1387: $args->{'counter'}++; 1388: 1389: # Does it have multiple parts? 1390: $args->{'multipart'} = 0; 1391: $args->{'condensed'} = 0; 1392: my @parts; 1393: 1394: # Decide what parts to show. 1395: if ($curRes->is_problem() && $showParts) { 1396: @parts = @{$curRes->parts()}; 1397: $args->{'multipart'} = $curRes->multipart(); 1398: 1399: if ($condenseParts) { # do the condensation 1400: if (!$curRes->opendate("0")) { 1401: @parts = (); 1402: $args->{'condensed'} = 1; 1403: } 1404: if (!$args->{'condensed'}) { 1405: # Decide whether to condense based on similarity 1406: my $status = $curRes->status($parts[0]); 1407: my $due = $curRes->duedate($parts[0]); 1408: my $open = $curRes->opendate($parts[0]); 1409: my $statusAllSame = 1; 1410: my $dueAllSame = 1; 1411: my $openAllSame = 1; 1412: for (my $i = 1; $i < scalar(@parts); $i++) { 1413: if ($curRes->status($parts[$i]) != $status){ 1414: $statusAllSame = 0; 1415: } 1416: if ($curRes->duedate($parts[$i]) != $due ) { 1417: $dueAllSame = 0; 1418: } 1419: if ($curRes->opendate($parts[$i]) != $open) { 1420: $openAllSame = 0; 1421: } 1422: } 1423: # $*allSame is true if all the statuses were 1424: # the same. Now, if they are all the same and 1425: # match one of the statuses to condense, or they 1426: # are all open with the same due date, or they are 1427: # all OPEN_LATER with the same open date, display the 1428: # status of the first non-zero part (to get the 'correct' 1429: # status right, since 0 is never 'correct' or 'open'). 1430: if (($statusAllSame && defined($condenseStatuses{$status})) || 1431: ($dueAllSame && $status == $curRes->OPEN && $statusAllSame)|| 1432: ($openAllSame && $status == $curRes->OPEN_LATER && $statusAllSame) ){ 1433: @parts = ($parts[0]); 1434: $args->{'condensed'} = 1; 1435: } 1436: } 1437: # Multipart problem with one part: always "condense" (happens 1438: # to match the desirable behavior) 1439: if ($curRes->countParts() == 1) { 1440: @parts = ($parts[0]); 1441: $args->{'condensed'} = 1; 1442: } 1443: } 1444: } 1445: 1446: # If the multipart problem was condensed, "forget" it was multipart 1447: if (scalar(@parts) == 1) { 1448: $args->{'multipart'} = 0; 1449: } else { 1450: # Add part 0 so we display it correctly. 1451: unshift @parts, '0'; 1452: } 1453: 1454: # Now, we've decided what parts to show. Loop through them and 1455: # show them. 1456: foreach my $part (@parts) { 1457: $rownum ++; 1458: my $backgroundColor = $backgroundColors[$rownum % scalar(@backgroundColors)]; 1459: 1460: $result .= " <tr bgcolor='$backgroundColor'>\n"; 1461: 1462: # Set up some data about the parts that the cols might want 1463: my $filter = $it->{FILTER}; 1464: my $stack = $it->getStack(); 1465: my $src = getLinkForResource($stack); 1466: 1467: my $srcHasQuestion = $src =~ /\?/; 1468: $args->{"resourceLink"} = $src. 1469: ($srcHasQuestion?'&':'?') . 1470: 'symb=' . &Apache::lonnet::escape($curRes->symb()); 1471: 1472: # Now, display each column. 1473: foreach my $col (@$cols) { 1474: my $colHTML = ''; 1475: if (ref($col)) { 1476: $colHTML .= &$col($curRes, $part, $args); 1477: } else { 1478: $colHTML .= &{$preparedColumns[$col]}($curRes, $part, $args); 1479: } 1480: 1481: # If this is the first column and it's time to print 1482: # the anchor, do so 1483: if ($col == $cols->[0] && 1484: $args->{'counter'} == $args->{'currentJumpIndex'} - 1485: $currentJumpDelta) { 1486: # Jam the anchor after the <td> tag; 1487: # necessary for valid HTML (which Mozilla requires) 1488: $colHTML =~ s/\>/\>\<a name="curloc" \/\>/; 1489: $displayedJumpMarker = 1; 1490: } 1491: $result .= $colHTML . "\n"; 1492: } 1493: $result .= " </tr>\n"; 1494: $args->{'isNewBranch'} = 0; 1495: } 1496: 1497: if ($r && $rownum % 20 == 0) { 1498: $r->print($result); 1499: $result = ""; 1500: $r->rflush(); 1501: } 1502: } continue { 1503: $curRes = $it->next(); 1504: 1505: if ($r) { 1506: # If we have the connection, make sure the user is still connected 1507: my $c = $r->connection; 1508: if ($c->aborted()) { 1509: Apache::lonnet::logthis("navmaps aborted"); 1510: # Who cares what we do, nobody will see it anyhow. 1511: return ''; 1512: } 1513: } 1514: } 1515: 1516: # Print out the part that jumps to #curloc if it exists 1517: # delay needed because the browser is processing the jump before 1518: # it finishes rendering, so it goes to the wrong place! 1519: # onload might be better, but this routine has no access to that. 1520: # On mozilla, the 0-millisecond timeout seems to prevent this; 1521: # it's quite likely this might fix other browsers, too, and 1522: # certainly won't hurt anything. 1523: if ($displayedJumpMarker) { 1524: $result .= "<script>setTimeout(\"location += '#curloc';\", 0)</script>\n"; 1525: } 1526: 1527: $result .= "</table>"; 1528: 1529: if ($r) { 1530: $r->print($result); 1531: $result = ""; 1532: $r->rflush(); 1533: } 1534: 1535: if ($mustCloseNavMap) { $navmap->untieHashes(); } 1536: 1537: return $result; 1538: } 1539: 1540: 1; 1541: 1542: package Apache::lonnavmaps::navmap; 1543: 1544: =pod 1545: 1546: lonnavmaps provides functions and objects for dealing with the 1547: compiled course hashes generated when a user enters the course, the 1548: Apache handler for the "Navigation Map" button, and a flexible 1549: prepared renderer for navigation maps that are easy to use anywhere. 1550: 1551: =head1 Object: navmap 1552: 1553: Encapsulating the compiled nav map 1554: 1555: navmap is an object that encapsulates a compiled course map and 1556: provides a reasonable interface to it. 1557: 1558: Most notably it provides a way to navigate the map sensibly and a 1559: flexible iterator that makes it easy to write various renderers based 1560: on nav maps. 1561: 1562: You must obtain resource objects through the navmap object. 1563: 1564: =head2 Methods 1565: 1566: =over 4 1567: 1568: =item * B<new>(navHashFile, parmHashFile, genCourseAndUserOptions, 1569: genMailDiscussStatus): 1570: 1571: Binds a new navmap object to the compiled nav map hash and parm hash 1572: given as filenames. genCourseAndUserOptions is a flag saying whether 1573: the course options and user options hash should be generated. This is 1574: for when you are using the parameters of the resources that require 1575: them; see documentation in resource object 1576: documentation. genMailDiscussStatus causes the nav map to retreive 1577: information about the email and discussion status of 1578: resources. Returns the navmap object if this is successful, or 1579: B<undef> if not. You must check for undef; errors will occur when you 1580: try to use the other methods otherwise. 1581: 1582: =item * B<getIterator>(first, finish, filter, condition): 1583: 1584: See iterator documentation below. 1585: 1586: =cut 1587: 1588: use strict; 1589: use GDBM_File; 1590: 1591: sub new { 1592: # magic invocation to create a class instance 1593: my $proto = shift; 1594: my $class = ref($proto) || $proto; 1595: my $self = {}; 1596: 1597: $self->{NAV_HASH_FILE} = shift; 1598: $self->{PARM_HASH_FILE} = shift; 1599: $self->{GENERATE_COURSE_USER_OPT} = shift; 1600: $self->{GENERATE_EMAIL_DISCUSS_STATUS} = shift; 1601: 1602: # Resource cache stores navmap resources as we reference them. We generate 1603: # them on-demand so we don't pay for creating resources unless we use them. 1604: $self->{RESOURCE_CACHE} = {}; 1605: 1606: # Network failure flag, if we accessed the course or user opt and 1607: # failed 1608: $self->{NETWORK_FAILURE} = 0; 1609: 1610: # tie the nav hash 1611: 1612: my %navmaphash; 1613: my %parmhash; 1614: if (!(tie(%navmaphash, 'GDBM_File', $self->{NAV_HASH_FILE}, 1615: &GDBM_READER(), 0640))) { 1616: return undef; 1617: } 1618: 1619: if (!(tie(%parmhash, 'GDBM_File', $self->{PARM_HASH_FILE}, 1620: &GDBM_READER(), 0640))) 1621: { 1622: untie %{$self->{PARM_HASH}}; 1623: return undef; 1624: } 1625: 1626: $self->{NAV_HASH} = \%navmaphash; 1627: $self->{PARM_HASH} = \%parmhash; 1628: $self->{INITED} = 0; 1629: 1630: bless($self); 1631: 1632: return $self; 1633: } 1634: 1635: sub init { 1636: my $self = shift; 1637: if ($self->{INITED}) { return; } 1638: 1639: # If the course opt hash and the user opt hash should be generated, 1640: # generate them 1641: if ($self->{GENERATE_COURSE_USER_OPT}) { 1642: my $uname=$ENV{'user.name'}; 1643: my $udom=$ENV{'user.domain'}; 1644: my $uhome=$ENV{'user.home'}; 1645: my $cid=$ENV{'request.course.id'}; 1646: my $chome=$ENV{'course.'.$cid.'.home'}; 1647: my ($cdom,$cnum)=split(/\_/,$cid); 1648: 1649: my $userprefix=$uname.'_'.$udom.'_'; 1650: 1651: my %courserdatas; my %useropt; my %courseopt; my %userrdatas; 1652: unless ($uhome eq 'no_host') { 1653: # ------------------------------------------------- Get coursedata (if present) 1654: unless ((time-$courserdatas{$cid.'.last_cache'})<240) { 1655: my $reply=&Apache::lonnet::reply('dump:'.$cdom.':'.$cnum. 1656: ':resourcedata',$chome); 1657: # Check for network failure 1658: if ( $reply =~ /no.such.host/i || $reply =~ /con_lost/i) { 1659: $self->{NETWORK_FAILURE} = 1; 1660: } elsif ($reply!~/^error\:/) { 1661: $courserdatas{$cid}=$reply; 1662: $courserdatas{$cid.'.last_cache'}=time; 1663: } 1664: } 1665: foreach (split(/\&/,$courserdatas{$cid})) { 1666: my ($name,$value)=split(/\=/,$_); 1667: $courseopt{$userprefix.&Apache::lonnet::unescape($name)}= 1668: &Apache::lonnet::unescape($value); 1669: } 1670: # --------------------------------------------------- Get userdata (if present) 1671: unless ((time-$userrdatas{$uname.'___'.$udom.'.last_cache'})<240) { 1672: my $reply=&Apache::lonnet::reply('dump:'.$udom.':'.$uname.':resourcedata',$uhome); 1673: if ($reply!~/^error\:/) { 1674: $userrdatas{$uname.'___'.$udom}=$reply; 1675: $userrdatas{$uname.'___'.$udom.'.last_cache'}=time; 1676: } 1677: # check to see if network failed 1678: elsif ( $reply=~/no.such.host/i || $reply=~/con.*lost/i ) 1679: { 1680: $self->{NETWORK_FAILURE} = 1; 1681: } 1682: } 1683: foreach (split(/\&/,$userrdatas{$uname.'___'.$udom})) { 1684: my ($name,$value)=split(/\=/,$_); 1685: $useropt{$userprefix.&Apache::lonnet::unescape($name)}= 1686: &Apache::lonnet::unescape($value); 1687: } 1688: $self->{COURSE_OPT} = \%courseopt; 1689: $self->{USER_OPT} = \%useropt; 1690: } 1691: } 1692: 1693: if ($self->{GENERATE_EMAIL_DISCUSS_STATUS}) { 1694: my $cid=$ENV{'request.course.id'}; 1695: my ($cdom,$cnum)=split(/\_/,$cid); 1696: 1697: my %emailstatus = &Apache::lonnet::dump('email_status'); 1698: my $logoutTime = $emailstatus{'logout'}; 1699: my $courseLeaveTime = $emailstatus{'logout_'.$ENV{'request.course.id'}}; 1700: $self->{LAST_CHECK} = (($courseLeaveTime > $logoutTime) ? 1701: $courseLeaveTime : $logoutTime); 1702: my %discussiontime = &Apache::lonnet::dump('discussiontimes', 1703: $cdom, $cnum); 1704: my %feedback=(); 1705: my %error=(); 1706: my $keys = &Apache::lonnet::reply('keys:'. 1707: $ENV{'user.domain'}.':'. 1708: $ENV{'user.name'}.':nohist_email', 1709: $ENV{'user.home'}); 1710: 1711: foreach my $msgid (split(/\&/, $keys)) { 1712: $msgid=&Apache::lonnet::unescape($msgid); 1713: my $plain=&Apache::lonnet::unescape(&Apache::lonnet::unescape($msgid)); 1714: if ($plain=~/(Error|Feedback) \[([^\]]+)\]/) { 1715: my ($what,$url)=($1,$2); 1716: my %status= 1717: &Apache::lonnet::get('email_status',[$msgid]); 1718: if ($status{$msgid}=~/^error\:/) { 1719: $status{$msgid}=''; 1720: } 1721: 1722: if (($status{$msgid} eq 'new') || 1723: (!$status{$msgid})) { 1724: if ($what eq 'Error') { 1725: $error{$url}.=','.$msgid; 1726: } else { 1727: $feedback{$url}.=','.$msgid; 1728: } 1729: } 1730: } 1731: } 1732: 1733: $self->{FEEDBACK} = \%feedback; 1734: $self->{ERROR_MSG} = \%error; # what is this? JB 1735: $self->{DISCUSSION_TIME} = \%discussiontime; 1736: $self->{EMAIL_STATUS} = \%emailstatus; 1737: 1738: } 1739: 1740: $self->{PARM_CACHE} = {}; 1741: $self->{INITED} = 1; 1742: } 1743: 1744: # Internal function: Takes a key to look up in the nav hash and implements internal 1745: # memory caching of that key. 1746: sub navhash { 1747: my $self = shift; my $key = shift; 1748: return $self->{NAV_HASH}->{$key}; 1749: } 1750: 1751: # Checks to see if coursemap is defined, matching test in old lonnavmaps 1752: sub courseMapDefined { 1753: my $self = shift; 1754: my $uri = &Apache::lonnet::clutter($ENV{'request.course.uri'}); 1755: 1756: my $firstres = $self->navhash("map_start_$uri"); 1757: my $lastres = $self->navhash("map_finish_$uri"); 1758: return $firstres && $lastres; 1759: } 1760: 1761: sub getIterator { 1762: my $self = shift; 1763: my $iterator = Apache::lonnavmaps::iterator->new($self, shift, shift, 1764: shift, undef, shift); 1765: return $iterator; 1766: } 1767: 1768: # unties the hash when done 1769: sub untieHashes { 1770: my $self = shift; 1771: untie %{$self->{NAV_HASH}}; 1772: untie %{$self->{PARM_HASH}}; 1773: } 1774: 1775: # Private method: Does the given resource (as a symb string) have 1776: # current discussion? Returns 0 if chat/mail data not extracted. 1777: sub hasDiscussion { 1778: my $self = shift; 1779: my $symb = shift; 1780: if (!defined($self->{DISCUSSION_TIME})) { return 0; } 1781: 1782: #return defined($self->{DISCUSSION_TIME}->{$symb}); 1783: return $self->{DISCUSSION_TIME}->{$symb} > 1784: $self->{LAST_CHECK}; 1785: } 1786: 1787: # Private method: Does the given resource (as a symb string) have 1788: # current feedback? Returns the string in the feedback hash, which 1789: # will be false if it does not exist. 1790: sub getFeedback { 1791: my $self = shift; 1792: my $symb = shift; 1793: 1794: if (!defined($self->{FEEDBACK})) { return ""; } 1795: 1796: return $self->{FEEDBACK}->{$symb}; 1797: } 1798: 1799: # Private method: Get the errors for that resource (by source). 1800: sub getErrors { 1801: my $self = shift; 1802: my $src = shift; 1803: 1804: if (!defined($self->{ERROR_MSG})) { return ""; } 1805: return $self->{ERROR_MSG}->{$src}; 1806: } 1807: 1808: =pod 1809: 1810: =item * B<getById>(id): 1811: 1812: Based on the ID of the resource (1.1, 3.2, etc.), get a resource 1813: object for that resource. This method, or other methods that use it 1814: (as in the resource object) is the only proper way to obtain a 1815: resource object. 1816: 1817: =item * B<getBySymb>(symb): 1818: 1819: Based on the symb of the resource, get a resource object for that 1820: resource. This is one of the proper ways to get a resource object. 1821: 1822: =item * B<getMapByMapPc>(map_pc): 1823: 1824: Based on the map_pc of the resource, get a resource object for 1825: the given map. This is one of the proper ways to get a resource object. 1826: 1827: =cut 1828: 1829: # The strategy here is to cache the resource objects, and only construct them 1830: # as we use them. The real point is to prevent reading any more from the tied 1831: # hash then we have to, which should hopefully alleviate speed problems. 1832: # Caching is just an incidental detail I throw in because it makes sense. 1833: 1834: sub getById { 1835: my $self = shift; 1836: my $id = shift; 1837: 1838: if (defined ($self->{RESOURCE_CACHE}->{$id})) 1839: { 1840: return $self->{RESOURCE_CACHE}->{$id}; 1841: } 1842: 1843: # resource handles inserting itself into cache. 1844: # Not clear why the quotes are necessary, but as of this 1845: # writing it doesn't work without them. 1846: return "Apache::lonnavmaps::resource"->new($self, $id); 1847: } 1848: 1849: sub getBySymb { 1850: my $self = shift; 1851: my $symb = shift; 1852: my ($mapUrl, $id, $filename) = split (/___/, $symb); 1853: my $map = $self->getResourceByUrl($mapUrl); 1854: return $self->getById($map->map_pc() . '.' . $id); 1855: } 1856: 1857: sub getByMapPc { 1858: my $self = shift; 1859: my $map_pc = shift; 1860: my $map_id = $self->{NAV_HASH}->{'map_id_' . $map_pc}; 1861: $map_id = $self->{NAV_HASH}->{'ids_' . $map_id}; 1862: return $self->getById($map_id); 1863: } 1864: 1865: =pod 1866: 1867: =item * B<firstResource>(): 1868: 1869: Returns a resource object reference corresponding to the first 1870: resource in the navmap. 1871: 1872: =cut 1873: 1874: sub firstResource { 1875: my $self = shift; 1876: my $firstResource = $self->navhash('map_start_' . 1877: &Apache::lonnet::clutter($ENV{'request.course.uri'})); 1878: return $self->getById($firstResource); 1879: } 1880: 1881: =pod 1882: 1883: =item * B<finishResource>(): 1884: 1885: Returns a resource object reference corresponding to the last resource 1886: in the navmap. 1887: 1888: =cut 1889: 1890: sub finishResource { 1891: my $self = shift; 1892: my $firstResource = $self->navhash('map_finish_' . 1893: &Apache::lonnet::clutter($ENV{'request.course.uri'})); 1894: return $self->getById($firstResource); 1895: } 1896: 1897: # Parmval reads the parm hash and cascades the lookups. parmval_real does 1898: # the actual lookup; parmval caches the results. 1899: sub parmval { 1900: my $self = shift; 1901: my ($what,$symb)=@_; 1902: my $hashkey = $what."|||".$symb; 1903: 1904: if (defined($self->{PARM_CACHE}->{$hashkey})) { 1905: return $self->{PARM_CACHE}->{$hashkey}; 1906: } 1907: 1908: my $result = $self->parmval_real($what, $symb); 1909: $self->{PARM_CACHE}->{$hashkey} = $result; 1910: return $result; 1911: } 1912: 1913: sub parmval_real { 1914: my $self = shift; 1915: my ($what,$symb) = @_; 1916: 1917: my $cid=$ENV{'request.course.id'}; 1918: my $csec=$ENV{'request.course.sec'}; 1919: my $uname=$ENV{'user.name'}; 1920: my $udom=$ENV{'user.domain'}; 1921: 1922: unless ($symb) { return ''; } 1923: my $result=''; 1924: 1925: my ($mapname,$id,$fn)=split(/\_\_\_/,$symb); 1926: 1927: # ----------------------------------------------------- Cascading lookup scheme 1928: my $rwhat=$what; 1929: $what=~s/^parameter\_//; 1930: $what=~s/\_/\./; 1931: 1932: my $symbparm=$symb.'.'.$what; 1933: my $mapparm=$mapname.'___(all).'.$what; 1934: my $usercourseprefix=$uname.'_'.$udom.'_'.$cid; 1935: 1936: my $seclevel= $usercourseprefix.'.['.$csec.'].'.$what; 1937: my $seclevelr=$usercourseprefix.'.['.$csec.'].'.$symbparm; 1938: my $seclevelm=$usercourseprefix.'.['.$csec.'].'.$mapparm; 1939: 1940: my $courselevel= $usercourseprefix.'.'.$what; 1941: my $courselevelr=$usercourseprefix.'.'.$symbparm; 1942: my $courselevelm=$usercourseprefix.'.'.$mapparm; 1943: 1944: my $useropt = $self->{USER_OPT}; 1945: my $courseopt = $self->{COURSE_OPT}; 1946: my $parmhash = $self->{PARM_HASH}; 1947: 1948: # ---------------------------------------------------------- first, check user 1949: if ($uname and defined($useropt)) { 1950: if (defined($$useropt{$courselevelr})) { return $$useropt{$courselevelr}; } 1951: if (defined($$useropt{$courselevelm})) { return $$useropt{$courselevelm}; } 1952: if (defined($$useropt{$courselevel})) { return $$useropt{$courselevel}; } 1953: } 1954: 1955: # ------------------------------------------------------- second, check course 1956: if ($csec and defined($courseopt)) { 1957: if (defined($$courseopt{$seclevelr})) { return $$courseopt{$seclevelr}; } 1958: if (defined($$courseopt{$seclevelm})) { return $$courseopt{$seclevelm}; } 1959: if (defined($$courseopt{$seclevel})) { return $$courseopt{$seclevel}; } 1960: } 1961: 1962: if (defined($courseopt)) { 1963: if (defined($$courseopt{$courselevelr})) { return $$courseopt{$courselevelr}; } 1964: if (defined($$courseopt{$courselevelm})) { return $$courseopt{$courselevelm}; } 1965: if (defined($$courseopt{$courselevel})) { return $$courseopt{$courselevel}; } 1966: } 1967: 1968: # ----------------------------------------------------- third, check map parms 1969: 1970: my $thisparm=$$parmhash{$symbparm}; 1971: if (defined($thisparm)) { return $thisparm; } 1972: 1973: # ----------------------------------------------------- fourth , check default 1974: 1975: my $default=&Apache::lonnet::metadata($fn,$rwhat.'.default'); 1976: if (defined($default)) { return $default} 1977: 1978: # --------------------------------------------------- fifth , cascade up parts 1979: 1980: my ($space,@qualifier)=split(/\./,$rwhat); 1981: my $qualifier=join('.',@qualifier); 1982: unless ($space eq '0') { 1983: my @parts=split(/_/,$space); 1984: my $id=pop(@parts); 1985: my $part=join('_',@parts); 1986: if ($part eq '') { $part='0'; } 1987: my $partgeneral=$self->parmval($part.".$qualifier",$symb); 1988: if (defined($partgeneral)) { return $partgeneral; } 1989: } 1990: return ''; 1991: } 1992: 1993: =pod 1994: 1995: =item * B<getResourceByUrl>(url): 1996: 1997: Retrieves a resource object by URL of the resource. If passed a 1998: resource object, it will simply return it, so it is safe to use this 1999: method in code like "$res = $navmap->getResourceByUrl($res)", if 2000: you're not sure if $res is already an object, or just a URL. If the 2001: resource appears multiple times in the course, only the first instance 2002: will be returned. As a result, this is probably useful only for maps. 2003: 2004: =item * B<retrieveResources>(map, filterFunc, recursive, bailout): 2005: 2006: The map is a specification of a map to retreive the resources from, 2007: either as a url or as an object. The filterFunc is a reference to a 2008: function that takes a resource object as its one argument and returns 2009: true if the resource should be included, or false if it should not 2010: be. If recursive is true, the map will be recursively examined, 2011: otherwise it will not be. If bailout is true, the function will return 2012: as soon as it finds a resource, if false it will finish. By default, 2013: the map is the top-level map of the course, filterFunc is a function 2014: that always returns 1, recursive is true, bailout is false. The 2015: resources will be returned in a list containing the resource objects 2016: for the corresponding resources, with B<no structure information> in 2017: the list; regardless of branching, recursion, etc., it will be a flat 2018: list. 2019: 2020: Thus, this is suitable for cases where you don't want the structure, 2021: just a list of all resources. It is also suitable for finding out how 2022: many resources match a given description; for this use, if all you 2023: want to know is if I<any> resources match the description, the bailout 2024: parameter will allow you to avoid potentially expensive enumeration of 2025: all matching resources. 2026: 2027: =item * B<hasResources>(map, filterFunc, recursive): 2028: 2029: Convience method for 2030: 2031: scalar(retrieveResources($map, $filterFunc, $recursive, 1)) > 0 2032: 2033: which will tell whether the map has resources matching the description 2034: in the filter function. 2035: 2036: =cut 2037: 2038: sub getResourceByUrl { 2039: my $self = shift; 2040: my $resUrl = shift; 2041: 2042: if (ref($resUrl)) { return $resUrl; } 2043: 2044: $resUrl = &Apache::lonnet::clutter($resUrl); 2045: my $resId = $self->{NAV_HASH}->{'ids_' . $resUrl}; 2046: if ($resId =~ /,/) { 2047: $resId = (split (/,/, $resId))[0]; 2048: } 2049: if (!$resId) { return ''; } 2050: return $self->getById($resId); 2051: } 2052: 2053: sub retrieveResources { 2054: my $self = shift; 2055: my $map = shift; 2056: my $filterFunc = shift; 2057: if (!defined ($filterFunc)) { 2058: $filterFunc = sub {return 1;}; 2059: } 2060: my $recursive = shift; 2061: if (!defined($recursive)) { $recursive = 1; } 2062: my $bailout = shift; 2063: if (!defined($bailout)) { $bailout = 0; } 2064: 2065: # Create the necessary iterator. 2066: if (!ref($map)) { # assume it's a url of a map. 2067: $map = $self->getResourceByUrl($map); 2068: } 2069: 2070: # Check the map's validity. 2071: if (!$map || !$map->is_map()) { 2072: # Oh, to throw an exception.... how I'd love that! 2073: return (); 2074: } 2075: 2076: # Get an iterator. 2077: my $it = $self->getIterator($map->map_start(), $map->map_finish(), 2078: !$recursive); 2079: 2080: my @resources = (); 2081: 2082: # Run down the iterator and collect the resources. 2083: my $depth = 1; 2084: $it->next(); 2085: my $curRes = $it->next(); 2086: 2087: while ($depth > 0) { 2088: if ($curRes == $it->BEGIN_MAP()) { 2089: $depth++; 2090: } 2091: if ($curRes == $it->END_MAP()) { 2092: $depth--; 2093: } 2094: 2095: if (ref($curRes)) { 2096: if (!&$filterFunc($curRes)) { 2097: next; 2098: } 2099: 2100: push @resources, $curRes; 2101: 2102: if ($bailout) { 2103: return @resources; 2104: } 2105: } 2106: 2107: $curRes = $it->next(); 2108: } 2109: 2110: return @resources; 2111: } 2112: 2113: sub hasResource { 2114: my $self = shift; 2115: my $map = shift; 2116: my $filterFunc = shift; 2117: my $recursive = shift; 2118: 2119: return scalar($self->retrieveResources($map, $filterFunc, $recursive, 1)) > 0; 2120: } 2121: 2122: 1; 2123: 2124: package Apache::lonnavmaps::iterator; 2125: 2126: =pod 2127: 2128: =back 2129: 2130: =head1 Object: navmap Iterator 2131: 2132: An I<iterator> encapsulates the logic required to traverse a data 2133: structure. navmap uses an iterator to traverse the course map 2134: according to the criteria you wish to use. 2135: 2136: To obtain an iterator, call the B<getIterator>() function of a 2137: B<navmap> object. (Do not instantiate Apache::lonnavmaps::iterator 2138: directly.) This will return a reference to the iterator: 2139: 2140: C<my $resourceIterator = $navmap-E<gt>getIterator();> 2141: 2142: To get the next thing from the iterator, call B<next>: 2143: 2144: C<my $nextThing = $resourceIterator-E<gt>next()> 2145: 2146: getIterator behaves as follows: 2147: 2148: =over 4 2149: 2150: =item * B<getIterator>(firstResource, finishResource, filterHash, condition, forceTop, returnTopMap): 2151: 2152: All parameters are optional. firstResource is a resource reference 2153: corresponding to where the iterator should start. It defaults to 2154: navmap->firstResource() for the corresponding nav map. finishResource 2155: corresponds to where you want the iterator to end, defaulting to 2156: navmap->finishResource(). filterHash is a hash used as a set 2157: containing strings representing the resource IDs, defaulting to 2158: empty. Condition is a 1 or 0 that sets what to do with the filter 2159: hash: If a 0, then only resources that exist IN the filterHash will be 2160: recursed on. If it is a 1, only resources NOT in the filterHash will 2161: be recursed on. Defaults to 0. forceTop is a boolean value. If it is 2162: false (default), the iterator will only return the first level of map 2163: that is not just a single, 'redirecting' map. If true, the iterator 2164: will return all information, starting with the top-level map, 2165: regardless of content. returnTopMap, if true (default false), will 2166: cause the iterator to return the top-level map object (resource 0.0) 2167: before anything else. 2168: 2169: Thus, by default, only top-level resources will be shown. Change the 2170: condition to a 1 without changing the hash, and all resources will be 2171: shown. Changing the condition to 1 and including some values in the 2172: hash will allow you to selectively suppress parts of the navmap, while 2173: leaving it on 0 and adding things to the hash will allow you to 2174: selectively add parts of the nav map. See the handler code for 2175: examples. 2176: 2177: The iterator will return either a reference to a resource object, or a 2178: token representing something in the map, such as the beginning of a 2179: new branch. The possible tokens are: 2180: 2181: =over 4 2182: 2183: =item * BEGIN_MAP: 2184: 2185: A new map is being recursed into. This is returned I<after> the map 2186: resource itself is returned. 2187: 2188: =item * END_MAP: 2189: 2190: The map is now done. 2191: 2192: =item * BEGIN_BRANCH: 2193: 2194: A branch is now starting. The next resource returned will be the first 2195: in that branch. 2196: 2197: =item * END_BRANCH: 2198: 2199: The branch is now done. 2200: 2201: =back 2202: 2203: The tokens are retreivable via methods on the iterator object, i.e., 2204: $iterator->END_MAP. 2205: 2206: Maps can contain empty resources. The iterator will automatically skip 2207: over such resources, but will still treat the structure 2208: correctly. Thus, a complicated map with several branches, but 2209: consisting entirely of empty resources except for one beginning or 2210: ending resource, will cause a lot of BRANCH_STARTs and BRANCH_ENDs, 2211: but only one resource will be returned. 2212: 2213: =back 2214: 2215: =cut 2216: 2217: # Here are the tokens for the iterator: 2218: 2219: sub BEGIN_MAP { return 1; } # begining of a new map 2220: sub END_MAP { return 2; } # end of the map 2221: sub BEGIN_BRANCH { return 3; } # beginning of a branch 2222: sub END_BRANCH { return 4; } # end of a branch 2223: sub FORWARD { return 1; } # go forward 2224: sub BACKWARD { return 2; } 2225: 2226: sub min { 2227: (my $a, my $b) = @_; 2228: if ($a < $b) { return $a; } else { return $b; } 2229: } 2230: 2231: sub new { 2232: # magic invocation to create a class instance 2233: my $proto = shift; 2234: my $class = ref($proto) || $proto; 2235: my $self = {}; 2236: 2237: $self->{NAV_MAP} = shift; 2238: return undef unless ($self->{NAV_MAP}); 2239: 2240: # Handle the parameters 2241: $self->{FIRST_RESOURCE} = shift || $self->{NAV_MAP}->firstResource(); 2242: $self->{FINISH_RESOURCE} = shift || $self->{NAV_MAP}->finishResource(); 2243: 2244: # If the given resources are just the ID of the resource, get the 2245: # objects 2246: if (!ref($self->{FIRST_RESOURCE})) { $self->{FIRST_RESOURCE} = 2247: $self->{NAV_MAP}->getById($self->{FIRST_RESOURCE}); } 2248: if (!ref($self->{FINISH_RESOURCE})) { $self->{FINISH_RESOURCE} = 2249: $self->{NAV_MAP}->getById($self->{FINISH_RESOURCE}); } 2250: 2251: $self->{FILTER} = shift; 2252: 2253: # A hash, used as a set, of resource already seen 2254: $self->{ALREADY_SEEN} = shift; 2255: if (!defined($self->{ALREADY_SEEN})) { $self->{ALREADY_SEEN} = {} }; 2256: $self->{CONDITION} = shift; 2257: 2258: # Do we want to automatically follow "redirection" maps? 2259: $self->{FORCE_TOP} = shift; 2260: 2261: # Do we want to return the top-level map object (resource 0.0)? 2262: $self->{RETURN_0} = shift; 2263: # have we done that yet? 2264: $self->{HAVE_RETURNED_0} = 0; 2265: 2266: # Now, we need to pre-process the map, by walking forward and backward 2267: # over the parts of the map we're going to look at. 2268: 2269: # The processing steps are exactly the same, except for a few small 2270: # changes, so I bundle those up in the following list of two elements: 2271: # (direction_to_iterate, VAL_name, next_resource_method_to_call, 2272: # first_resource). 2273: # This prevents writing nearly-identical code twice. 2274: my @iterations = ( [FORWARD(), 'TOP_DOWN_VAL', 'getNext', 2275: 'FIRST_RESOURCE'], 2276: [BACKWARD(), 'BOT_UP_VAL', 'getPrevious', 2277: 'FINISH_RESOURCE'] ); 2278: 2279: my $maxDepth = 0; # tracks max depth 2280: 2281: # If there is only one resource in this map, and it's a map, we 2282: # want to remember that, so the user can ask for the first map 2283: # that isn't just a redirector. 2284: my $resource; my $resourceCount = 0; 2285: 2286: # Documentation on this algorithm can be found in the CVS repository at 2287: # /docs/lonnavdocs; these "**#**" markers correspond to documentation 2288: # in that file. 2289: # **1** 2290: 2291: foreach my $pass (@iterations) { 2292: my $direction = $pass->[0]; 2293: my $valName = $pass->[1]; 2294: my $nextResourceMethod = $pass->[2]; 2295: my $firstResourceName = $pass->[3]; 2296: 2297: my $iterator = Apache::lonnavmaps::DFSiterator->new($self->{NAV_MAP}, 2298: $self->{FIRST_RESOURCE}, 2299: $self->{FINISH_RESOURCE}, 2300: {}, undef, 0, $direction); 2301: 2302: # prime the recursion 2303: $self->{$firstResourceName}->{DATA}->{$valName} = 0; 2304: my $depth = 0; 2305: $iterator->next(); 2306: my $curRes = $iterator->next(); 2307: while ($depth > -1) { 2308: if ($curRes == $iterator->BEGIN_MAP()) { $depth++; } 2309: if ($curRes == $iterator->END_MAP()) { $depth--; } 2310: 2311: if (ref($curRes)) { 2312: # If there's only one resource, this will save it 2313: # we have to filter empty resources from consideration here, 2314: # or even "empty", redirecting maps have two (start & finish) 2315: # or three (start, finish, plus redirector) 2316: if($direction == FORWARD && $curRes->src()) { 2317: $resource = $curRes; $resourceCount++; 2318: } 2319: my $resultingVal = $curRes->{DATA}->{$valName}; 2320: my $nextResources = $curRes->$nextResourceMethod(); 2321: my $nextCount = scalar(@{$nextResources}); 2322: 2323: if ($nextCount == 1) { # **3** 2324: my $current = $nextResources->[0]->{DATA}->{$valName} || 999999999; 2325: $nextResources->[0]->{DATA}->{$valName} = min($resultingVal, $current); 2326: } 2327: 2328: if ($nextCount > 1) { # **4** 2329: foreach my $res (@{$nextResources}) { 2330: my $current = $res->{DATA}->{$valName} || 999999999; 2331: $res->{DATA}->{$valName} = min($current, $resultingVal + 1); 2332: } 2333: } 2334: } 2335: 2336: # Assign the final val (**2**) 2337: if (ref($curRes) && $direction == BACKWARD()) { 2338: my $finalDepth = min($curRes->{DATA}->{TOP_DOWN_VAL}, 2339: $curRes->{DATA}->{BOT_UP_VAL}); 2340: 2341: $curRes->{DATA}->{DISPLAY_DEPTH} = $finalDepth; 2342: if ($finalDepth > $maxDepth) {$maxDepth = $finalDepth;} 2343: } 2344: } continue { 2345: $curRes = $iterator->next(); 2346: } 2347: } 2348: 2349: # Check: Was this only one resource, a map? 2350: if ($resourceCount == 1 && $resource->is_map() && !$self->{FORCE_TOP}) { 2351: my $firstResource = $resource->map_start(); 2352: my $finishResource = $resource->map_finish(); 2353: return 2354: Apache::lonnavmaps::iterator->new($self->{NAV_MAP}, $firstResource, 2355: $finishResource, $self->{FILTER}, 2356: $self->{ALREADY_SEEN}, 2357: $self->{CONDITION}, 0); 2358: 2359: } 2360: 2361: # Set up some bookkeeping information. 2362: $self->{CURRENT_DEPTH} = 0; 2363: $self->{MAX_DEPTH} = $maxDepth; 2364: $self->{STACK} = []; 2365: $self->{RECURSIVE_ITERATOR_FLAG} = 0; 2366: 2367: for (my $i = 0; $i <= $self->{MAX_DEPTH}; $i++) { 2368: push @{$self->{STACK}}, []; 2369: } 2370: 2371: # Prime the recursion w/ the first resource **5** 2372: push @{$self->{STACK}->[0]}, $self->{FIRST_RESOURCE}; 2373: $self->{ALREADY_SEEN}->{$self->{FIRST_RESOURCE}->{ID}} = 1; 2374: 2375: bless ($self); 2376: 2377: return $self; 2378: } 2379: 2380: sub next { 2381: my $self = shift; 2382: 2383: # If we want to return the top-level map object, and haven't yet, 2384: # do so. 2385: if ($self->{RETURN_0} && !$self->{HAVE_RETURNED_0}) { 2386: $self->{HAVE_RETURNED_0} = 1; 2387: return $self->{NAV_MAP}->getById('0.0'); 2388: } 2389: 2390: if ($self->{RECURSIVE_ITERATOR_FLAG}) { 2391: # grab the next from the recursive iterator 2392: my $next = $self->{RECURSIVE_ITERATOR}->next(); 2393: 2394: # is it a begin or end map? If so, update the depth 2395: if ($next == BEGIN_MAP() ) { $self->{RECURSIVE_DEPTH}++; } 2396: if ($next == END_MAP() ) { $self->{RECURSIVE_DEPTH}--; } 2397: 2398: # Are we back at depth 0? If so, stop recursing 2399: if ($self->{RECURSIVE_DEPTH} == 0) { 2400: $self->{RECURSIVE_ITERATOR_FLAG} = 0; 2401: } 2402: 2403: return $next; 2404: } 2405: 2406: if (defined($self->{FORCE_NEXT})) { 2407: my $tmp = $self->{FORCE_NEXT}; 2408: $self->{FORCE_NEXT} = undef; 2409: return $tmp; 2410: } 2411: 2412: # Have we not yet begun? If not, return BEGIN_MAP and 2413: # remember we've started. 2414: if ( !$self->{STARTED} ) { 2415: $self->{STARTED} = 1; 2416: return $self->BEGIN_MAP(); 2417: } 2418: 2419: # Here's the guts of the iterator. 2420: 2421: # Find the next resource, if any. 2422: my $found = 0; 2423: my $i = $self->{MAX_DEPTH}; 2424: my $newDepth; 2425: my $here; 2426: while ( $i >= 0 && !$found ) { 2427: if ( scalar(@{$self->{STACK}->[$i]}) > 0 ) { # **6** 2428: $here = pop @{$self->{STACK}->[$i]}; # **7** 2429: $found = 1; 2430: $newDepth = $i; 2431: } 2432: $i--; 2433: } 2434: 2435: # If we still didn't find anything, we're done. 2436: if ( !$found ) { 2437: # We need to get back down to the correct branch depth 2438: if ( $self->{CURRENT_DEPTH} > 0 ) { 2439: $self->{CURRENT_DEPTH}--; 2440: return END_BRANCH(); 2441: } else { 2442: return END_MAP(); 2443: } 2444: } 2445: 2446: # If this is not a resource, it must be an END_BRANCH marker we want 2447: # to return directly. 2448: if (!ref($here)) { # **8** 2449: if ($here == END_BRANCH()) { # paranoia, in case of later extension 2450: $self->{CURRENT_DEPTH}--; 2451: return $here; 2452: } 2453: } 2454: 2455: # Otherwise, it is a resource and it's safe to store in $self->{HERE} 2456: $self->{HERE} = $here; 2457: 2458: # Get to the right level 2459: if ( $self->{CURRENT_DEPTH} > $newDepth ) { 2460: push @{$self->{STACK}->[$newDepth]}, $here; 2461: $self->{CURRENT_DEPTH}--; 2462: return END_BRANCH(); 2463: } 2464: if ( $self->{CURRENT_DEPTH} < $newDepth) { 2465: push @{$self->{STACK}->[$newDepth]}, $here; 2466: $self->{CURRENT_DEPTH}++; 2467: return BEGIN_BRANCH(); 2468: } 2469: 2470: # If we made it here, we have the next resource, and we're at the 2471: # right branch level. So let's examine the resource for where 2472: # we can get to from here. 2473: 2474: # So we need to look at all the resources we can get to from here, 2475: # categorize them if we haven't seen them, remember if we have a new 2476: my $nextUnfiltered = $here->getNext(); 2477: my $maxDepthAdded = -1; 2478: 2479: for (@$nextUnfiltered) { 2480: if (!defined($self->{ALREADY_SEEN}->{$_->{ID}})) { 2481: my $depth = $_->{DATA}->{DISPLAY_DEPTH}; 2482: push @{$self->{STACK}->[$depth]}, $_; 2483: $self->{ALREADY_SEEN}->{$_->{ID}} = 1; 2484: if ($maxDepthAdded < $depth) { $maxDepthAdded = $depth; } 2485: } 2486: } 2487: 2488: # Is this the end of a branch? If so, all of the resources examined above 2489: # led to lower levels then the one we are currently at, so we push a END_BRANCH 2490: # marker onto the stack so we don't forget. 2491: # Example: For the usual A(BC)(DE)F case, when the iterator goes down the 2492: # BC branch and gets to C, it will see F as the only next resource, but it's 2493: # one level lower. Thus, this is the end of the branch, since there are no 2494: # more resources added to this level or above. 2495: # We don't do this if the examined resource is the finish resource, 2496: # because the condition given above is true, but the "END_MAP" will 2497: # take care of things and we should already be at depth 0. 2498: my $isEndOfBranch = $maxDepthAdded < $self->{CURRENT_DEPTH}; 2499: if ($isEndOfBranch && $here != $self->{FINISH_RESOURCE}) { # **9** 2500: push @{$self->{STACK}->[$self->{CURRENT_DEPTH}]}, END_BRANCH(); 2501: } 2502: 2503: # That ends the main iterator logic. Now, do we want to recurse 2504: # down this map (if this resource is a map)? 2505: if ($self->{HERE}->is_map() && 2506: (defined($self->{FILTER}->{$self->{HERE}->map_pc()}) xor $self->{CONDITION})) { 2507: $self->{RECURSIVE_ITERATOR_FLAG} = 1; 2508: my $firstResource = $self->{HERE}->map_start(); 2509: my $finishResource = $self->{HERE}->map_finish(); 2510: 2511: $self->{RECURSIVE_ITERATOR} = 2512: Apache::lonnavmaps::iterator->new($self->{NAV_MAP}, $firstResource, 2513: $finishResource, $self->{FILTER}, 2514: $self->{ALREADY_SEEN}, $self->{CONDITION}); 2515: } 2516: 2517: # If this is a blank resource, don't actually return it. 2518: # Should you ever find you need it, make sure to add an option to the code 2519: # that you can use; other things depend on this behavior. 2520: my $browsePriv = $self->{HERE}->browsePriv(); 2521: if (!$self->{HERE}->src() || 2522: (!($browsePriv eq 'F') && !($browsePriv eq '2')) ) { 2523: return $self->next(); 2524: } 2525: 2526: return $self->{HERE}; 2527: 2528: } 2529: 2530: =pod 2531: 2532: The other method available on the iterator is B<getStack>, which 2533: returns an array populated with the current 'stack' of maps, as 2534: references to the resource objects. Example: This is useful when 2535: making the navigation map, as we need to check whether we are under a 2536: page map to see if we need to link directly to the resource, or to the 2537: page. The first elements in the array will correspond to the top of 2538: the stack (most inclusive map). 2539: 2540: =cut 2541: 2542: sub getStack { 2543: my $self=shift; 2544: 2545: my @stack; 2546: 2547: $self->populateStack(\@stack); 2548: 2549: return \@stack; 2550: } 2551: 2552: # Private method: Calls the iterators recursively to populate the stack. 2553: sub populateStack { 2554: my $self=shift; 2555: my $stack = shift; 2556: 2557: push @$stack, $self->{HERE} if ($self->{HERE}); 2558: 2559: if ($self->{RECURSIVE_ITERATOR_FLAG}) { 2560: $self->{RECURSIVE_ITERATOR}->populateStack($stack); 2561: } 2562: } 2563: 2564: 1; 2565: 2566: package Apache::lonnavmaps::DFSiterator; 2567: 2568: # Not documented in the perldoc: This is a simple iterator that just walks 2569: # through the nav map and presents the resources in a depth-first search 2570: # fashion, ignorant of conditionals, randomized resources, etc. It presents 2571: # BEGIN_MAP and END_MAP, but does not understand branches at all. It is 2572: # useful for pre-processing of some kind, and is in fact used by the main 2573: # iterator that way, but that's about it. 2574: # One could imagine merging this into the init routine of the main iterator, 2575: # but this might as well be left seperate, since it is possible some other 2576: # use might be found for it. - Jeremy 2577: 2578: # Unlike the main iterator, this DOES return all resources, even blank ones. 2579: # The main iterator needs them to correctly preprocess the map. 2580: 2581: sub BEGIN_MAP { return 1; } # begining of a new map 2582: sub END_MAP { return 2; } # end of the map 2583: sub FORWARD { return 1; } # go forward 2584: sub BACKWARD { return 2; } 2585: 2586: # Params: Nav map ref, first resource id/ref, finish resource id/ref, 2587: # filter hash ref (or undef), already seen hash or undef, condition 2588: # (as in main iterator), direction FORWARD or BACKWARD (undef->forward). 2589: sub new { 2590: # magic invocation to create a class instance 2591: my $proto = shift; 2592: my $class = ref($proto) || $proto; 2593: my $self = {}; 2594: 2595: $self->{NAV_MAP} = shift; 2596: return undef unless ($self->{NAV_MAP}); 2597: 2598: $self->{FIRST_RESOURCE} = shift || $self->{NAV_MAP}->firstResource(); 2599: $self->{FINISH_RESOURCE} = shift || $self->{NAV_MAP}->finishResource(); 2600: 2601: # If the given resources are just the ID of the resource, get the 2602: # objects 2603: if (!ref($self->{FIRST_RESOURCE})) { $self->{FIRST_RESOURCE} = 2604: $self->{NAV_MAP}->getById($self->{FIRST_RESOURCE}); } 2605: if (!ref($self->{FINISH_RESOURCE})) { $self->{FINISH_RESOURCE} = 2606: $self->{NAV_MAP}->getById($self->{FINISH_RESOURCE}); } 2607: 2608: $self->{FILTER} = shift; 2609: 2610: # A hash, used as a set, of resource already seen 2611: $self->{ALREADY_SEEN} = shift; 2612: if (!defined($self->{ALREADY_SEEN})) { $self->{ALREADY_SEEN} = {} }; 2613: $self->{CONDITION} = shift; 2614: $self->{DIRECTION} = shift || FORWARD(); 2615: 2616: # Flag: Have we started yet? 2617: $self->{STARTED} = 0; 2618: 2619: # Should we continue calling the recursive iterator, if any? 2620: $self->{RECURSIVE_ITERATOR_FLAG} = 0; 2621: # The recursive iterator, if any 2622: $self->{RECURSIVE_ITERATOR} = undef; 2623: # Are we recursing on a map, or a branch? 2624: $self->{RECURSIVE_MAP} = 1; # we'll manually unset this when recursing on branches 2625: # And the count of how deep it is, so that this iterator can keep track of 2626: # when to pick back up again. 2627: $self->{RECURSIVE_DEPTH} = 0; 2628: 2629: # For keeping track of our branches, we maintain our own stack 2630: $self->{STACK} = []; 2631: 2632: # Start with the first resource 2633: if ($self->{DIRECTION} == FORWARD) { 2634: push @{$self->{STACK}}, $self->{FIRST_RESOURCE}; 2635: } else { 2636: push @{$self->{STACK}}, $self->{FINISH_RESOURCE}; 2637: } 2638: 2639: bless($self); 2640: return $self; 2641: } 2642: 2643: sub next { 2644: my $self = shift; 2645: 2646: # Are we using a recursive iterator? If so, pull from that and 2647: # watch the depth; we want to resume our level at the correct time. 2648: if ($self->{RECURSIVE_ITERATOR_FLAG}) { 2649: # grab the next from the recursive iterator 2650: my $next = $self->{RECURSIVE_ITERATOR}->next(); 2651: 2652: # is it a begin or end map? Update depth if so 2653: if ($next == BEGIN_MAP() ) { $self->{RECURSIVE_DEPTH}++; } 2654: if ($next == END_MAP() ) { $self->{RECURSIVE_DEPTH}--; } 2655: 2656: # Are we back at depth 0? If so, stop recursing. 2657: if ($self->{RECURSIVE_DEPTH} == 0) { 2658: $self->{RECURSIVE_ITERATOR_FLAG} = 0; 2659: } 2660: 2661: return $next; 2662: } 2663: 2664: # Is there a current resource to grab? If not, then return 2665: # END_MAP, which will end the iterator. 2666: if (scalar(@{$self->{STACK}}) == 0) { 2667: return $self->END_MAP(); 2668: } 2669: 2670: # Have we not yet begun? If not, return BEGIN_MAP and 2671: # remember that we've started. 2672: if ( !$self->{STARTED} ) { 2673: $self->{STARTED} = 1; 2674: return $self->BEGIN_MAP; 2675: } 2676: 2677: # Get the next resource in the branch 2678: $self->{HERE} = pop @{$self->{STACK}}; 2679: 2680: # remember that we've seen this, so we don't return it again later 2681: $self->{ALREADY_SEEN}->{$self->{HERE}->{ID}} = 1; 2682: 2683: # Get the next possible resources 2684: my $nextUnfiltered; 2685: if ($self->{DIRECTION} == FORWARD()) { 2686: $nextUnfiltered = $self->{HERE}->getNext(); 2687: } else { 2688: $nextUnfiltered = $self->{HERE}->getPrevious(); 2689: } 2690: my $next = []; 2691: 2692: # filter the next possibilities to remove things we've 2693: # already seen. 2694: foreach (@$nextUnfiltered) { 2695: if (!defined($self->{ALREADY_SEEN}->{$_->{ID}})) { 2696: push @$next, $_; 2697: } 2698: } 2699: 2700: while (@$next) { 2701: # copy the next possibilities over to the stack 2702: push @{$self->{STACK}}, shift @$next; 2703: } 2704: 2705: # If this is a map and we want to recurse down it... (not filtered out) 2706: if ($self->{HERE}->is_map() && 2707: (defined($self->{FILTER}->{$self->{HERE}->map_pc()}) xor $self->{CONDITION})) { 2708: $self->{RECURSIVE_ITERATOR_FLAG} = 1; 2709: my $firstResource = $self->{HERE}->map_start(); 2710: my $finishResource = $self->{HERE}->map_finish(); 2711: 2712: $self->{RECURSIVE_ITERATOR} = 2713: Apache::lonnavmaps::DFSiterator->new ($self->{NAV_MAP}, $firstResource, 2714: $finishResource, $self->{FILTER}, $self->{ALREADY_SEEN}, 2715: $self->{CONDITION}, $self->{DIRECTION}); 2716: } 2717: 2718: return $self->{HERE}; 2719: } 2720: 2721: # Identical to the full iterator methods of the same name. Hate to copy/paste 2722: # but I also hate to "inherit" either iterator from the other. 2723: 2724: sub getStack { 2725: my $self=shift; 2726: 2727: my @stack; 2728: 2729: $self->populateStack(\@stack); 2730: 2731: return \@stack; 2732: } 2733: 2734: # Private method: Calls the iterators recursively to populate the stack. 2735: sub populateStack { 2736: my $self=shift; 2737: my $stack = shift; 2738: 2739: push @$stack, $self->{HERE} if ($self->{HERE}); 2740: 2741: if ($self->{RECURSIVE_ITERATOR_FLAG}) { 2742: $self->{RECURSIVE_ITERATOR}->populateStack($stack); 2743: } 2744: } 2745: 2746: 1; 2747: 2748: package Apache::lonnavmaps::resource; 2749: 2750: use Apache::lonnet; 2751: 2752: =pod 2753: 2754: =head1 Object: resource 2755: 2756: A resource object encapsulates a resource in a resource map, allowing 2757: easy manipulation of the resource, querying the properties of the 2758: resource (including user properties), and represents a reference that 2759: can be used as the canonical representation of the resource by 2760: lonnavmap clients like renderers. 2761: 2762: A resource only makes sense in the context of a navmap, as some of the 2763: data is stored in the navmap object. 2764: 2765: You will probably never need to instantiate this object directly. Use 2766: Apache::lonnavmaps::navmap, and use the "start" method to obtain the 2767: starting resource. 2768: 2769: Resource objects respect the parameter_hiddenparts, which suppresses 2770: various parts according to the wishes of the map author. As of this 2771: writing, there is no way to override this parameter, and suppressed 2772: parts will never be returned, nor will their response types or ids be 2773: stored. 2774: 2775: =head2 Public Members 2776: 2777: resource objects have a hash called DATA ($resourceRef->{DATA}) that 2778: you can store whatever you want in. This allows you to easily do 2779: two-pass algorithms without worrying about managing your own 2780: resource->data hash. 2781: 2782: =head2 Methods 2783: 2784: =over 4 2785: 2786: =item * B<new>($navmapRef, $idString): 2787: 2788: The first arg is a reference to the parent navmap object. The second 2789: is the idString of the resource itself. Very rarely, if ever, called 2790: directly. Use the nav map->getByID() method. 2791: 2792: =back 2793: 2794: =cut 2795: 2796: sub new { 2797: # magic invocation to create a class instance 2798: my $proto = shift; 2799: my $class = ref($proto) || $proto; 2800: my $self = {}; 2801: 2802: $self->{NAV_MAP} = shift; 2803: $self->{ID} = shift; 2804: 2805: # Store this new resource in the parent nav map's cache. 2806: $self->{NAV_MAP}->{RESOURCE_CACHE}->{$self->{ID}} = $self; 2807: $self->{RESOURCE_ERROR} = 0; 2808: 2809: # A hash that can be used by two-pass algorithms to store data 2810: # about this resource in. Not used by the resource object 2811: # directly. 2812: $self->{DATA} = {}; 2813: 2814: bless($self); 2815: 2816: return $self; 2817: } 2818: 2819: # private function: simplify the NAV_HASH lookups we keep doing 2820: # pass the name, and to automatically append my ID, pass a true val on the 2821: # second param 2822: sub navHash { 2823: my $self = shift; 2824: my $param = shift; 2825: my $id = shift; 2826: return $self->{NAV_MAP}->navhash($param . ($id?$self->{ID}:"")); 2827: } 2828: 2829: =pod 2830: 2831: B<Metadata Retreival> 2832: 2833: These are methods that help you retrieve metadata about the resource: 2834: Method names are based on the fields in the compiled course 2835: representation. 2836: 2837: =over 4 2838: 2839: =item * B<compTitle>: 2840: 2841: Returns a "composite title", that is equal to $res->title() if the 2842: resource has a title, and is otherwise the last part of the URL (e.g., 2843: "problem.problem"). 2844: 2845: =item * B<ext>: 2846: 2847: Returns true if the resource is external. 2848: 2849: =item * B<goesto>: 2850: 2851: Returns the "goesto" value from the compiled nav map. (It is likely 2852: you want to use B<getNext> instead.) 2853: 2854: =item * B<kind>: 2855: 2856: Returns the kind of the resource from the compiled nav map. 2857: 2858: =item * B<randomout>: 2859: 2860: Returns true if this resource was chosen to NOT be shown to the user 2861: by the random map selection feature. In other words, this is usually 2862: false. 2863: 2864: =item * B<randompick>: 2865: 2866: Returns true for a map if the randompick feature is being used on the 2867: map. (?) 2868: 2869: =item * B<src>: 2870: 2871: Returns the source for the resource. 2872: 2873: =item * B<symb>: 2874: 2875: Returns the symb for the resource. 2876: 2877: =item * B<title>: 2878: 2879: Returns the title of the resource. 2880: 2881: =item * B<to>: 2882: 2883: Returns the "to" value from the compiled nav map. (It is likely you 2884: want to use B<getNext> instead.) 2885: 2886: =back 2887: 2888: =cut 2889: 2890: # These info functions can be used directly, as they don't return 2891: # resource information. 2892: sub comesfrom { my $self=shift; return $self->navHash("comesfrom_", 1); } 2893: sub ext { my $self=shift; return $self->navHash("ext_", 1) eq 'true:'; } 2894: sub from { my $self=shift; return $self->navHash("from_", 1); } 2895: sub goesto { my $self=shift; return $self->navHash("goesto_", 1); } 2896: sub kind { my $self=shift; return $self->navHash("kind_", 1); } 2897: sub randomout { my $self=shift; return $self->navHash("randomout_", 1); } 2898: sub randompick { 2899: my $self = shift; 2900: return $self->{NAV_MAP}->{PARM_HASH}->{$self->symb . 2901: '.0.parameter_randompick'}; 2902: } 2903: sub src { 2904: my $self=shift; 2905: return $self->navHash("src_", 1); 2906: } 2907: sub symb { 2908: my $self=shift; 2909: (my $first, my $second) = $self->{ID} =~ /(\d+).(\d+)/; 2910: my $symbSrc = &Apache::lonnet::declutter($self->src()); 2911: return &Apache::lonnet::declutter( 2912: $self->navHash('map_id_'.$first)) 2913: . '___' . $second . '___' . $symbSrc; 2914: } 2915: sub title { my $self=shift; return $self->navHash("title_", 1); } 2916: sub to { my $self=shift; return $self->navHash("to_", 1); } 2917: sub compTitle { 2918: my $self = shift; 2919: my $title = $self->title(); 2920: $title=~s/\&colon\;/\:/gs; 2921: if (!$title) { 2922: $title = $self->src(); 2923: $title = substr($title, rindex($title, '/') + 1); 2924: } 2925: return $title; 2926: } 2927: =pod 2928: 2929: B<Predicate Testing the Resource> 2930: 2931: These methods are shortcuts to deciding if a given resource has a given property. 2932: 2933: =over 4 2934: 2935: =item * B<is_map>: 2936: 2937: Returns true if the resource is a map type. 2938: 2939: =item * B<is_problem>: 2940: 2941: Returns true if the resource is a problem type, false 2942: otherwise. (Looks at the extension on the src field; might need more 2943: to work correctly.) 2944: 2945: =item * B<is_page>: 2946: 2947: Returns true if the resource is a page. 2948: 2949: =item * B<is_sequence>: 2950: 2951: Returns true if the resource is a sequence. 2952: 2953: =back 2954: 2955: =cut 2956: 2957: 2958: sub is_html { 2959: my $self=shift; 2960: my $src = $self->src(); 2961: return ($src =~ /html$/); 2962: } 2963: sub is_map { my $self=shift; return defined($self->navHash("is_map_", 1)); } 2964: sub is_page { 2965: my $self=shift; 2966: my $src = $self->src(); 2967: return $self->navHash("is_map_", 1) && 2968: $self->navHash("map_type_" . $self->map_pc()) eq 'page'; 2969: } 2970: sub is_problem { 2971: my $self=shift; 2972: my $src = $self->src(); 2973: return ($src =~ /problem$/); 2974: } 2975: sub is_sequence { 2976: my $self=shift; 2977: my $src = $self->src(); 2978: return $self->navHash("is_map_", 1) && 2979: $self->navHash("map_type_" . $self->map_pc()) eq 'sequence'; 2980: } 2981: 2982: # Private method: Shells out to the parmval in the nav map, handler parts. 2983: sub parmval { 2984: my $self = shift; 2985: my $what = shift; 2986: my $part = shift; 2987: if (!defined($part)) { 2988: $part = '0'; 2989: } 2990: return $self->{NAV_MAP}->parmval($part.'.'.$what, $self->symb()); 2991: } 2992: 2993: =pod 2994: 2995: B<Map Methods> 2996: 2997: These methods are useful for getting information about the map 2998: properties of the resource, if the resource is a map (B<is_map>). 2999: 3000: =over 4 3001: 3002: =item * B<map_finish>: 3003: 3004: Returns a reference to a resource object corresponding to the finish 3005: resource of the map. 3006: 3007: =item * B<map_pc>: 3008: 3009: Returns the pc value of the map, which is the first number that 3010: appears in the resource ID of the resources in the map, and is the 3011: number that appears around the middle of the symbs of the resources in 3012: that map. 3013: 3014: =item * B<map_start>: 3015: 3016: Returns a reference to a resource object corresponding to the start 3017: resource of the map. 3018: 3019: =item * B<map_type>: 3020: 3021: Returns a string with the type of the map in it. 3022: 3023: =back 3024: 3025: =cut 3026: 3027: sub map_finish { 3028: my $self = shift; 3029: my $src = $self->src(); 3030: $src = Apache::lonnet::clutter($src); 3031: my $res = $self->navHash("map_finish_$src", 0); 3032: $res = $self->{NAV_MAP}->getById($res); 3033: return $res; 3034: } 3035: sub map_pc { 3036: my $self = shift; 3037: my $src = $self->src(); 3038: return $self->navHash("map_pc_$src", 0); 3039: } 3040: sub map_start { 3041: my $self = shift; 3042: my $src = $self->src(); 3043: $src = Apache::lonnet::clutter($src); 3044: my $res = $self->navHash("map_start_$src", 0); 3045: $res = $self->{NAV_MAP}->getById($res); 3046: return $res; 3047: } 3048: sub map_type { 3049: my $self = shift; 3050: my $pc = $self->map_pc(); 3051: return $self->navHash("map_type_$pc", 0); 3052: } 3053: 3054: ##### 3055: # Property queries 3056: ##### 3057: 3058: # These functions will be responsible for returning the CORRECT 3059: # VALUE for the parameter, no matter what. So while they may look 3060: # like direct calls to parmval, they can be more then that. 3061: # So, for instance, the duedate function should use the "duedatetype" 3062: # information, rather then the resource object user. 3063: 3064: =pod 3065: 3066: =head2 Resource Parameters 3067: 3068: In order to use the resource parameters correctly, the nav map must 3069: have been instantiated with genCourseAndUserOptions set to true, so 3070: the courseopt and useropt is read correctly. Then, you can call these 3071: functions to get the relevant parameters for the resource. Each 3072: function defaults to part "0", but can be directed to another part by 3073: passing the part as the parameter. 3074: 3075: These methods are responsible for getting the parameter correct, not 3076: merely reflecting the contents of the GDBM hashes. As we move towards 3077: dates relative to other dates, these methods should be updated to 3078: reflect that. (Then, anybody using these methods will not have to update 3079: their code.) 3080: 3081: =over 4 3082: 3083: =item * B<acc>: 3084: 3085: Get the Client IP/Name Access Control information. 3086: 3087: =item * B<answerdate>: 3088: 3089: Get the answer-reveal date for the problem. 3090: 3091: =item * B<duedate>: 3092: 3093: Get the due date for the problem. 3094: 3095: =item * B<tries>: 3096: 3097: Get the number of tries the student has used on the problem. 3098: 3099: =item * B<maxtries>: 3100: 3101: Get the number of max tries allowed. 3102: 3103: =item * B<opendate>: 3104: 3105: Get the open date for the problem. 3106: 3107: =item * B<sig>: 3108: 3109: Get the significant figures setting. 3110: 3111: =item * B<tol>: 3112: 3113: Get the tolerance for the problem. 3114: 3115: =item * B<tries>: 3116: 3117: Get the number of tries the user has already used on the problem. 3118: 3119: =item * B<type>: 3120: 3121: Get the question type for the problem. 3122: 3123: =item * B<weight>: 3124: 3125: Get the weight for the problem. 3126: 3127: =back 3128: 3129: =cut 3130: 3131: sub acc { 3132: (my $self, my $part) = @_; 3133: return $self->parmval("acc", $part); 3134: } 3135: sub answerdate { 3136: (my $self, my $part) = @_; 3137: # Handle intervals 3138: if ($self->parmval("answerdate.type", $part) eq 'date_interval') { 3139: return $self->duedate($part) + 3140: $self->parmval("answerdate", $part); 3141: } 3142: return $self->parmval("answerdate", $part); 3143: } 3144: sub awarded { my $self = shift; return $self->queryRestoreHash('awarded', shift); } 3145: sub duedate { 3146: (my $self, my $part) = @_; 3147: return $self->parmval("duedate", $part); 3148: } 3149: sub maxtries { 3150: (my $self, my $part) = @_; 3151: return $self->parmval("maxtries", $part); 3152: } 3153: sub opendate { 3154: (my $self, my $part) = @_; 3155: if ($self->parmval("opendate.type", $part) eq 'date_interval') { 3156: return $self->duedate($part) - 3157: $self->parmval("opendate", $part); 3158: } 3159: return $self->parmval("opendate"); 3160: } 3161: sub problemstatus { 3162: (my $self, my $part) = @_; 3163: return $self->parmval("problemstatus", $part); 3164: } 3165: sub sig { 3166: (my $self, my $part) = @_; 3167: return $self->parmval("sig", $part); 3168: } 3169: sub tol { 3170: (my $self, my $part) = @_; 3171: return $self->parmval("tol", $part); 3172: } 3173: sub tries { 3174: my $self = shift; 3175: my $tries = $self->queryRestoreHash('tries', shift); 3176: if (!defined($tries)) { return '0';} 3177: return $tries; 3178: } 3179: sub type { 3180: (my $self, my $part) = @_; 3181: return $self->parmval("type", $part); 3182: } 3183: sub weight { 3184: my $self = shift; my $part = shift; 3185: return $self->parmval("weight", $part); 3186: } 3187: 3188: # Multiple things need this 3189: sub getReturnHash { 3190: my $self = shift; 3191: 3192: if (!defined($self->{RETURN_HASH})) { 3193: my %tmpHash = &Apache::lonnet::restore($self->symb()); 3194: $self->{RETURN_HASH} = \%tmpHash; 3195: } 3196: } 3197: 3198: ###### 3199: # Status queries 3200: ###### 3201: 3202: # These methods query the status of problems. 3203: 3204: # If we need to count parts, this function determines the number of 3205: # parts from the metadata. When called, it returns a reference to a list 3206: # of strings corresponding to the parts. (Thus, using it in a scalar context 3207: # tells you how many parts you have in the problem: 3208: # $partcount = scalar($resource->countParts()); 3209: # Don't use $self->{PARTS} directly because you don't know if it's been 3210: # computed yet. 3211: 3212: =pod 3213: 3214: =head2 Resource misc 3215: 3216: Misc. functions for the resource. 3217: 3218: =over 4 3219: 3220: =item * B<hasDiscussion>: 3221: 3222: Returns a false value if there has been discussion since the user last 3223: logged in, true if there has. Always returns false if the discussion 3224: data was not extracted when the nav map was constructed. 3225: 3226: =item * B<getFeedback>: 3227: 3228: Gets the feedback for the resource and returns the raw feedback string 3229: for the resource, or the null string if there is no feedback or the 3230: email data was not extracted when the nav map was constructed. Usually 3231: used like this: 3232: 3233: for (split(/\,/, $res->getFeedback())) { 3234: my $link = &Apache::lonnet::escape($_); 3235: ... 3236: 3237: and use the link as appropriate. 3238: 3239: =cut 3240: 3241: sub hasDiscussion { 3242: my $self = shift; 3243: return $self->{NAV_MAP}->hasDiscussion($self->symb()); 3244: } 3245: 3246: sub getFeedback { 3247: my $self = shift; 3248: my $source = $self->src(); 3249: if ($source =~ /^\/res\//) { $source = substr $source, 5; } 3250: return $self->{NAV_MAP}->getFeedback($source); 3251: } 3252: 3253: sub getErrors { 3254: my $self = shift; 3255: my $source = $self->src(); 3256: if ($source =~ /^\/res\//) { $source = substr $source, 5; } 3257: return $self->{NAV_MAP}->getErrors($source); 3258: } 3259: 3260: =pod 3261: 3262: =item * B<parts>(): 3263: 3264: Returns a list reference containing sorted strings corresponding to 3265: each part of the problem. Single part problems have only a part '0'. 3266: Multipart problems do not return their part '0', since they typically 3267: do not really matter. 3268: 3269: =item * B<countParts>(): 3270: 3271: Returns the number of parts of the problem a student can answer. Thus, 3272: for single part problems, returns 1. For multipart, it returns the 3273: number of parts in the problem, not including psuedo-part 0. 3274: 3275: =item * B<multipart>(): 3276: 3277: Returns true if the problem is multipart, false otherwise. Use this instead 3278: of countParts if all you want is multipart/not multipart. 3279: 3280: =item * B<responseType>($part): 3281: 3282: Returns the response type of the part, without the word "response" on the 3283: end. Example return values: 'string', 'essay', 'numeric', etc. 3284: 3285: =item * B<responseIds>($part): 3286: 3287: Retreives the response IDs for the given part as an array reference containing 3288: strings naming the response IDs. This may be empty. 3289: 3290: =back 3291: 3292: =cut 3293: 3294: sub parts { 3295: my $self = shift; 3296: 3297: if ($self->ext) { return []; } 3298: 3299: $self->extractParts(); 3300: return $self->{PARTS}; 3301: } 3302: 3303: sub countParts { 3304: my $self = shift; 3305: 3306: my $parts = $self->parts(); 3307: 3308: # If I left this here, then it's not necessary. 3309: #my $delta = 0; 3310: #for my $part (@$parts) { 3311: # if ($part eq '0') { $delta--; } 3312: #} 3313: 3314: if ($self->{RESOURCE_ERROR}) { 3315: return 0; 3316: } 3317: 3318: return scalar(@{$parts}); # + $delta; 3319: } 3320: 3321: sub multipart { 3322: my $self = shift; 3323: return $self->countParts() > 1; 3324: } 3325: 3326: sub responseType { 3327: my $self = shift; 3328: my $part = shift; 3329: 3330: $self->extractParts(); 3331: return $self->{RESPONSE_TYPE}->{$part}; 3332: } 3333: 3334: sub responseIds { 3335: my $self = shift; 3336: my $part = shift; 3337: 3338: $self->extractParts(); 3339: return $self->{RESPONSE_IDS}->{$part}; 3340: } 3341: 3342: # Private function: Extracts the parts information, both part names and 3343: # part types, and saves it. 3344: sub extractParts { 3345: my $self = shift; 3346: 3347: return if (defined($self->{PARTS})); 3348: return if ($self->ext); 3349: 3350: $self->{PARTS} = []; 3351: 3352: my %parts; 3353: 3354: # Retrieve part count, if this is a problem 3355: if ($self->is_problem()) { 3356: my $metadata = &Apache::lonnet::metadata($self->src(), 'packages'); 3357: if (!$metadata) { 3358: $self->{RESOURCE_ERROR} = 1; 3359: $self->{PARTS} = []; 3360: $self->{PART_TYPE} = {}; 3361: return; 3362: } 3363: foreach (split(/\,/,$metadata)) { 3364: if ($_ =~ /^part_(.*)$/) { 3365: my $part = $1; 3366: # This floods the logs if it blows up 3367: if (defined($parts{$part})) { 3368: Apache::lonnet::logthis("$part multiply defined in metadata for " . $self->symb()); 3369: } 3370: 3371: # check to see if part is turned off. 3372: 3373: if (!Apache::loncommon::check_if_partid_hidden($part, $self->symb())) { 3374: $parts{$part} = 1; 3375: } 3376: } 3377: } 3378: 3379: 3380: my @sortedParts = sort keys %parts; 3381: $self->{PARTS} = \@sortedParts; 3382: 3383: my %responseIdHash; 3384: my %responseTypeHash; 3385: 3386: 3387: # Init the responseIdHash 3388: foreach (@{$self->{PARTS}}) { 3389: $responseIdHash{$_} = []; 3390: } 3391: 3392: # Now, the unfortunate thing about this is that parts, part name, and 3393: # response if are delimited by underscores, but both the part 3394: # name and response id can themselves have underscores in them. 3395: # So we have to use our knowlege of part names to figure out 3396: # where the part names begin and end, and even then, it is possible 3397: # to construct ambiguous situations. 3398: foreach (split /,/, $metadata) { 3399: if ($_ =~ /^([a-zA-Z]+)response_(.*)/) { 3400: my $responseType = $1; 3401: my $partStuff = $2; 3402: my $partIdSoFar = ''; 3403: my @partChunks = split /_/, $partStuff; 3404: my $i = 0; 3405: 3406: for ($i = 0; $i < scalar(@partChunks); $i++) { 3407: if ($partIdSoFar) { $partIdSoFar .= '_'; } 3408: $partIdSoFar .= $partChunks[$i]; 3409: if ($parts{$partIdSoFar}) { 3410: my @otherChunks = @partChunks[$i+1..$#partChunks]; 3411: my $responseId = join('_', @otherChunks); 3412: push @{$responseIdHash{$partIdSoFar}}, $responseId; 3413: $responseTypeHash{$partIdSoFar} = $responseType; 3414: last; 3415: } 3416: } 3417: } 3418: } 3419: 3420: $self->{RESPONSE_IDS} = \%responseIdHash; 3421: $self->{RESPONSE_TYPES} = \%responseTypeHash; 3422: } 3423: 3424: return; 3425: } 3426: 3427: =pod 3428: 3429: =head2 Resource Status 3430: 3431: Problem resources have status information, reflecting their various 3432: dates and completion statuses. 3433: 3434: There are two aspects to the status: the date-related information and 3435: the completion information. 3436: 3437: Idiomatic usage of these two methods would probably look something 3438: like 3439: 3440: foreach ($resource->parts()) { 3441: my $dateStatus = $resource->getDateStatus($_); 3442: my $completionStatus = $resource->getCompletionStatus($_); 3443: 3444: or 3445: 3446: my $status = $resource->status($_); 3447: 3448: ... use it here ... 3449: } 3450: 3451: Which you use depends on exactly what you are looking for. The 3452: status() function has been optimized for the nav maps display and may 3453: not precisely match what you need elsewhere. 3454: 3455: The symbolic constants shown below can be accessed through the 3456: resource object: C<$res->OPEN>. 3457: 3458: =over 4 3459: 3460: =item * B<getDateStatus>($part): 3461: 3462: ($part defaults to 0). A convenience function that returns a symbolic 3463: constant telling you about the date status of the part. The possible 3464: return values are: 3465: 3466: =back 3467: 3468: B<Date Codes> 3469: 3470: =over 4 3471: 3472: =item * B<OPEN_LATER>: 3473: 3474: The problem will be opened later. 3475: 3476: =item * B<OPEN>: 3477: 3478: Open and not yet due. 3479: 3480: 3481: =item * B<PAST_DUE_ANSWER_LATER>: 3482: 3483: The due date has passed, but the answer date has not yet arrived. 3484: 3485: =item * B<PAST_DUE_NO_ANSWER>: 3486: 3487: The due date has passed and there is no answer opening date set. 3488: 3489: =item * B<ANSWER_OPEN>: 3490: 3491: The answer date is here. 3492: 3493: =item * B<NETWORK_FAILURE>: 3494: 3495: The information is unknown due to network failure. 3496: 3497: =back 3498: 3499: =cut 3500: 3501: # Apparently the compiler optimizes these into constants automatically 3502: sub OPEN_LATER { return 0; } 3503: sub OPEN { return 1; } 3504: sub PAST_DUE_NO_ANSWER { return 2; } 3505: sub PAST_DUE_ANSWER_LATER { return 3; } 3506: sub ANSWER_OPEN { return 4; } 3507: sub NOTHING_SET { return 5; } 3508: sub NETWORK_FAILURE { return 100; } 3509: 3510: # getDateStatus gets the date status for a given problem part. 3511: # Because answer date, due date, and open date are fully independent 3512: # (i.e., it is perfectly possible to *only* have an answer date), 3513: # we have to completely cover the 3x3 maxtrix of (answer, due, open) x 3514: # (past, future, none given). This function handles this with a decision 3515: # tree. Read the comments to follow the decision tree. 3516: 3517: sub getDateStatus { 3518: my $self = shift; 3519: my $part = shift; 3520: $part = "0" if (!defined($part)); 3521: 3522: # Always return network failure if there was one. 3523: return $self->NETWORK_FAILURE if ($self->{NAV_MAP}->{NETWORK_FAILURE}); 3524: 3525: my $now = time(); 3526: 3527: my $open = $self->opendate($part); 3528: my $due = $self->duedate($part); 3529: my $answer = $self->answerdate($part); 3530: 3531: if (!$open && !$due && !$answer) { 3532: # no data on the problem at all 3533: # should this be the same as "open later"? think multipart. 3534: return $self->NOTHING_SET; 3535: } 3536: if (!$open || $now < $open) {return $self->OPEN_LATER} 3537: if (!$due || $now < $due) {return $self->OPEN} 3538: if ($answer && $now < $answer) {return $self->PAST_DUE_ANSWER_LATER} 3539: if ($answer) { return $self->ANSWER_OPEN; } 3540: return PAST_DUE_NO_ANSWER; 3541: } 3542: 3543: =pod 3544: 3545: B<> 3546: 3547: =over 4 3548: 3549: =item * B<getCompletionStatus>($part): 3550: 3551: ($part defaults to 0.) A convenience function that returns a symbolic 3552: constant telling you about the completion status of the part, with the 3553: following possible results: 3554: 3555: =back 3556: 3557: B<Completion Codes> 3558: 3559: =over 4 3560: 3561: =item * B<NOT_ATTEMPTED>: 3562: 3563: Has not been attempted at all. 3564: 3565: =item * B<INCORRECT>: 3566: 3567: Attempted, but wrong by student. 3568: 3569: =item * B<INCORRECT_BY_OVERRIDE>: 3570: 3571: Attempted, but wrong by instructor override. 3572: 3573: =item * B<CORRECT>: 3574: 3575: Correct or correct by instructor. 3576: 3577: =item * B<CORRECT_BY_OVERRIDE>: 3578: 3579: Correct by instructor override. 3580: 3581: =item * B<EXCUSED>: 3582: 3583: Excused. Not yet implemented. 3584: 3585: =item * B<NETWORK_FAILURE>: 3586: 3587: Information not available due to network failure. 3588: 3589: =item * B<ATTEMPTED>: 3590: 3591: Attempted, and not yet graded. 3592: 3593: =back 3594: 3595: =cut 3596: 3597: sub NOT_ATTEMPTED { return 10; } 3598: sub INCORRECT { return 11; } 3599: sub INCORRECT_BY_OVERRIDE { return 12; } 3600: sub CORRECT { return 13; } 3601: sub CORRECT_BY_OVERRIDE { return 14; } 3602: sub EXCUSED { return 15; } 3603: sub ATTEMPTED { return 16; } 3604: 3605: sub getCompletionStatus { 3606: my $self = shift; 3607: return $self->NETWORK_FAILURE if ($self->{NAV_MAP}->{NETWORK_FAILURE}); 3608: 3609: my $status = $self->queryRestoreHash('solved', shift); 3610: 3611: # Left as seperate if statements in case we ever do more with this 3612: if ($status eq 'correct_by_student') {return $self->CORRECT;} 3613: if ($status eq 'correct_by_override') {return $self->CORRECT_BY_OVERRIDE; } 3614: if ($status eq 'incorrect_attempted') {return $self->INCORRECT; } 3615: if ($status eq 'incorrect_by_override') {return $self->INCORRECT_BY_OVERRIDE; } 3616: if ($status eq 'excused') {return $self->EXCUSED; } 3617: if ($status eq 'ungraded_attempted') {return $self->ATTEMPTED; } 3618: return $self->NOT_ATTEMPTED; 3619: } 3620: 3621: sub queryRestoreHash { 3622: my $self = shift; 3623: my $hashentry = shift; 3624: my $part = shift; 3625: $part = "0" if (!defined($part) || $part eq ''); 3626: return $self->NETWORK_FAILURE if ($self->{NAV_MAP}->{NETWORK_FAILURE}); 3627: 3628: $self->getReturnHash(); 3629: 3630: return $self->{RETURN_HASH}->{'resource.'.$part.'.'.$hashentry}; 3631: } 3632: 3633: =pod 3634: 3635: B<Composite Status> 3636: 3637: Along with directly returning the date or completion status, the 3638: resource object includes a convenience function B<status>() that will 3639: combine the two status tidbits into one composite status that can 3640: represent the status of the resource as a whole. This method represents 3641: the concept of the thing we want to display to the user on the nav maps 3642: screen, which is a combination of completion and open status. The precise logic is 3643: documented in the comments of the status method. The following results 3644: may be returned, all available as methods on the resource object 3645: ($res->NETWORK_FAILURE): In addition to the return values that match 3646: the date or completion status, this function can return "ANSWER_SUBMITTED" 3647: if that problemstatus parameter value is set to No, suppressing the 3648: incorrect/correct feedback. 3649: 3650: =over 4 3651: 3652: =item * B<NETWORK_FAILURE>: 3653: 3654: The network has failed and the information is not available. 3655: 3656: =item * B<NOTHING_SET>: 3657: 3658: No dates have been set for this problem (part) at all. (Because only 3659: certain parts of a multi-part problem may be assigned, this can not be 3660: collapsed into "open later", as we do not know a given part will EVER 3661: be opened. For single part, this is the same as "OPEN_LATER".) 3662: 3663: =item * B<CORRECT>: 3664: 3665: For any reason at all, the part is considered correct. 3666: 3667: =item * B<EXCUSED>: 3668: 3669: For any reason at all, the problem is excused. 3670: 3671: =item * B<PAST_DUE_NO_ANSWER>: 3672: 3673: The problem is past due, not considered correct, and no answer date is 3674: set. 3675: 3676: =item * B<PAST_DUE_ANSWER_LATER>: 3677: 3678: The problem is past due, not considered correct, and an answer date in 3679: the future is set. 3680: 3681: =item * B<ANSWER_OPEN>: 3682: 3683: The problem is past due, not correct, and the answer is now available. 3684: 3685: =item * B<OPEN_LATER>: 3686: 3687: The problem is not yet open. 3688: 3689: =item * B<TRIES_LEFT>: 3690: 3691: The problem is open, has been tried, is not correct, but there are 3692: tries left. 3693: 3694: =item * B<INCORRECT>: 3695: 3696: The problem is open, and all tries have been used without getting the 3697: correct answer. 3698: 3699: =item * B<OPEN>: 3700: 3701: The item is open and not yet tried. 3702: 3703: =item * B<ATTEMPTED>: 3704: 3705: The problem has been attempted. 3706: 3707: =item * B<ANSWER_SUBMITTED>: 3708: 3709: An answer has been submitted, but the student should not see it. 3710: 3711: =back 3712: 3713: =cut 3714: 3715: sub TRIES_LEFT { return 20; } 3716: sub ANSWER_SUBMITTED { return 21; } 3717: 3718: sub status { 3719: my $self = shift; 3720: my $part = shift; 3721: if (!defined($part)) { $part = "0"; } 3722: my $completionStatus = $self->getCompletionStatus($part); 3723: my $dateStatus = $self->getDateStatus($part); 3724: 3725: # What we have is a two-dimensional matrix with 4 entries on one 3726: # dimension and 5 entries on the other, which we want to colorize, 3727: # plus network failure and "no date data at all". 3728: 3729: if ($completionStatus == NETWORK_FAILURE) { return NETWORK_FAILURE; } 3730: 3731: my $suppressFeedback = lc($self->parmval("problemstatus", $part)) eq 'no'; 3732: 3733: # There are a few whole rows we can dispose of: 3734: if ($completionStatus == CORRECT || 3735: $completionStatus == CORRECT_BY_OVERRIDE ) { 3736: return $suppressFeedback? ANSWER_SUBMITTED : CORRECT; 3737: } 3738: 3739: if ($completionStatus == ATTEMPTED) { 3740: return ATTEMPTED; 3741: } 3742: 3743: # If it's EXCUSED, then return that no matter what 3744: if ($completionStatus == EXCUSED) { 3745: return EXCUSED; 3746: } 3747: 3748: if ($dateStatus == NOTHING_SET) { 3749: return NOTHING_SET; 3750: } 3751: 3752: # Now we're down to a 4 (incorrect, incorrect_override, not_attempted) 3753: # by 4 matrix (date statuses). 3754: 3755: if ($dateStatus == PAST_DUE_ANSWER_LATER || 3756: $dateStatus == PAST_DUE_NO_ANSWER ) { 3757: return $dateStatus; 3758: } 3759: 3760: if ($dateStatus == ANSWER_OPEN) { 3761: return ANSWER_OPEN; 3762: } 3763: 3764: # Now: (incorrect, incorrect_override, not_attempted) x 3765: # (open_later), (open) 3766: 3767: if ($dateStatus == OPEN_LATER) { 3768: return OPEN_LATER; 3769: } 3770: 3771: # If it's WRONG... 3772: if ($completionStatus == INCORRECT || $completionStatus == INCORRECT_BY_OVERRIDE) { 3773: # and there are TRIES LEFT: 3774: if ($self->tries($part) < $self->maxtries($part) || !$self->maxtries($part)) { 3775: return TRIES_LEFT; 3776: } 3777: return $suppressFeedback ? ANSWER_SUBMITTED : INCORRECT; # otherwise, return orange; student can't fix this 3778: } 3779: 3780: # Otherwise, it's untried and open 3781: return OPEN; 3782: } 3783: 3784: =pod 3785: 3786: B<Completable> 3787: 3788: The completable method represents the concept of I<whether the student can 3789: currently do the problem>. If the student can do the problem, which means 3790: that it is open, there are tries left, and if the problem is manually graded 3791: or the grade is suppressed via problemstatus, the student has not tried it 3792: yet, then the method returns 1. Otherwise, it returns 0, to indicate that 3793: either the student has tried it and there is no feedback, or that for 3794: some reason it is no longer completable (not open yet, successfully completed, 3795: out of tries, etc.). As an example, this is used as the filter for the 3796: "Uncompleted Homework" option for the nav maps. 3797: 3798: If this does not quite meet your needs, do not fiddle with it (unless you are 3799: fixing it to better match the student's conception of "completable" because 3800: it's broken somehow)... make a new method. 3801: 3802: =cut 3803: 3804: sub completable { 3805: my $self = shift; 3806: if (!$self->is_problem()) { return 0; } 3807: my $partCount = $self->countParts(); 3808: 3809: foreach my $part (@{$self->parts()}) { 3810: if ($part eq '0' && $partCount != 1) { next; } 3811: my $status = $self->status($part); 3812: # "If any of the parts are open, or have tries left (implies open), 3813: # and it is not "attempted" (manually graded problem), it is 3814: # not "complete" 3815: if (!(($status == OPEN() || $status == TRIES_LEFT()) 3816: && $self->getCompletionStatus($part) != ATTEMPTED() 3817: && $status != ANSWER_SUBMITTED())) { 3818: return 0; 3819: } 3820: } 3821: 3822: # If all the parts were complete, so was this problem. 3823: return 1; 3824: } 3825: 3826: =pod 3827: 3828: =head2 Resource/Nav Map Navigation 3829: 3830: =over 4 3831: 3832: =item * B<getNext>(): 3833: 3834: Retreive an array of the possible next resources after this 3835: one. Always returns an array, even in the one- or zero-element case. 3836: 3837: =item * B<getPrevious>(): 3838: 3839: Retreive an array of the possible previous resources from this 3840: one. Always returns an array, even in the one- or zero-element case. 3841: 3842: =cut 3843: 3844: sub getNext { 3845: my $self = shift; 3846: my @branches; 3847: my $to = $self->to(); 3848: foreach my $branch ( split(/,/, $to) ) { 3849: my $choice = $self->{NAV_MAP}->getById($branch); 3850: my $next = $choice->goesto(); 3851: $next = $self->{NAV_MAP}->getById($next); 3852: 3853: push @branches, $next; 3854: } 3855: return \@branches; 3856: } 3857: 3858: sub getPrevious { 3859: my $self = shift; 3860: my @branches; 3861: my $from = $self->from(); 3862: foreach my $branch ( split /,/, $from) { 3863: my $choice = $self->{NAV_MAP}->getById($branch); 3864: my $prev = $choice->comesfrom(); 3865: $prev = $self->{NAV_MAP}->getById($prev); 3866: 3867: push @branches, $prev; 3868: } 3869: return \@branches; 3870: } 3871: 3872: sub browsePriv { 3873: my $self = shift; 3874: if (defined($self->{BROWSE_PRIV})) { 3875: return $self->{BROWSE_PRIV}; 3876: } 3877: 3878: $self->{BROWSE_PRIV} = &Apache::lonnet::allowed('bre', $self->src()); 3879: } 3880: 3881: =pod 3882: 3883: =back 3884: 3885: =cut 3886: 3887: 1; 3888: 3889: __END__ 3890: 3891: