loncom/interface/lonnavmaps.pm - view

File: [LON-CAPA] / loncom / interface / lonnavmaps.pm
Revision 1.220: download - view: text, annotated - select for diffs
Thu Aug 7 14:29:43 2003 UTC (20 years, 10 months ago) by bowersj2
Branches: MAIN
CVS tags: HEAD

Remove the requirement to pass in the nav hash and the param hash;
nobody ever does it and I'm pretty sure it will never be useful. (If it
is, it can be easily added back in as an optional parameter later;
meanwhile it just confuses things.)

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