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