loncom/interface/lonnavmaps.pm - view

File: [LON-CAPA] / loncom / interface / lonnavmaps.pm
Revision 1.193: download - view: text, annotated - select for diffs
Tue May 27 21:00:23 2003 UTC (21 years ago) by bowersj2
Branches: MAIN
CVS tags: HEAD

Wanted to just commit the one line fix to LAST_CHECK which seems to
repair some FEEDBACK bubble issues, but this also includes some stuff
with responseIds and such.

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