loncom/interface/lonnavmaps.pm - view

File: [LON-CAPA] / loncom / interface / lonnavmaps.pm
Revision 1.257: download - view: text, annotated - select for diffs
Mon Apr 5 18:16:36 2004 UTC (20 years, 2 months ago) by raeburn
Branches: MAIN
CVS tags: HEAD

Changes required so documents within uploaded *.page files show as links in the navigation map.
This change could cause problems for other types of non-wrapped /uploaded files if there are any.
If all /uploaded documents are wrapped within /adm/wrapper (except .page and .sequence) then there should not be a problem.

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