loncom/interface/lonnavmaps.pm - view

File: [LON-CAPA] / loncom / interface / lonnavmaps.pm
Revision 1.510: download - view: text, annotated - select for diffs
Mon Oct 5 01:52:10 2015 UTC (8 years, 7 months ago) by raeburn
Branches: MAIN
CVS tags: HEAD

- Usage restriction for a particular slot can be for one or more .sequences
  and/or .pages (in which case the slot may be used for all resources within
  those map(s)), or for one or more specific .problem(s).

1: # The LearningOnline Network with CAPA 2: # Navigate Maps Handler 3: # 4: # $Id: lonnavmaps.pm,v 1.510 2015/10/05 01:52:10 raeburn Exp $ 5: # 6: # Copyright Michigan State University Board of Trustees 7: # 8: # This file is part of the LearningOnline Network with CAPA (LON-CAPA). 9: # 10: # LON-CAPA is free software; you can redistribute it and/or modify 11: # it under the terms of the GNU General Public License as published by 12: # the Free Software Foundation; either version 2 of the License, or 13: # (at your option) any later version. 14: # 15: # LON-CAPA is distributed in the hope that it will be useful, 16: # but WITHOUT ANY WARRANTY; without even the implied warranty of 17: # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 18: # GNU General Public License for more details. 19: # 20: # You should have received a copy of the GNU General Public License 21: # along with LON-CAPA; if not, write to the Free Software 22: # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA 23: # 24: # /home/httpd/html/adm/gpl.txt 25: # 26: # http://www.lon-capa.org/ 27: # 28: ### 29: 30: =pod 31: 32: =head1 NAME 33: 34: Apache::lonnavmaps - Subroutines to handle and render the navigation 35: 36: =head1 SYNOPSIS 37: 38: Handles navigational maps. 39: 40: The main handler generates the navigational listing for the course, 41: the other objects export this information in a usable fashion for 42: other modules. 43: 44: 45: This is part of the LearningOnline Network with CAPA project 46: described at http://www.lon-capa.org. 47: 48: 49: =head1 OVERVIEW 50: 51: X<lonnavmaps, overview> When a user enters a course, LON-CAPA examines the 52: course structure and caches it in what is often referred to as the 53: "big hash" X<big hash>. You can see it if you are logged into 54: LON-CAPA, in a course, by going to /adm/test. (You may need to 55: tweak the /home/httpd/lonTabs/htpasswd file to view it.) The 56: content of the hash will be under the heading "Big Hash". 57: 58: Big Hash contains, among other things, how resources are related 59: to each other (next/previous), what resources are maps, which 60: resources are being chosen to not show to the student (for random 61: selection), and a lot of other things that can take a lot of time 62: to compute due to the amount of data that needs to be collected and 63: processed. 64: 65: Apache::lonnavmaps provides an object model for manipulating this 66: information in a higher-level fashion than directly manipulating 67: the hash. It also provides access to several auxilary functions 68: that aren't necessarily stored in the Big Hash, but are a per- 69: resource sort of value, like whether there is any feedback on 70: a given resource. 71: 72: Apache::lonnavmaps also abstracts away branching, and someday, 73: conditions, for the times where you don't really care about those 74: things. 75: 76: Apache::lonnavmaps also provides fairly powerful routines for 77: rendering navmaps, and last but not least, provides the navmaps 78: view for when the user clicks the NAV button. 79: 80: B<Note>: Apache::lonnavmaps I<only> works for the "currently 81: logged in user"; if you want things like "due dates for another 82: student" lonnavmaps can not directly retrieve information like 83: that. You need the EXT function. This module can still help, 84: because many things, such as the course structure, are constant 85: between users, and Apache::lonnavmaps can help by providing 86: symbs for the EXT call. 87: 88: The rest of this file will cover the provided rendering routines, 89: which can often be used without fiddling with the navmap object at 90: all, then documents the Apache::lonnavmaps::navmap object, which 91: is the key to accessing the Big Hash information, covers the use 92: of the Iterator (which provides the logic for traversing the 93: somewhat-complicated Big Hash data structure), documents the 94: Apache::lonnavmaps::Resource objects that are returned by 95: 96: =head1 Subroutine: render 97: 98: The navmap renderer package provides a sophisticated rendering of the 99: standard navigation maps interface into HTML. The provided nav map 100: handler is actually just a glorified call to this. 101: 102: Because of the large number of parameters this function accepts, 103: instead of passing it arguments as is normal, pass it in an anonymous 104: hash with the desired options. 105: 106: The package provides a function called 'render', called as 107: Apache::lonnavmaps::render({}). 108: 109: =head2 Overview of Columns 110: 111: The renderer will build an HTML table for the navmap and return 112: it. The table consists of several columns, and a row for each 113: resource (or possibly each part). You tell the renderer how many 114: columns to create and what to place in each column, optionally using 115: one or more of the prepared columns, and the renderer will assemble 116: the table. 117: 118: Any additional generally useful column types should be placed in the 119: renderer code here, so anybody can use it anywhere else. Any code 120: specific to the current application (such as the addition of <input> 121: elements in a column) should be placed in the code of the thing using 122: the renderer. 123: 124: At the core of the renderer is the array reference COLS (see Example 125: section below for how to pass this correctly). The COLS array will 126: consist of entries of one of two types of things: Either an integer 127: representing one of the pre-packaged column types, or a sub reference 128: that takes a resource reference, a part number, and a reference to the 129: argument hash passed to the renderer, and returns a string that will 130: be inserted into the HTML representation as it. 131: 132: All other parameters are ways of either changing how the columns 133: are printing, or which rows are shown. 134: 135: The pre-packaged column names are refered to by constants in the 136: Apache::lonnavmaps namespace. The following currently exist: 137: 138: =over 4 139: 140: =item * B<Apache::lonnavmaps::resource>: 141: 142: The general info about the resource: Link, icon for the type, etc. The 143: first column in the standard nav map display. This column provides the 144: indentation effect seen in the B<NAV> screen. This column also accepts 145: the following parameters in the renderer hash: 146: 147: =over 4 148: 149: =item * B<resource_nolink>: default false 150: 151: If true, the resource will not be linked. By default, all non-folder 152: resources are linked. 153: 154: =item * B<resource_part_count>: default true 155: 156: If true, the resource will show a part count B<if> the full 157: part list is not displayed. (See "condense_parts" later.) If false, 158: the resource will never show a part count. 159: 160: =item * B<resource_no_folder_link>: 161: 162: If true, the resource's folder will not be clickable to open or close 163: it. Default is false. True implies printCloseAll is false, since you 164: can't close or open folders when this is on anyhow. 165: 166: =item * B<map_no_edit_link>: 167: 168: If true, the title of the folder or page will not be followed by an 169: icon/link to direct editing of a folder or composite page, originally 170: added via the Course Editor. 171: 172: =back 173: 174: =item * B<Apache::lonnavmaps::communication_status>: 175: 176: Whether there is discussion on the resource, email for the user, or 177: (lumped in here) perl errors in the execution of the problem. This is 178: the second column in the main nav map. 179: 180: =item * B<Apache::lonnavmaps::quick_status>: 181: 182: An icon for the status of a problem, with five possible states: 183: Correct, incorrect, open, awaiting grading (for a problem where the 184: computer's grade is suppressed, or the computer can't grade, like 185: essay problem), or none (not open yet, not a problem). The 186: third column of the standard navmap. 187: 188: =item * B<Apache::lonnavmaps::long_status>: 189: 190: A text readout of the details of the current status of the problem, 191: such as "Due in 22 hours". The fourth column of the standard navmap. 192: 193: =item * B<Apache::lonnavmaps::part_status_summary>: 194: 195: A text readout summarizing the status of the problem. If it is a 196: single part problem, will display "Correct", "Incorrect", 197: "Not yet open", "Open", "Attempted", or "Error". If there are 198: multiple parts, this will output a string that in HTML will show a 199: status of how many parts are in each status, in color coding, trying 200: to match the colors of the icons within reason. 201: 202: Note this only makes sense if you are I<not> showing parts. If 203: C<showParts> is true (see below), this column will not output 204: anything. 205: 206: =back 207: 208: If you add any others please be sure to document them here. 209: 210: An example of a column renderer that will show the ID number of a 211: resource, along with the part name if any: 212: 213: sub { 214: my ($resource, $part, $params) = @_; 215: if ($part) { return '<td>' . $resource->{ID} . ' ' . $part . '</td>'; } 216: return '<td>' . $resource->{ID} . '</td>'; 217: } 218: 219: Note these functions are responsible for the TD tags, which allow them 220: to override vertical and horizontal alignment, etc. 221: 222: =head2 Parameters 223: 224: Minimally, you should be 225: able to get away with just using 'cols' (to specify the columns 226: shown), 'url' (necessary for the folders to link to the current screen 227: correctly), and possibly 'queryString' if your app calls for it. In 228: that case, maintaining the state of the folders will be done 229: automatically. 230: 231: =over 4 232: 233: =item * B<iterator>: default: constructs one from %env 234: 235: A reference to a fresh ::iterator to use from the navmaps. The 236: rendering will reflect the options passed to the iterator, so you can 237: use that to just render a certain part of the course, if you like. If 238: one is not passed, the renderer will attempt to construct one from 239: env{'form.filter'} and env{'form.condition'} information, plus the 240: 'iterator_map' parameter if any. 241: 242: =item * B<iterator_map>: default: not used 243: 244: If you are letting the renderer do the iterator handling, you can 245: instruct the renderer to render only a particular map by passing it 246: the source of the map you want to process, like 247: '/res/103/jerf/navmap.course.sequence'. 248: 249: =item * B<include_top_level_map>: default: false 250: 251: If you need to include the top level map (meaning the course) in the 252: rendered output set this to true 253: 254: =item * B<navmap>: default: constructs one from %env 255: 256: A reference to a navmap, used only if an iterator is not passed in. If 257: this is necessary to make an iterator but it is not passed in, a new 258: one will be constructed based on env info. This is useful to do basic 259: error checking before passing it off to render. 260: 261: =item * B<r>: default: must be passed in 262: 263: The standard Apache response object. This must be passed to the 264: renderer or the course hash will be locked. 265: 266: =item * B<cols>: default: empty (useless) 267: 268: An array reference 269: 270: =item * B<showParts>:default true 271: 272: A flag. If true, a line for the resource itself, and a line 273: for each part will be displayed. If not, only one line for each 274: resource will be displayed. 275: 276: =item * B<condenseParts>: default true 277: 278: A flag. If true, if all parts of the problem have the same 279: status and that status is Nothing Set, Correct, or Network Failure, 280: then only one line will be displayed for that resource anyhow. If no, 281: all parts will always be displayed. If showParts is 0, this is 282: ignored. 283: 284: =item * B<jumpCount>: default: determined from %env 285: 286: A string identifying the URL to place the anchor 'curloc' at. 287: It is the responsibility of the renderer user to 288: ensure that the #curloc is in the URL. By default, determined through 289: the use of the env{} 'jump' information, and should normally "just 290: work" correctly. 291: 292: =item * B<here>: default: empty string 293: 294: A Symb identifying where to place the 'here' marker. The empty 295: string means no marker. 296: 297: =item * B<indentString>: default: 25 pixel whitespace image 298: 299: A string identifying the indentation string to use. 300: 301: =item * B<queryString>: default: empty 302: 303: A string which will be prepended to the query string used when the 304: folders are opened or closed. You can use this to pass 305: application-specific values. 306: 307: =item * B<url>: default: none 308: 309: The url the folders will link to, which should be the current 310: page. Required if the resource info column is shown, and you 311: are allowing the user to open and close folders. 312: 313: =item * B<currentJumpIndex>: default: no jumping 314: 315: Describes the currently-open row number to cause the browser to jump 316: to, because the user just opened that folder. By default, pulled from 317: the Jump information in the env{'form.*'}. 318: 319: =item * B<printKey>: default: false 320: 321: If true, print the key that appears on the top of the standard 322: navmaps. 323: 324: =item * B<printCloseAll>: default: true 325: 326: If true, print the "Close all folders" or "open all folders" 327: links. 328: 329: =item * B<filterFunc>: default: sub {return 1;} (accept everything) 330: 331: A function that takes the resource object as its only parameter and 332: returns a true or false value. If true, the resource is displayed. If 333: false, it is simply skipped in the display. 334: 335: =item * B<suppressEmptySequences>: default: false 336: 337: If you're using a filter function, and displaying sequences to orient 338: the user, then frequently some sequences will be empty. Setting this to 339: true will cause those sequences not to display, so as not to confuse the 340: user into thinking that if the sequence is there there should be things 341: under it; for example, see the "Show Uncompleted Homework" view on the 342: B<NAV> screen. 343: 344: =item * B<suppressNavmaps>: default: false 345: 346: If true, will not display Navigate Content resources. 347: 348: =back 349: 350: =head2 Additional Info 351: 352: In addition to the parameters you can pass to the renderer, which will 353: be passed through unchange to the column renderers, the renderer will 354: generate the following information which your renderer may find 355: useful: 356: 357: =over 4 358: 359: =item * B<counter>: 360: 361: Contains the number of rows printed. Useful after calling the render 362: function, as you can detect whether anything was printed at all. 363: 364: =item * B<isNewBranch>: 365: 366: Useful for renderers: If this resource is currently the first resource 367: of a new branch, this will be true. The Resource column (leftmost in the 368: navmaps screen) uses this to display the "new branch" icon 369: 370: =back 371: 372: =cut 373: 374: 375: =head1 SUBROUTINES 376: 377: =over 378: 379: =item update() 380: 381: =item addToFilter() 382: 383: Convenience functions: Returns a string that adds or subtracts 384: the second argument from the first hash, appropriate for the 385: query string that determines which folders to recurse on 386: 387: =item removeFromFilter() 388: 389: =item getLinkForResource() 390: 391: Convenience function: Given a stack returned from getStack on the iterator, 392: return the correct src() value. 393: 394: =item getDescription() 395: 396: Convenience function: This separates the logic of how to create 397: the problem text strings ("Due: DATE", "Open: DATE", "Not yet assigned", 398: etc.) into a separate function. It takes a resource object as the 399: first parameter, and the part number of the resource as the second. 400: It's basically a big switch statement on the status of the resource. 401: 402: =item dueInLessThan24Hours() 403: 404: Convenience function, so others can use it: Is the problem due in less than 24 hours, and still can be done? 405: 406: =item lastTry() 407: 408: Convenience function, so others can use it: Is there only one try remaining for the 409: part, with more than one try to begin with, not due yet and still can be done? 410: 411: =item advancedUser() 412: 413: This puts a human-readable name on the env variable. 414: 415: =item timeToHumanString() 416: 417: timeToHumanString takes a time number and converts it to a 418: human-readable representation, meant to be used in the following 419: manner: 420: 421: =over 4 422: 423: =item * print "Due $timestring" 424: 425: =item * print "Open $timestring" 426: 427: =item * print "Answer available $timestring" 428: 429: =back 430: 431: Very, very, very, VERY English-only... goodness help a localizer on 432: this func... 433: 434: =item resource() 435: 436: returns 0 437: 438: =item communication_status() 439: 440: returns 1 441: 442: =item quick_status() 443: 444: returns 2 445: 446: =item long_status() 447: 448: returns 3 449: 450: =item part_status_summary() 451: 452: returns 4 453: 454: =item render_resource() 455: 456: =item render_communication_status() 457: 458: =item render_quick_status() 459: 460: =item render_long_status() 461: 462: =item render_parts_summary_status() 463: 464: =item setDefault() 465: 466: =item cmp_title() 467: 468: =item render() 469: 470: =item add_linkitem() 471: 472: =item show_linkitems_toolbar() 473: 474: =back 475: 476: =cut 477: 478: package Apache::lonnavmaps; 479: 480: use strict; 481: use GDBM_File; 482: use Apache::loncommon(); 483: use Apache::lonenc(); 484: use Apache::lonlocal; 485: use Apache::lonnet; 486: use Apache::lonmap; 487: 488: use POSIX qw (floor strftime); 489: use Time::HiRes qw( gettimeofday tv_interval ); 490: use LONCAPA; 491: use DateTime(); 492: use HTML::Entities; 493: 494: # For debugging 495: 496: #use Data::Dumper; 497: 498: 499: # symbolic constants 500: sub SYMB { return 1; } 501: sub URL { return 2; } 502: sub NOTHING { return 3; } 503: 504: # Some data 505: 506: my $resObj = "Apache::lonnavmaps::resource"; 507: 508: # Keep these mappings in sync with lonquickgrades, which usesthe colors 509: # instead of the icons. 510: my %statusIconMap = 511: ( 512: $resObj->CLOSED => '', 513: $resObj->OPEN => 'navmap.open.gif', 514: $resObj->CORRECT => 'navmap.correct.gif', 515: $resObj->PARTIALLY_CORRECT => 'navmap.partial.gif', 516: $resObj->INCORRECT => 'navmap.wrong.gif', 517: $resObj->ATTEMPTED => 'navmap.ellipsis.gif', 518: $resObj->ERROR => '' 519: ); 520: 521: my %iconAltTags = #texthash does not work here 522: ( 'navmap.correct.gif' => 'Correct', 523: 'navmap.wrong.gif' => 'Incorrect', 524: 'navmap.open.gif' => 'Is Open', 525: 'navmap.partial.gif' => 'Partially Correct', 526: 'navmap.ellipsis.gif' => 'Attempted', 527: ); 528: 529: # Defines a status->color mapping, null string means don't color 530: my %colormap = 531: ( $resObj->NETWORK_FAILURE => '', 532: $resObj->CORRECT => '', 533: $resObj->EXCUSED => '#3333FF', 534: $resObj->PAST_DUE_ANSWER_LATER => '', 535: $resObj->PAST_DUE_NO_ANSWER => '', 536: $resObj->ANSWER_OPEN => '#006600', 537: $resObj->OPEN_LATER => '', 538: $resObj->TRIES_LEFT => '', 539: $resObj->INCORRECT => '', 540: $resObj->OPEN => '', 541: $resObj->NOTHING_SET => '', 542: $resObj->ATTEMPTED => '', 543: $resObj->CREDIT_ATTEMPTED => '', 544: $resObj->ANSWER_SUBMITTED => '', 545: $resObj->PARTIALLY_CORRECT => '#006600' 546: ); 547: # And a special case in the nav map; what to do when the assignment 548: # is not yet done and due in less than 24 hours 549: my $hurryUpColor = "#FF0000"; 550: 551: sub addToFilter { 552: my $hashIn = shift; 553: my $addition = shift; 554: my %hash = %$hashIn; 555: $hash{$addition} = 1; 556: 557: return join (",", keys(%hash)); 558: } 559: 560: sub removeFromFilter { 561: my $hashIn = shift; 562: my $subtraction = shift; 563: my %hash = %$hashIn; 564: 565: delete $hash{$subtraction}; 566: return join(",", keys(%hash)); 567: } 568: 569: sub getLinkForResource { 570: my $stack = shift; 571: my $res; 572: 573: # Check to see if there are any pages in the stack 574: foreach $res (@$stack) { 575: if (defined($res)) { 576: my $anchor; 577: if ($res->is_page()) { 578: foreach my $item (@$stack) { if (defined($item)) { $anchor = $item; } } 579: $anchor=&escape($anchor->shown_symb()); 580: return ($res->link(),$res->shown_symb(),$anchor); 581: } 582: # in case folder was skipped over as "only sequence" 583: my ($map,$id,$src)=&Apache::lonnet::decode_symb($res->symb()); 584: if ($map=~/\.page$/) { 585: my $url=&Apache::lonnet::clutter($map); 586: $anchor=&escape($res->shown_symb()); 587: return ($url,$res->shown_symb(),$anchor); 588: } 589: } 590: } 591: 592: # Failing that, return the src of the last resource that is defined 593: # (when we first recurse on a map, it puts an undefined resource 594: # on the bottom because $self->{HERE} isn't defined yet, and we 595: # want the src for the map anyhow) 596: foreach my $item (@$stack) { 597: if (defined($item)) { $res = $item; } 598: } 599: 600: if ($res) { 601: return ($res->link(),$res->shown_symb()); 602: } 603: return; 604: } 605: 606: 607: 608: sub getDescription { 609: my $res = shift; 610: my $part = shift; 611: my $status = $res->status($part); 612: 613: my $open = $res->opendate($part); 614: my $due = $res->duedate($part); 615: my $answer = $res->answerdate($part); 616: 617: if ($status == $res->NETWORK_FAILURE) { 618: return &mt("Having technical difficulties; please check status later"); 619: } 620: if ($status == $res->NOTHING_SET) { 621: return &Apache::lonhtmlcommon::direct_parm_link(&mt('Not currently assigned'),$res->symb(),'opendate',$part); 622: } 623: if ($status == $res->OPEN_LATER) { 624: return &mt("Open [_1]",&Apache::lonhtmlcommon::direct_parm_link(&timeToHumanString($open,'start'),$res->symb(),'opendate',$part)); 625: } 626: my $slotinfo; 627: if ($res->simpleStatus($part) == $res->OPEN) { 628: unless (&Apache::lonnet::allowed('mgr',$env{'request.course.id'})) { 629: my ($slot_status,$slot_time,$slot_name)=$res->check_for_slot($part); 630: my $slotmsg; 631: if ($slot_status == $res->UNKNOWN) { 632: $slotmsg = &mt('Reservation status unknown'); 633: } elsif ($slot_status == $res->RESERVED) { 634: $slotmsg = &mt('Reserved - ends [_1]', 635: timeToHumanString($slot_time,'end')); 636: } elsif ($slot_status == $res->RESERVED_LOCATION) { 637: $slotmsg = &mt('Reserved - specific location(s) - ends [_1]', 638: timeToHumanString($slot_time,'end')); 639: } elsif ($slot_status == $res->RESERVED_LATER) { 640: $slotmsg = &mt('Reserved - next open [_1]', 641: timeToHumanString($slot_time,'start')); 642: } elsif ($slot_status == $res->RESERVABLE) { 643: $slotmsg = &mt('Reservable, reservations close [_1]', 644: timeToHumanString($slot_time,'end')); 645: } elsif ($slot_status == $res->RESERVABLE_LATER) { 646: $slotmsg = &mt('Reservable, reservations open [_1]', 647: timeToHumanString($slot_time,'start')); 648: } elsif ($slot_status == $res->NOT_IN_A_SLOT) { 649: $slotmsg = &mt('Reserve a time/place to work'); 650: } elsif ($slot_status == $res->NOTRESERVABLE) { 651: $slotmsg = &mt('Reservation not available'); 652: } elsif ($slot_status == $res->WAITING_FOR_GRADE) { 653: $slotmsg = &mt('Submission in grading queue'); 654: } 655: if ($slotmsg) { 656: if ($res->is_task() || !$due) { 657: return $slotmsg; 658: } 659: $slotinfo = (' ' x 2).'('.$slotmsg.')'; 660: } 661: } 662: } 663: if ($status == $res->OPEN) { 664: if ($due) { 665: if ($res->is_practice()) { 666: return &mt("Closes [_1]",&Apache::lonhtmlcommon::direct_parm_link(&timeToHumanString($due,'start'),$res->symb(),'duedate',$part)).$slotinfo; 667: } else { 668: return &mt("Due [_1]",&Apache::lonhtmlcommon::direct_parm_link(&timeToHumanString($due,'end'),$res->symb(),'duedate',$part)).$slotinfo; 669: } 670: } else { 671: return &Apache::lonhtmlcommon::direct_parm_link(&mt("Open, no due date"),$res->symb(),'duedate',$part).$slotinfo; 672: } 673: } 674: if ($status == $res->PAST_DUE_ANSWER_LATER) { 675: return &mt("Answer open [_1]",&Apache::lonhtmlcommon::direct_parm_link(&timeToHumanString($answer,'start'),$res->symb(),'answerdate',$part)); 676: } 677: if ($status == $res->PAST_DUE_NO_ANSWER) { 678: if ($res->is_practice()) { 679: return &mt("Closed [_1]",&Apache::lonhtmlcommon::direct_parm_link(&timeToHumanString($due,'start'),$res->symb(),'answerdate,duedate',$part)); 680: } else { 681: return &mt("Was due [_1]",&Apache::lonhtmlcommon::direct_parm_link(&timeToHumanString($due,'end'),$res->symb(),'answerdate,duedate',$part)); 682: } 683: } 684: if (($status == $res->ANSWER_OPEN || $status == $res->PARTIALLY_CORRECT) 685: && $res->handgrade($part) ne 'yes') { 686: return &Apache::lonhtmlcommon::direct_parm_link(&mt("Answer available"),$res->symb(),'answerdate,duedate',$part); 687: } 688: if ($status == $res->EXCUSED) { 689: return &mt("Excused by instructor"); 690: } 691: if ($status == $res->ATTEMPTED) { 692: if ($res->is_anonsurvey($part) || $res->is_survey($part)) { 693: return &mt("Survey submission recorded"); 694: } else { 695: return &mt("Answer submitted, not yet graded"); 696: } 697: } 698: if ($status == $res->CREDIT_ATTEMPTED) { 699: if ($res->is_anonsurvey($part) || $res->is_survey($part)) { 700: return &mt("Credit for survey submission"); 701: } 702: } 703: if ($status == $res->TRIES_LEFT) { 704: my $tries = $res->tries($part); 705: my $maxtries = $res->maxtries($part); 706: my $triesString = ""; 707: if ($tries && $maxtries) { 708: $triesString = '<span class="LC_fontsize_medium"><i>('.&mt('[_1] of [quant,_2,try,tries] used',$tries,$maxtries).')</i></span>'; 709: if ($maxtries > 1 && $maxtries - $tries == 1) { 710: $triesString = "<b>$triesString</b>"; 711: } 712: } 713: if ($due) { 714: return &mt("Due [_1]",&Apache::lonhtmlcommon::direct_parm_link(&timeToHumanString($due,'end'),$res->symb(),'duedate',$part)) . 715: " $triesString"; 716: } else { 717: return &Apache::lonhtmlcommon::direct_parm_link(&mt("No due date"),$res->symb(),'duedate',$part)." $triesString"; 718: } 719: } 720: if ($status == $res->ANSWER_SUBMITTED) { 721: return &mt('Answer submitted'); 722: } 723: } 724: 725: 726: sub dueInLessThan24Hours { 727: my $res = shift; 728: my $part = shift; 729: my $status = $res->status($part); 730: 731: return ($status == $res->OPEN() || 732: $status == $res->TRIES_LEFT()) && 733: $res->duedate($part) && $res->duedate($part) < time()+(24*60*60) && 734: $res->duedate($part) > time(); 735: } 736: 737: 738: sub lastTry { 739: my $res = shift; 740: my $part = shift; 741: 742: my $tries = $res->tries($part); 743: my $maxtries = $res->maxtries($part); 744: return $tries && $maxtries && $maxtries > 1 && 745: $maxtries - $tries == 1 && $res->duedate($part) && 746: $res->duedate($part) > time(); 747: } 748: 749: 750: sub advancedUser { 751: return $env{'request.role.adv'}; 752: } 753: 754: sub timeToHumanString { 755: my ($time,$type,$format) = @_; 756: 757: # zero, '0' and blank are bad times 758: if (!$time) { 759: return &mt('never'); 760: } 761: unless (&Apache::lonlocal::current_language()=~/^en/) { 762: return &Apache::lonlocal::locallocaltime($time); 763: } 764: my $now = time(); 765: 766: # Positive = future 767: my $delta = $time - $now; 768: 769: my $minute = 60; 770: my $hour = 60 * $minute; 771: my $day = 24 * $hour; 772: my $week = 7 * $day; 773: my $inPast = 0; 774: 775: # Logic in comments: 776: # Is it now? (extremely unlikely) 777: if ( $delta == 0 ) { 778: return "this instant"; 779: } 780: 781: if ($delta < 0) { 782: $inPast = 1; 783: $delta = -$delta; 784: } 785: 786: if ( $delta > 0 ) { 787: 788: my $tense = $inPast ? " ago" : ""; 789: my $prefix = $inPast ? "" : "in "; 790: 791: # Less than a minute 792: if ( $delta < $minute ) { 793: if ($delta == 1) { return "${prefix}1 second$tense"; } 794: return "$prefix$delta seconds$tense"; 795: } 796: 797: # Less than an hour 798: if ( $delta < $hour ) { 799: # If so, use minutes; or minutes, seconds (if format requires) 800: my $minutes = floor($delta / 60); 801: if (($format ne '') && ($format =~ /\%(T|S)/)) { 802: my $display; 803: if ($minutes == 1) { 804: $display = "${prefix}1 minute"; 805: } else { 806: $display = "$prefix$minutes minutes"; 807: } 808: my $seconds = $delta % $minute; 809: if ($seconds == 0) { 810: $display .= $tense; 811: } elsif ($seconds == 1) { 812: $display .= ", 1 second$tense"; 813: } else { 814: $display .= ", $seconds seconds$tense"; 815: } 816: return $display; 817: } 818: if ($minutes == 1) { return "${prefix}1 minute$tense"; } 819: return "$prefix$minutes minutes$tense"; 820: } 821: 822: # Is it less than 24 hours away? If so, 823: # display hours + minutes, (and + seconds, if format specified it) 824: if ( $delta < $hour * 24) { 825: my $hours = floor($delta / $hour); 826: my $minutes = floor(($delta % $hour) / $minute); 827: my $hourString = "$hours hours"; 828: my $minuteString = ", $minutes minutes"; 829: if ($hours == 1) { 830: $hourString = "1 hour"; 831: } 832: if ($minutes == 1) { 833: $minuteString = ", 1 minute"; 834: } 835: if ($minutes == 0) { 836: $minuteString = ""; 837: } 838: if (($format ne '') && ($format =~ /\%(T|S)/)) { 839: my $display = "$prefix$hourString$minuteString"; 840: my $seconds = $delta-(($hours * $hour)+($minutes * $minute)); 841: if ($seconds == 0) { 842: $display .= $tense; 843: } elsif ($seconds == 1) { 844: $display .= ", 1 second$tense"; 845: } else { 846: $display .= ", $seconds seconds$tense"; 847: } 848: return $display; 849: } 850: return "$prefix$hourString$minuteString$tense"; 851: } 852: 853: # Date/time is more than 24 hours away 854: 855: my $dt = DateTime->from_epoch(epoch => $time) 856: ->set_time_zone(&Apache::lonlocal::gettimezone()); 857: 858: # If there's a caller supplied format, use it, unless it only displays 859: # H:M:S or H:M. 860: 861: if (($format ne '') && ($format ne '%T') && ($format ne '%R')) { 862: my $timeStr = $dt->strftime($format); 863: return $timeStr.' ('.$dt->time_zone_short_name().')'; 864: } 865: 866: # Less than 5 days away, display day of the week and 867: # HH:MM 868: 869: if ( $delta < $day * 5 ) { 870: my $timeStr = $dt->strftime("%A, %b %e at %I:%M %P (%Z)"); 871: $timeStr =~ s/12:00 am/00:00/; 872: $timeStr =~ s/12:00 pm/noon/; 873: return ($inPast ? "last " : "this ") . 874: $timeStr; 875: } 876: 877: my $conjunction='on'; 878: if ($type eq 'start') { 879: $conjunction='at'; 880: } elsif ($type eq 'end') { 881: $conjunction='by'; 882: } 883: # Is it this year? 884: my $dt_now = DateTime->from_epoch(epoch => $now) 885: ->set_time_zone(&Apache::lonlocal::gettimezone()); 886: if ( $dt->year() == $dt_now->year()) { 887: # Return on Month Day, HH:MM meridian 888: my $timeStr = $dt->strftime("$conjunction %A, %b %e at %I:%M %P (%Z)"); 889: $timeStr =~ s/12:00 am/00:00/; 890: $timeStr =~ s/12:00 pm/noon/; 891: return $timeStr; 892: } 893: 894: # Not this year, so show the year 895: my $timeStr = 896: $dt->strftime("$conjunction %A, %b %e %Y at %I:%M %P (%Z)"); 897: $timeStr =~ s/12:00 am/00:00/; 898: $timeStr =~ s/12:00 pm/noon/; 899: return $timeStr; 900: } 901: } 902: 903: 904: sub resource { return 0; } 905: sub communication_status { return 1; } 906: sub quick_status { return 2; } 907: sub long_status { return 3; } 908: sub part_status_summary { return 4; } 909: 910: sub render_resource { 911: my ($resource, $part, $params) = @_; 912: 913: my $editmapLink; 914: my $nonLinkedText = ''; # stuff after resource title not in link 915: 916: my $link = $params->{"resourceLink"}; 917: 918: # The URL part is not escaped at this point, but the symb is... 919: 920: my $src = $resource->src(); 921: my $it = $params->{"iterator"}; 922: my $filter = $it->{FILTER}; 923: 924: my $title = $resource->compTitle(); 925: 926: my $partLabel = ""; 927: my $newBranchText = ""; 928: my $location=&Apache::loncommon::lonhttpdurl("/adm/lonIcons"); 929: # If this is a new branch, label it so 930: if ($params->{'isNewBranch'}) { 931: $newBranchText = "<img src='$location/branch.gif' alt=".mt('Branch')." />"; 932: } 933: 934: # links to open and close the folder 935: 936: my $whitespace = $location.'/whitespace_21.gif'; 937: my $linkopen = "<img src='$whitespace' alt='' />"."<a href=\"$link\">"; 938: my $linkclose = "</a>"; 939: 940: # Default icon: unknown page 941: my $icon = "<img class=\"LC_contentImage\" src='$location/unknown.gif' alt='' />"; 942: 943: if ($resource->is_problem()) { 944: if ($part eq '0' || $params->{'condensed'}) { 945: $icon = '<img class="LC_contentImage" src="'.$location.'/'; 946: if ($resource->is_task()) { 947: $icon .= 'task.gif" alt="'.&mt('Task'); 948: } else { 949: $icon .= 'problem.gif" alt="'.&mt('Problem'); 950: } 951: $icon .='" />'; 952: } else { 953: $icon = $params->{'indentString'}; 954: } 955: } else { 956: $icon = "<img class=\"LC_contentImage\" src='".&Apache::loncommon::icon($resource->src)."' alt='' />"; 957: } 958: 959: # Display the correct map icon to open or shut map 960: if ($resource->is_map()) { 961: my $mapId = $resource->map_pc(); 962: my $nowOpen = !defined($filter->{$mapId}); 963: if ($it->{CONDITION}) { 964: $nowOpen = !$nowOpen; 965: } 966: 967: my $folderType = $resource->is_sequence() ? 'folder' : 'page'; 968: my $title=$resource->title; 969: $title=~s/\"/\&qout;/g; 970: if (!$params->{'resource_no_folder_link'}) { 971: $icon = "navmap.$folderType." . ($nowOpen ? 'closed' : 'open') . '.gif'; 972: $icon = "<img src='$location/arrow." . ($nowOpen ? 'closed' : 'open') . ".gif' alt='' />" 973: ."<img class=\"LC_contentImage\" src='$location/$icon' alt=\"" 974: .($nowOpen ? &mt('Open Folder') : &mt('Close Folder')).' '.$title."\" />"; 975: $linkopen = "<a href=\"" . $params->{'url'} . '?' . 976: $params->{'queryString'} . '&filter='; 977: $linkopen .= ($nowOpen xor $it->{CONDITION}) ? 978: addToFilter($filter, $mapId) : 979: removeFromFilter($filter, $mapId); 980: $linkopen .= "&condition=" . $it->{CONDITION} . '&hereType=' 981: . $params->{'hereType'} . '&here=' . 982: &escape($params->{'here'}) . 983: '&jump=' . 984: &escape($resource->symb()) . 985: "&folderManip=1\">"; 986: 987: } else { 988: # Don't allow users to manipulate folder 989: $icon = "navmap.$folderType." . ($nowOpen ? 'closed' : 'open') . '.gif'; 990: $icon = "<img class=\"LC_space\" src='$whitespace' alt='' />"."<img class=\"LC_contentImage\" src='$location/$icon' alt=\"".($nowOpen ? &mt('Open Folder') : &mt('Close Folder')).' '.$title."\" />"; 991: 992: $linkopen = ""; 993: $linkclose = ""; 994: } 995: if ((&Apache::lonnet::allowed('mdc',$env{'request.course.id'})) && 996: ($resource->symb=~/\_\_\_[^\_]+\_\_\_uploaded/)) { 997: if (!$params->{'map_no_edit_link'}) { 998: my $icon = &Apache::loncommon::lonhttpdurl('/res/adm/pages').'/editmap.png'; 999: $editmapLink=' '. 1000: '<a href="/adm/coursedocs?command=directnav&symb='.&escape($resource->symb()).'">'. 1001: '<img src="'.$icon.'" alt="'.&mt('Edit Content').'" title="'.&mt('Edit Content').'" />'. 1002: '</a>'; 1003: } 1004: } 1005: } 1006: 1007: if ($resource->randomout()) { 1008: $nonLinkedText .= ' <span class="LC_warning">('.&mt('hidden').')</span> '; 1009: } 1010: if (!$resource->condval()) { 1011: $nonLinkedText .= ' <span class="LC_info">('.&mt('conditionally hidden').')</span> '; 1012: } 1013: if (($resource->is_practice()) && ($resource->is_raw_problem())) { 1014: $nonLinkedText .=' <span class="LC_info"><b>'.&mt('not graded').'</b></span>'; 1015: } 1016: 1017: # We're done preparing and finally ready to start the rendering 1018: my $result = '<td class="LC_middle">'; 1019: my $newfolderType = $resource->is_sequence() ? 'folder' : 'page'; 1020: 1021: my $indentLevel = $params->{'indentLevel'}; 1022: if ($newBranchText) { $indentLevel--; } 1023: 1024: # print indentation 1025: for (my $i = 0; $i < $indentLevel; $i++) { 1026: $result .= $params->{'indentString'}; 1027: } 1028: 1029: # Decide what to display 1030: $result .= "$newBranchText$linkopen$icon$linkclose"; 1031: 1032: my $curMarkerBegin = ''; 1033: my $curMarkerEnd = ''; 1034: 1035: # Is this the current resource? 1036: if (!$params->{'displayedHereMarker'} && 1037: $resource->symb() eq $params->{'here'} ) { 1038: unless ($resource->is_map()) { 1039: $curMarkerBegin = '<span class="LC_current_nav_location">'; 1040: $curMarkerEnd = '</span>'; 1041: } 1042: $params->{'displayedHereMarker'} = 1; 1043: } 1044: 1045: if ($resource->is_problem() && $part ne '0' && 1046: !$params->{'condensed'}) { 1047: my $displaypart=$resource->part_display($part); 1048: $partLabel = " (".&mt('Part: [_1]', $displaypart).")"; 1049: if ($link!~/\#/) { $link.='#'.&escape($part); } 1050: $title = ""; 1051: } 1052: 1053: if ($params->{'condensed'} && $resource->countParts() > 1) { 1054: $nonLinkedText .= ' ('.&mt('[_1] parts', $resource->countParts()).')'; 1055: } 1056: 1057: if (!$params->{'resource_nolink'} && !$resource->is_sequence() && !$resource->is_empty_sequence) { 1058: $result .= "$curMarkerBegin<a href=\"$link\">$title$partLabel</a>$curMarkerEnd$editmapLink$nonLinkedText</td>"; 1059: } else { 1060: $result .= "$curMarkerBegin$linkopen$title$partLabel</a>$curMarkerEnd$editmapLink$nonLinkedText</td>"; 1061: } 1062: 1063: return $result; 1064: } 1065: 1066: sub render_communication_status { 1067: my ($resource, $part, $params) = @_; 1068: my $discussionHTML = ""; my $feedbackHTML = ""; my $errorHTML = ""; 1069: 1070: my $link = $params->{"resourceLink"}; 1071: my $linkopen = "<a href=\"$link\">"; 1072: my $linkclose = "</a>"; 1073: my $location=&Apache::loncommon::lonhttpdurl("/adm/lonMisc"); 1074: 1075: if ($resource->hasDiscussion()) { 1076: $discussionHTML = $linkopen . 1077: '<img alt="'.&mt('New Discussion').'" src="'.$location.'/chat.gif" title="'.&mt('New Discussion').'"/>' . 1078: $linkclose; 1079: } 1080: 1081: if ($resource->getFeedback()) { 1082: my $feedback = $resource->getFeedback(); 1083: foreach my $msgid (split(/\,/, $feedback)) { 1084: if ($msgid) { 1085: $feedbackHTML .= ' <a href="/adm/email?display=' 1086: . &escape($msgid) . '">' 1087: . '<img alt="'.&mt('New E-mail').'" src="'.$location.'/feedback.gif" title="'.&mt('New E-mail').'"/></a>'; 1088: } 1089: } 1090: } 1091: 1092: if ($resource->getErrors()) { 1093: my $errors = $resource->getErrors(); 1094: my $errorcount = 0; 1095: foreach my $msgid (split(/,/, $errors)) { 1096: last if ($errorcount>=10); # Only output 10 bombs maximum 1097: if ($msgid) { 1098: $errorcount++; 1099: $errorHTML .= ' <a href="/adm/email?display=' 1100: . &escape($msgid) . '">' 1101: . '<img alt="'.&mt('New Error').'" src="'.$location.'/bomb.gif" title="'.&mt('New Error').'"/></a>'; 1102: } 1103: } 1104: } 1105: 1106: if ($params->{'multipart'} && $part != '0') { 1107: $discussionHTML = $feedbackHTML = $errorHTML = ''; 1108: } 1109: return "<td class=\"LC_middle\">$discussionHTML$feedbackHTML$errorHTML </td>"; 1110: 1111: } 1112: sub render_quick_status { 1113: my ($resource, $part, $params) = @_; 1114: my $result = ""; 1115: my $firstDisplayed = !$params->{'condensed'} && 1116: $params->{'multipart'} && $part eq "0"; 1117: 1118: my $link = $params->{"resourceLink"}; 1119: my $linkopen = "<a href=\"$link\">"; 1120: my $linkclose = "</a>"; 1121: 1122: $result .= '<td class="LC_middle">'; 1123: if ($resource->is_problem() && 1124: !$firstDisplayed) { 1125: my $icon = $statusIconMap{$resource->simpleStatus($part)}; 1126: my $alt = $iconAltTags{$icon}; 1127: if ($icon) { 1128: my $location= 1129: &Apache::loncommon::lonhttpdurl("/adm/lonIcons/$icon"); 1130: $result .= $linkopen.'<img src="'.$location.'" alt="'.&mt($alt).'" title="'.&mt($alt).'" />'.$linkclose; 1131: } else { 1132: $result .= " "; 1133: } 1134: } else { # not problem, no icon 1135: $result .= " "; 1136: } 1137: $result .= "</td>\n"; 1138: return $result; 1139: } 1140: sub render_long_status { 1141: my ($resource, $part, $params) = @_; 1142: my $result = '<td class="LC_middle LC_right">'; 1143: my $firstDisplayed = !$params->{'condensed'} && 1144: $params->{'multipart'} && $part eq "0"; 1145: 1146: my $color; 1147: my $info = ''; 1148: if ($resource->is_problem() || $resource->is_practice()) { 1149: $color = $colormap{$resource->status}; 1150: 1151: if (dueInLessThan24Hours($resource, $part)) { 1152: $color = $hurryUpColor; 1153: $info = ' title="'.&mt('Due in less than 24 hours!').'"'; 1154: } elsif (lastTry($resource, $part)) { 1155: unless (($resource->problemstatus($part) eq 'no') || 1156: ($resource->problemstatus($part) eq 'no_feedback_ever')) { 1157: $color = $hurryUpColor; 1158: $info = ' title="'.&mt('One try remaining!').'"'; 1159: } 1160: } 1161: } 1162: 1163: if ($resource->kind() eq "res" && 1164: $resource->is_raw_problem() && 1165: !$firstDisplayed) { 1166: if ($color) {$result .= '<span style="color:'.$color.'"'.$info.'><b>'; } 1167: $result .= getDescription($resource, $part); 1168: if ($color) {$result .= "</b></span>"; } 1169: } 1170: if ($resource->is_map() && &advancedUser() && $resource->randompick()) { 1171: $result .= &mt('(randomly select [_1])', $resource->randompick()); 1172: } 1173: if ($resource->is_map() && &advancedUser() && $resource->randomorder()) { 1174: $result .= &mt('(randomly ordered)'); 1175: } 1176: 1177: # Debugging code 1178: #$result .= " " . $resource->awarded($part) . '/' . $resource->weight($part) . 1179: # ' - Part: ' . $part; 1180: 1181: $result .= "</td>\n"; 1182: 1183: return $result; 1184: } 1185: 1186: # Colors obtained by taking the icons, matching the colors, and 1187: # possibly reducing the Value (HSV) of the color, if it's too bright 1188: # for text, generally by one third or so. 1189: my %statusColors = 1190: ( 1191: $resObj->CLOSED => '#000000', 1192: $resObj->OPEN => '#998b13', 1193: $resObj->CORRECT => '#26933f', 1194: $resObj->INCORRECT => '#c48207', 1195: $resObj->ATTEMPTED => '#a87510', 1196: $resObj->ERROR => '#000000' 1197: ); 1198: my %statusStrings = 1199: ( 1200: $resObj->CLOSED => 'Not yet open', 1201: $resObj->OPEN => 'Open', 1202: $resObj->CORRECT => 'Correct', 1203: $resObj->INCORRECT => 'Incorrect', 1204: $resObj->ATTEMPTED => 'Attempted', 1205: $resObj->ERROR => 'Network Error' 1206: ); 1207: my @statuses = ($resObj->CORRECT, $resObj->ATTEMPTED, $resObj->INCORRECT, $resObj->OPEN, $resObj->CLOSED, $resObj->ERROR); 1208: 1209: sub render_parts_summary_status { 1210: my ($resource, $part, $params) = @_; 1211: if (!$resource->is_problem() && !$resource->contains_problem) { return '<td></td>'; } 1212: if ($params->{showParts}) { 1213: return '<td></td>'; 1214: } 1215: 1216: my $td = "<td align='right'>\n"; 1217: my $endtd = "</td>\n"; 1218: my @probs; 1219: 1220: if ($resource->contains_problem) { 1221: @probs=$resource->retrieveResources($resource,sub { $_[0]->is_problem() },1,0); 1222: } else { 1223: @probs=($resource); 1224: } 1225: my $return; 1226: my %overallstatus; 1227: my $totalParts; 1228: foreach my $resource (@probs) { 1229: # If there is a single part, just show the simple status 1230: if ($resource->singlepart()) { 1231: my $status = $resource->simpleStatus(${$resource->parts}[0]); 1232: $overallstatus{$status}++; 1233: $totalParts++; 1234: next; 1235: } 1236: # Now we can be sure the $part doesn't really matter. 1237: my $statusCount = $resource->simpleStatusCount(); 1238: my @counts; 1239: foreach my $status (@statuses) { 1240: # decouple display order from the simpleStatusCount order 1241: my $slot = Apache::lonnavmaps::resource::statusToSlot($status); 1242: if ($statusCount->[$slot]) { 1243: $overallstatus{$status}+=$statusCount->[$slot]; 1244: $totalParts+=$statusCount->[$slot]; 1245: } 1246: } 1247: } 1248: $return.= $td . $totalParts . ' parts: '; 1249: foreach my $status (@statuses) { 1250: if ($overallstatus{$status}) { 1251: $return.='<span style="color:' . $statusColors{$status} 1252: . '">' . $overallstatus{$status} . ' ' 1253: . $statusStrings{$status} . '</span>'; 1254: } 1255: } 1256: $return.= $endtd; 1257: return $return; 1258: } 1259: 1260: my @preparedColumns = (\&render_resource, \&render_communication_status, 1261: \&render_quick_status, \&render_long_status, 1262: \&render_parts_summary_status); 1263: 1264: sub setDefault { 1265: my ($val, $default) = @_; 1266: if (!defined($val)) { return $default; } 1267: return $val; 1268: } 1269: 1270: sub cmp_title { 1271: my ($atitle,$btitle) = (lc($_[0]->compTitle),lc($_[1]->compTitle)); 1272: $atitle=~s/^\s*//; 1273: $btitle=~s/^\s*//; 1274: return $atitle cmp $btitle; 1275: } 1276: 1277: sub render { 1278: my $args = shift; 1279: &Apache::loncommon::get_unprocessed_cgi($ENV{QUERY_STRING}); 1280: my $result = ''; 1281: # Configure the renderer. 1282: my $cols = $args->{'cols'}; 1283: if (!defined($cols)) { 1284: # no columns, no nav maps. 1285: return ''; 1286: } 1287: my $navmap; 1288: if (defined($args->{'navmap'})) { 1289: $navmap = $args->{'navmap'}; 1290: } 1291: 1292: my $r = $args->{'r'}; 1293: my $queryString = $args->{'queryString'}; 1294: my $jump = $args->{'jump'}; 1295: my $here = $args->{'here'}; 1296: my $suppressNavmap = setDefault($args->{'suppressNavmap'}, 0); 1297: my $closeAllPages = setDefault($args->{'closeAllPages'}, 0); 1298: my $currentJumpDelta = 2; # change this to change how many resources are displayed 1299: # before the current resource when using #current 1300: 1301: # If we were passed 'here' information, we are not rendering 1302: # after a folder manipulation, and we were not passed an 1303: # iterator, make sure we open the folders to show the "here" 1304: # marker 1305: my $filterHash = {}; 1306: # Figure out what we're not displaying 1307: foreach my $item (split(/\,/, $env{"form.filter"})) { 1308: if ($item) { 1309: $filterHash->{$item} = "1"; 1310: } 1311: } 1312: 1313: # Filter: Remember filter function and add our own filter: Refuse 1314: # to show hidden resources unless the user can see them. 1315: my $userCanSeeHidden = advancedUser(); 1316: my $filterFunc = setDefault($args->{'filterFunc'}, 1317: sub {return 1;}); 1318: if (!$userCanSeeHidden) { 1319: # Without renaming the filterfunc, the server seems to go into 1320: # an infinite loop 1321: my $oldFilterFunc = $filterFunc; 1322: $filterFunc = sub { my $res = shift; return !$res->randomout() && 1323: &$oldFilterFunc($res);}; 1324: } 1325: 1326: my $condition = 0; 1327: if ($env{'form.condition'}) { 1328: $condition = 1; 1329: } 1330: 1331: if (!$env{'form.folderManip'} && !defined($args->{'iterator'})) { 1332: # Step 1: Check to see if we have a navmap 1333: if (!defined($navmap)) { 1334: $navmap = Apache::lonnavmaps::navmap->new(); 1335: if (!defined($navmap)) { 1336: # no longer in course 1337: return '<span class="LC_error">'.&mt('No course selected').'</span><br /> 1338: <a href="/adm/roles">'.&mt('Select a course').'</a><br />'; 1339: } 1340: } 1341: 1342: # Step two: Locate what kind of here marker is necessary 1343: # Determine where the "here" marker is and where the screen jumps to. 1344: 1345: if ($env{'form.postsymb'} ne '') { 1346: $here = $jump = &Apache::lonnet::symbclean($env{'form.postsymb'}); 1347: } elsif ($env{'form.postdata'} ne '') { 1348: # couldn't find a symb, is there a URL? 1349: my $currenturl = $env{'form.postdata'}; 1350: #$currenturl=~s/^http\:\/\///; 1351: #$currenturl=~s/^[^\/]+//; 1352: 1353: $here = $jump = &Apache::lonnet::symbread($currenturl); 1354: } 1355: if ($here eq '') { 1356: my $last; 1357: if (tie(my %hash,'GDBM_File',$env{'request.course.fn'}.'_symb.db', 1358: &GDBM_READER(),0640)) { 1359: $last=$hash{'last_known'}; 1360: untie(%hash); 1361: } 1362: if ($last) { $here = $jump = $last; } 1363: } 1364: 1365: # Step three: Ensure the folders are open 1366: my $mapIterator = $navmap->getIterator(undef, undef, undef, 1); 1367: my $curRes; 1368: my $found = 0; 1369: 1370: # We only need to do this if we need to open the maps to show the 1371: # current position. This will change the counter so we can't count 1372: # for the jump marker with this loop. 1373: while ($here && ($curRes = $mapIterator->next()) && !$found) { 1374: if (ref($curRes) && $curRes->symb() eq $here) { 1375: my $mapStack = $mapIterator->getStack(); 1376: 1377: # Ensure the parent maps are open 1378: for my $map (@{$mapStack}) { 1379: if ($condition) { 1380: undef $filterHash->{$map->map_pc()}; 1381: } else { 1382: $filterHash->{$map->map_pc()} = 1; 1383: } 1384: } 1385: $found = 1; 1386: } 1387: } 1388: } 1389: 1390: if ( !defined($args->{'iterator'}) && $env{'form.folderManip'} ) { # we came from a user's manipulation of the nav page 1391: # If this is a click on a folder or something, we want to preserve the "here" 1392: # from the querystring, and get the new "jump" marker 1393: $here = $env{'form.here'}; 1394: $jump = $env{'form.jump'}; 1395: } 1396: 1397: my $it = $args->{'iterator'}; 1398: if (!defined($it)) { 1399: # Construct a default iterator based on $env{'form.'} information 1400: 1401: # Step 1: Check to see if we have a navmap 1402: if (!defined($navmap)) { 1403: $navmap = Apache::lonnavmaps::navmap->new(); 1404: if (!defined($navmap)) { 1405: # no longer in course 1406: return '<span class="LC_error">'.&mt('No course selected').'</span><br /> 1407: <a href="/adm/roles">'.&mt('Select a course').'</a><br />'; 1408: } 1409: } 1410: 1411: # See if we're being passed a specific map 1412: if ($args->{'iterator_map'}) { 1413: my $map = $args->{'iterator_map'}; 1414: $map = $navmap->getResourceByUrl($map); 1415: my $firstResource = $map->map_start(); 1416: my $finishResource = $map->map_finish(); 1417: 1418: $args->{'iterator'} = $it = $navmap->getIterator($firstResource, $finishResource, $filterHash, $condition); 1419: } else { 1420: $args->{'iterator'} = $it = $navmap->getIterator(undef, undef, $filterHash, $condition,undef,$args->{'include_top_level_map'}); 1421: } 1422: } 1423: 1424: # (re-)Locate the jump point, if any 1425: # Note this does not take filtering or hidden into account... need 1426: # to be fixed? 1427: my $mapIterator = $navmap->getIterator(undef, undef, $filterHash, 0); 1428: my $curRes; 1429: my $foundJump = 0; 1430: my $counter = 0; 1431: 1432: while (($curRes = $mapIterator->next()) && !$foundJump) { 1433: if (ref($curRes)) { $counter++; } 1434: 1435: if (ref($curRes) && $jump eq $curRes->symb()) { 1436: 1437: # This is why we have to use the main iterator instead of the 1438: # potentially faster DFS: The count has to be the same, so 1439: # the order has to be the same, which DFS won't give us. 1440: $args->{'currentJumpIndex'} = $counter; 1441: $foundJump = 1; 1442: } 1443: } 1444: 1445: my $showParts = setDefault($args->{'showParts'}, 1); 1446: my $condenseParts = setDefault($args->{'condenseParts'}, 1); 1447: # keeps track of when the current resource is found, 1448: # so we can back up a few and put the anchor above the 1449: # current resource 1450: my $printKey = $args->{'printKey'}; 1451: my $printCloseAll = $args->{'printCloseAll'}; 1452: if (!defined($printCloseAll)) { $printCloseAll = 1; } 1453: 1454: # Print key? 1455: if ($printKey) { 1456: $result .= '<table border="0" cellpadding="2" cellspacing="0">'; 1457: $result.='<tr><td align="right" valign="bottom">Key:  </td>'; 1458: my $location=&Apache::loncommon::lonhttpdurl("/adm/lonMisc"); 1459: if ($navmap->{LAST_CHECK}) { 1460: $result .= 1461: '<img src="'.$location.'/chat.gif" alt="" /> '.&mt('New discussion since').' '. 1462: strftime("%A, %b %e at %I:%M %P", localtime($navmap->{LAST_CHECK})). 1463: '</td><td align="center" valign="bottom">  '. 1464: '<img src="'.$location.'/feedback.gif" alt="" /> '.&mt('New message (click to open)').'<p>'. 1465: '</td>'; 1466: } else { 1467: $result .= '<td align="center" valign="bottom">  '. 1468: '<img src="'.$location.'/chat.gif" alt="" /> '.&mt('Discussions').'</td><td align="center" valign="bottom">'. 1469: '  <img src="'.$location.'/feedback.gif" alt="" /> '.&mt('New message (click to open)'). 1470: '</td>'; 1471: } 1472: 1473: $result .= '</tr></table>'; 1474: } 1475: 1476: if ($printCloseAll && !$args->{'resource_no_folder_link'}) { 1477: my ($link,$text); 1478: if ($condition) { 1479: $link='navmaps?condition=0&filter=&'.$queryString. 1480: '&here='.&escape($here); 1481: $text='Close all folders'; 1482: } else { 1483: $link='navmaps?condition=1&filter=&'.$queryString. 1484: '&here='.&escape($here); 1485: $text='Open all folders'; 1486: } 1487: if ($env{'form.register'}) { 1488: $link .= '&register='.$env{'form.register'}; 1489: } 1490: if ($args->{'caller'} eq 'navmapsdisplay') { 1491: unless ($args->{'notools'}) { 1492: &add_linkitem($args->{'linkitems'},'changefolder', 1493: "location.href='$link'",$text); 1494: } 1495: } else { 1496: $result.= '<a href="'.$link.'">'.&mt($text).'</a>'; 1497: } 1498: $result .= "\n"; 1499: } 1500: 1501: # Check for any unread discussions in all resources. 1502: if (($args->{'caller'} eq 'navmapsdisplay') && (!$args->{'notools'})) { 1503: &add_linkitem($args->{'linkitems'},'clearbubbles', 1504: 'document.clearbubbles.submit()', 1505: 'Mark all posts read'); 1506: my $time=time; 1507: my $querystr = &HTML::Entities::encode($ENV{'QUERY_STRING'},'<>&"'); 1508: $result .= (<<END); 1509: <form name="clearbubbles" method="post" action="/adm/feedback"> 1510: <input type="hidden" name="navurl" value="$querystr" /> 1511: <input type="hidden" name="navtime" value="$time" /> 1512: END 1513: if ($env{'form.register'}) { 1514: $result .= '<input type="hidden" name="register" value="'.$env{'form.register'}.'" />'; 1515: } 1516: if ($args->{'sort'} eq 'discussion') { 1517: my $totdisc = 0; 1518: my $haveDisc = ''; 1519: my @allres=$navmap->retrieveResources(); 1520: foreach my $resource (@allres) { 1521: if ($resource->hasDiscussion()) { 1522: $haveDisc .= $resource->wrap_symb().':'; 1523: $totdisc ++; 1524: } 1525: } 1526: if ($totdisc > 0) { 1527: $haveDisc =~ s/:$//; 1528: $result .= (<<END); 1529: <input type="hidden" name="navmaps" value="$haveDisc" /> 1530: </form> 1531: END 1532: } 1533: } 1534: $result.='</form>'; 1535: } 1536: if (($args->{'caller'} eq 'navmapsdisplay') && 1537: (&Apache::lonnet::allowed('mdc',$env{'request.course.id'}))) { 1538: my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'}; 1539: my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'}; 1540: if ($env{'course.'.$env{'request.course.id'}.'.url'} eq 1541: "uploaded/$cdom/$cnum/default.sequence") { 1542: &add_linkitem($args->{'linkitems'},'edittoplevel', 1543: "javascript:gocmd('/adm/coursedocs','editdocs');", 1544: 'Content Editor'); 1545: } 1546: } 1547: 1548: if ($args->{'caller'} eq 'navmapsdisplay') { 1549: $result .= &show_linkitems_toolbar($args,$condition); 1550: } elsif ($args->{'sort_html'}) { 1551: $result.=$args->{'sort_html'}; 1552: } 1553: 1554: #$result .= "<br />\n"; 1555: if ($r) { 1556: $r->print($result); 1557: $r->rflush(); 1558: $result = ""; 1559: } 1560: # End parameter setting 1561: 1562: $result .= "<br />\n"; 1563: 1564: # Data 1565: $result.=&Apache::loncommon::start_data_table("LC_tableOfContent"); 1566: 1567: my $res = "Apache::lonnavmaps::resource"; 1568: my %condenseStatuses = 1569: ( $res->NETWORK_FAILURE => 1, 1570: $res->NOTHING_SET => 1, 1571: $res->CORRECT => 1 ); 1572: 1573: # Shared variables 1574: $args->{'counter'} = 0; # counts the rows 1575: $args->{'indentLevel'} = 0; 1576: $args->{'isNewBranch'} = 0; 1577: $args->{'condensed'} = 0; 1578: 1579: my $location = &Apache::loncommon::lonhttpdurl("/adm/lonIcons/whitespace_21.gif"); 1580: $args->{'indentString'} = setDefault($args->{'indentString'}, "<img src='$location' alt='' />"); 1581: $args->{'displayedHereMarker'} = 0; 1582: 1583: # If we're suppressing empty sequences, look for them here. Use DFS for speed, 1584: # since structure actually doesn't matter, except what map has what resources. 1585: if ($args->{'suppressEmptySequences'}) { 1586: my $dfsit = Apache::lonnavmaps::DFSiterator->new($navmap, 1587: $it->{FIRST_RESOURCE}, 1588: $it->{FINISH_RESOURCE}, 1589: {}, undef, 1); 1590: my $depth = 0; 1591: $dfsit->next(); 1592: my $curRes = $dfsit->next(); 1593: while ($depth > -1) { 1594: if ($curRes == $dfsit->BEGIN_MAP()) { $depth++; } 1595: if ($curRes == $dfsit->END_MAP()) { $depth--; } 1596: 1597: if (ref($curRes)) { 1598: # Parallel pre-processing: Do sequences have non-filtered-out children? 1599: if ($curRes->is_map()) { 1600: $curRes->{DATA}->{HAS_VISIBLE_CHILDREN} = 0; 1601: # Sequences themselves do not count as visible children, 1602: # unless those sequences also have visible children. 1603: # This means if a sequence appears, there's a "promise" 1604: # that there's something under it if you open it, somewhere. 1605: } else { 1606: # Not a sequence: if it's filtered, ignore it, otherwise 1607: # rise up the stack and mark the sequences as having children 1608: if (&$filterFunc($curRes)) { 1609: for my $sequence (@{$dfsit->getStack()}) { 1610: $sequence->{DATA}->{HAS_VISIBLE_CHILDREN} = 1; 1611: } 1612: } 1613: } 1614: } 1615: } continue { 1616: $curRes = $dfsit->next(); 1617: } 1618: } 1619: 1620: my $displayedJumpMarker = 0; 1621: # Set up iteration. 1622: my $now = time(); 1623: my $in24Hours = $now + 24 * 60 * 60; 1624: my $rownum = 0; 1625: 1626: # export "here" marker information 1627: $args->{'here'} = $here; 1628: 1629: $args->{'indentLevel'} = -1; # first BEGIN_MAP takes this to 0 1630: my @resources; 1631: my $code='';# sub { !(shift->is_map();) }; 1632: if ($args->{'sort'} eq 'title') { 1633: my $oldFilterFunc = $filterFunc; 1634: my $filterFunc= 1635: sub { 1636: my ($res)=@_; 1637: if ($res->is_map()) { return 0;} 1638: return &$oldFilterFunc($res); 1639: }; 1640: @resources=$navmap->retrieveResources(undef,$filterFunc); 1641: @resources= sort { &cmp_title($a,$b) } @resources; 1642: } elsif ($args->{'sort'} eq 'duedate') { 1643: my $oldFilterFunc = $filterFunc; 1644: my $filterFunc= 1645: sub { 1646: my ($res)=@_; 1647: if (!$res->is_problem()) { return 0;} 1648: return &$oldFilterFunc($res); 1649: }; 1650: @resources=$navmap->retrieveResources(undef,$filterFunc); 1651: @resources= sort { 1652: if ($a->duedate ne $b->duedate) { 1653: return $a->duedate cmp $b->duedate; 1654: } 1655: my $value=&cmp_title($a,$b); 1656: return $value; 1657: } @resources; 1658: } elsif ($args->{'sort'} eq 'discussion') { 1659: my $oldFilterFunc = $filterFunc; 1660: my $filterFunc= 1661: sub { 1662: my ($res)=@_; 1663: if (!$res->hasDiscussion() && 1664: !$res->getFeedback() && 1665: !$res->getErrors()) { return 0;} 1666: return &$oldFilterFunc($res); 1667: }; 1668: @resources=$navmap->retrieveResources(undef,$filterFunc); 1669: @resources= sort { &cmp_title($a,$b) } @resources; 1670: } else { 1671: #unknow sort mechanism or default 1672: undef($args->{'sort'}); 1673: } 1674: 1675: 1676: while (1) { 1677: if ($args->{'sort'}) { 1678: $curRes = shift(@resources); 1679: } else { 1680: $curRes = $it->next($closeAllPages); 1681: } 1682: if (!$curRes) { last; } 1683: 1684: # Maintain indentation level. 1685: if ($curRes == $it->BEGIN_MAP() || 1686: $curRes == $it->BEGIN_BRANCH() ) { 1687: $args->{'indentLevel'}++; 1688: } 1689: if ($curRes == $it->END_MAP() || 1690: $curRes == $it->END_BRANCH() ) { 1691: $args->{'indentLevel'}--; 1692: } 1693: # Notice new branches 1694: if ($curRes == $it->BEGIN_BRANCH()) { 1695: $args->{'isNewBranch'} = 1; 1696: } 1697: 1698: # If this isn't an actual resource, continue on 1699: if (!ref($curRes)) { 1700: next; 1701: } 1702: 1703: # If this has been filtered out, continue on 1704: if (!(&$filterFunc($curRes))) { 1705: $args->{'isNewBranch'} = 0; # Don't falsely remember this 1706: next; 1707: } 1708: 1709: # If this is an empty sequence and we're filtering them, continue on 1710: if ($curRes->is_map() && $args->{'suppressEmptySequences'} && 1711: !$curRes->{DATA}->{HAS_VISIBLE_CHILDREN}) { 1712: next; 1713: } 1714: 1715: # If we're suppressing navmaps and this is a navmap, continue on 1716: if ($suppressNavmap && $curRes->src() =~ /^\/adm\/navmaps/) { 1717: next; 1718: } 1719: 1720: $args->{'counter'}++; 1721: 1722: # Does it have multiple parts? 1723: $args->{'multipart'} = 0; 1724: $args->{'condensed'} = 0; 1725: my @parts; 1726: 1727: # Decide what parts to show. 1728: if ($curRes->is_problem() && $showParts) { 1729: @parts = @{$curRes->parts()}; 1730: $args->{'multipart'} = $curRes->multipart(); 1731: 1732: if ($condenseParts) { # do the condensation 1733: if (!$args->{'condensed'}) { 1734: # Decide whether to condense based on similarity 1735: my $status = $curRes->status($parts[0]); 1736: my $due = $curRes->duedate($parts[0]); 1737: my $open = $curRes->opendate($parts[0]); 1738: my $statusAllSame = 1; 1739: my $dueAllSame = 1; 1740: my $openAllSame = 1; 1741: for (my $i = 1; $i < scalar(@parts); $i++) { 1742: if ($curRes->status($parts[$i]) != $status){ 1743: $statusAllSame = 0; 1744: } 1745: if ($curRes->duedate($parts[$i]) != $due ) { 1746: $dueAllSame = 0; 1747: } 1748: if ($curRes->opendate($parts[$i]) != $open) { 1749: $openAllSame = 0; 1750: } 1751: } 1752: # $*allSame is true if all the statuses were 1753: # the same. Now, if they are all the same and 1754: # match one of the statuses to condense, or they 1755: # are all open with the same due date, or they are 1756: # all OPEN_LATER with the same open date, display the 1757: # status of the first non-zero part (to get the 'correct' 1758: # status right, since 0 is never 'correct' or 'open'). 1759: if (($statusAllSame && defined($condenseStatuses{$status})) || 1760: ($dueAllSame && $status == $curRes->OPEN && $statusAllSame)|| 1761: ($openAllSame && $status == $curRes->OPEN_LATER && $statusAllSame) ){ 1762: @parts = ($parts[0]); 1763: $args->{'condensed'} = 1; 1764: } 1765: } 1766: # Multipart problem with one part: always "condense" (happens 1767: # to match the desirable behavior) 1768: if ($curRes->countParts() == 1) { 1769: @parts = ($parts[0]); 1770: $args->{'condensed'} = 1; 1771: } 1772: } 1773: } 1774: 1775: # If the multipart problem was condensed, "forget" it was multipart 1776: if (scalar(@parts) == 1) { 1777: $args->{'multipart'} = 0; 1778: } else { 1779: # Add part 0 so we display it correctly. 1780: unshift @parts, '0'; 1781: } 1782: 1783: { 1784: my ($src,$symb,$anchor,$stack); 1785: if ($args->{'sort'}) { 1786: my $it = $navmap->getIterator(undef, undef, undef, 1); 1787: while ( my $res=$it->next()) { 1788: if (ref($res) && 1789: $res->symb() eq $curRes->symb()) { last; } 1790: } 1791: $stack=$it->getStack(); 1792: } else { 1793: $stack=$it->getStack(); 1794: } 1795: ($src,$symb,$anchor)=getLinkForResource($stack); 1796: if (defined($anchor)) { $anchor='#'.$anchor; } 1797: my $srcHasQuestion = $src =~ /\?/; 1798: $args->{"resourceLink"} = $src. 1799: ($srcHasQuestion?'&':'?') . 1800: 'symb=' . &escape($symb).$anchor; 1801: } 1802: # Now, we've decided what parts to show. Loop through them and 1803: # show them. 1804: foreach my $part (@parts) { 1805: $rownum ++; 1806: 1807: $result .= &Apache::loncommon::start_data_table_row(); 1808: 1809: # Set up some data about the parts that the cols might want 1810: my $filter = $it->{FILTER}; 1811: 1812: # Now, display each column. 1813: foreach my $col (@$cols) { 1814: my $colHTML = ''; 1815: if (ref($col)) { 1816: $colHTML .= &$col($curRes, $part, $args); 1817: } else { 1818: $colHTML .= &{$preparedColumns[$col]}($curRes, $part, $args); 1819: } 1820: 1821: # If this is the first column and it's time to print 1822: # the anchor, do so 1823: if ($col == $cols->[0] && 1824: $args->{'counter'} == $args->{'currentJumpIndex'} - 1825: $currentJumpDelta) { 1826: # Jam the anchor after the <td> tag; 1827: # necessary for valid HTML (which Mozilla requires) 1828: $colHTML =~ s/\>/\>\<a name="curloc" \/\>/; 1829: $displayedJumpMarker = 1; 1830: } 1831: $result .= $colHTML . "\n"; 1832: } 1833: $result .= &Apache::loncommon::end_data_table_row(); 1834: $args->{'isNewBranch'} = 0; 1835: } 1836: 1837: if ($r && $rownum % 20 == 0) { 1838: $r->print($result); 1839: $result = ""; 1840: $r->rflush(); 1841: } 1842: } continue { 1843: if ($r) { 1844: # If we have the connection, make sure the user is still connected 1845: my $c = $r->connection; 1846: if ($c->aborted()) { 1847: # Who cares what we do, nobody will see it anyhow. 1848: return ''; 1849: } 1850: } 1851: } 1852: 1853: $result.=&Apache::loncommon::end_data_table(); 1854: 1855: # Print out the part that jumps to #curloc if it exists 1856: # delay needed because the browser is processing the jump before 1857: # it finishes rendering, so it goes to the wrong place! 1858: # onload might be better, but this routine has no access to that. 1859: # On mozilla, the 0-millisecond timeout seems to prevent this; 1860: # it's quite likely this might fix other browsers, too, and 1861: # certainly won't hurt anything. 1862: if ($displayedJumpMarker) { 1863: $result .= &Apache::lonhtmlcommon::scripttag(" 1864: if (location.href.indexOf('#curloc')==-1) { 1865: setTimeout(\"location += '#curloc';\", 0) 1866: } 1867: "); 1868: } 1869: 1870: if ($r) { 1871: $r->print($result); 1872: $result = ""; 1873: $r->rflush(); 1874: } 1875: 1876: return $result; 1877: } 1878: 1879: sub add_linkitem { 1880: my ($linkitems,$name,$cmd,$text)=@_; 1881: $$linkitems{$name}{'cmd'}=$cmd; 1882: $$linkitems{$name}{'text'}=&mt($text); 1883: } 1884: 1885: sub show_linkitems_toolbar { 1886: my ($args,$condition) = @_; 1887: my $result; 1888: if (ref($args) eq 'HASH') { 1889: if (ref($args->{'linkitems'}) eq 'HASH') { 1890: my $numlinks = scalar(keys(%{$args->{'linkitems'}})); 1891: if ($numlinks > 1) { 1892: $result = '<td>'. 1893: &Apache::loncommon::help_open_menu('Navigation Screen','Navigation_Screen', 1894: undef,'RAT'). 1895: '</td>'. 1896: '<td> </td>'. 1897: '<td class="LC_middle">'.&mt('Tools:').'</td>'; 1898: } 1899: $result .= '<td align="left">'."\n". 1900: '<ul id="LC_toolbar">'; 1901: my @linkorder = ('firsthomework','everything','uncompleted', 1902: 'changefolder','clearbubbles','edittoplevel'); 1903: foreach my $link (@linkorder) { 1904: if (ref($args->{'linkitems'}{$link}) eq 'HASH') { 1905: if ($args->{'linkitems'}{$link}{'text'} ne '') { 1906: $args->{'linkitems'}{$link}{'cmd'}=~s/"/'/g; 1907: if ($args->{'linkitems'}{$link}{'cmd'}) { 1908: my $link_id = 'LC_content_toolbar_'.$link; 1909: if ($link eq 'changefolder') { 1910: if ($condition) { 1911: $link_id='LC_content_toolbar_changefolder_toggled'; 1912: } else { 1913: $link_id='LC_content_toolbar_changefolder'; 1914: } 1915: } 1916: $result .= '<li><a href="#" '. 1917: 'onclick="'.$args->{'linkitems'}{$link}{'cmd'}.'" '. 1918: 'id="'.$link_id.'" '. 1919: 'class="LC_toolbarItem" '. 1920: 'title="'.$args->{'linkitems'}{$link}{'text'}.'">'. 1921: '</a></li>'."\n"; 1922: } 1923: } 1924: } 1925: } 1926: $result .= '</ul>'. 1927: '</td>'; 1928: if (($numlinks==1) && (exists($args->{'linkitems'}{'edittoplevel'}))) { 1929: $result .= '<td><a href="'.$args->{'linkitems'}{'edittoplevel'}{'cmd'}.'">'. 1930: &mt('Content Editor').'</a></td>'; 1931: } 1932: } 1933: if ($args->{'sort_html'}) { 1934: $result .= '<td> </td><td> </td><td> </td>'. 1935: '<td align="right">'.$args->{'sort_html'}.'</td>'; 1936: } 1937: } 1938: if ($result) { 1939: $result = "<table><tr>$result</tr></table>"; 1940: } 1941: return $result; 1942: } 1943: 1944: 1; 1945: 1946: 1947: 1948: 1949: 1950: 1951: 1952: 1953: 1954: package Apache::lonnavmaps::navmap; 1955: 1956: =pod 1957: 1958: =head1 Object: Apache::lonnavmaps::navmap 1959: 1960: =head2 Overview 1961: 1962: The navmap object's job is to provide access to the resources 1963: in the course as Apache::lonnavmaps::resource objects, and to 1964: query and manage the relationship between those resource objects. 1965: 1966: Generally, you'll use the navmap object in one of three basic ways. 1967: In order of increasing complexity and power: 1968: 1969: =over 4 1970: 1971: =item * C<$navmap-E<gt>getByX>, where X is B<Id>, B<Symb> or B<MapPc> and getResourceByUrl. This provides 1972: various ways to obtain resource objects, based on various identifiers. 1973: Use this when you want to request information about one object or 1974: a handful of resources you already know the identities of, from some 1975: other source. For more about Ids, Symbs, and MapPcs, see the 1976: Resource documentation. Note that Url should be a B<last resort>, 1977: not your first choice; it only really works when there is only one 1978: instance of the resource in the course, which only applies to 1979: maps, and even that may change in the future (see the B<getResourceByUrl> 1980: documentation for more details.) 1981: 1982: =item * C<my @resources = $navmap-E<gt>retrieveResources(args)>. This 1983: retrieves resources matching some criterion and returns them 1984: in a flat array, with no structure information. Use this when 1985: you are manipulating a series of resources, based on what map 1986: the are in, but do not care about branching, or exactly how 1987: the maps and resources are related. This is the most common case. 1988: 1989: =item * C<$it = $navmap-E<gt>getIterator(args)>. This allows you traverse 1990: the course's navmap in various ways without writing the traversal 1991: code yourself. See iterator documentation below. Use this when 1992: you need to know absolutely everything about the course, including 1993: branches and the precise relationship between maps and resources. 1994: 1995: =back 1996: 1997: =head2 Creation And Destruction 1998: 1999: To create a navmap object, use the following function: 2000: 2001: =over 4 2002: 2003: =item * B<Apache::lonnavmaps::navmap-E<gt>new>(): 2004: 2005: Creates a new navmap object. Returns the navmap object if this is 2006: successful, or B<undef> if not. 2007: 2008: =back 2009: 2010: =head2 Methods 2011: 2012: =over 4 2013: 2014: =item * B<getIterator>(first, finish, filter, condition): 2015: 2016: See iterator documentation below. 2017: 2018: =cut 2019: 2020: use strict; 2021: use GDBM_File; 2022: use Apache::lonnet; 2023: use LONCAPA; 2024: 2025: sub new { 2026: # magic invocation to create a class instance 2027: my $proto = shift; 2028: my $class = ref($proto) || $proto; 2029: my $self = {}; 2030: bless($self); # So we can call change_user if necessary 2031: 2032: $self->{USERNAME} = shift || $env{'user.name'}; 2033: $self->{DOMAIN} = shift || $env{'user.domain'}; 2034: $self->{CODE} = shift; 2035: $self->{NOHIDE} = shift; 2036: 2037: 2038: 2039: # Resource cache stores navmap resources as we reference them. We generate 2040: # them on-demand so we don't pay for creating resources unless we use them. 2041: $self->{RESOURCE_CACHE} = {}; 2042: 2043: # Network failure flag, if we accessed the course or user opt and 2044: # failed 2045: $self->{NETWORK_FAILURE} = 0; 2046: 2047: # We can only tie the nav hash as done below if the username/domain 2048: # match the env one. Otherwise change_user does everything we need...since we can't 2049: # assume there are course hashes for the specific requested user:domain 2050: # Note: change_user is also called if we need the nav hash when printing CODEd 2051: # assignments or printing an exam, in which the enclosing folder for the items in 2052: # the exam has hidden set. 2053: # 2054: 2055: if (($self->{USERNAME} eq $env{'user.name'}) && ($self->{DOMAIN} eq $env{'user.domain'}) && 2056: !$self->{CODE} && !$self->{NOHIDE}) { 2057: 2058: # tie the nav hash 2059: 2060: my %navmaphash; 2061: my %parmhash; 2062: my $courseFn = $env{"request.course.fn"}; 2063: if (!(tie(%navmaphash, 'GDBM_File', "${courseFn}.db", 2064: &GDBM_READER(), 0640))) { 2065: return undef; 2066: } 2067: 2068: if (!(tie(%parmhash, 'GDBM_File', "${courseFn}_parms.db", 2069: &GDBM_READER(), 0640))) 2070: { 2071: untie %{$self->{PARM_HASH}}; 2072: return undef; 2073: } 2074: 2075: $self->{NAV_HASH} = \%navmaphash; 2076: $self->{PARM_HASH} = \%parmhash; 2077: $self->{PARM_CACHE} = {}; 2078: } else { 2079: $self->change_user($self->{USERNAME}, $self->{DOMAIN}, $self->{CODE}, $self->{NOHIDE}); 2080: } 2081: 2082: return $self; 2083: } 2084: 2085: # 2086: # In some instances it is useful to be able to dynamically change the 2087: # username/domain associated with a navmap (e.g. to navigate for someone 2088: # else besides the current user...if sufficiently privileged. 2089: # Parameters: 2090: # user - New user. 2091: # domain- Domain the user belongs to. 2092: # code - Anonymous CODE in use. 2093: # Implicit inputs: 2094: # 2095: sub change_user { 2096: my $self = shift; 2097: $self->{USERNAME} = shift; 2098: $self->{DOMAIN} = shift; 2099: $self->{CODE} = shift; 2100: $self->{NOHIDE} = shift; 2101: 2102: # If the hashes are already tied make sure to break that bond: 2103: 2104: untie %{$self->{NAV_HASH}}; 2105: untie %{$self->{PARM_HASH}}; 2106: 2107: # The assumption is that we have to 2108: # use lonmap here to re-read the hash and from it reconstruct 2109: # new big and parameter hashes. An implicit assumption at this time 2110: # is that the course file is probably not created locally yet 2111: # an that we will therefore just read without tying. 2112: 2113: my ($cdom, $cnum) = split(/\_/, $env{'request.course.id'}); 2114: 2115: my %big_hash; 2116: &Apache::lonmap::loadmap($cnum, $cdom, $self->{USERNAME}, $self->{DOMAIN}, $self->{CODE}, $self->{NOHIDE}, \%big_hash); 2117: $self->{NAV_HASH} = \%big_hash; 2118: 2119: 2120: 2121: # Now clear the parm cache and reconstruct the parm hash fromt he big_hash 2122: # param.xxxx keys. 2123: 2124: $self->{PARM_CACHE} = {}; 2125: 2126: my %parm_hash = {}; 2127: foreach my $key (keys(%big_hash)) { 2128: if ($key =~ /^param\./) { 2129: my $param_key = $key; 2130: $param_key =~ s/^param\.//; 2131: $parm_hash{$param_key} = $big_hash{$key}; 2132: } 2133: } 2134: 2135: $self->{PARM_HASH} = \%parm_hash; 2136: 2137: } 2138: 2139: sub generate_course_user_opt { 2140: my $self = shift; 2141: if ($self->{COURSE_USER_OPT_GENERATED}) { return; } 2142: 2143: my $uname=$self->{USERNAME}; 2144: my $udom=$self->{DOMAIN}; 2145: 2146: my $cid=$env{'request.course.id'}; 2147: my $cdom=$env{'course.'.$cid.'.domain'}; 2148: my $cnum=$env{'course.'.$cid.'.num'}; 2149: 2150: # ------------------------------------------------- Get coursedata (if present) 2151: my $courseopt=&Apache::lonnet::get_courseresdata($cnum,$cdom); 2152: # Check for network failure 2153: if (!ref($courseopt)) { 2154: if ( $courseopt =~ /no.such.host/i || $courseopt =~ /con_lost/i) { 2155: $self->{NETWORK_FAILURE} = 1; 2156: } 2157: undef($courseopt); 2158: } 2159: 2160: # --------------------------------------------------- Get userdata (if present) 2161: 2162: my $useropt=&Apache::lonnet::get_userresdata($uname,$udom); 2163: # Check for network failure 2164: if (!ref($useropt)) { 2165: if ( $useropt =~ /no.such.host/i || $useropt =~ /con_lost/i) { 2166: $self->{NETWORK_FAILURE} = 1; 2167: } 2168: undef($useropt); 2169: } 2170: 2171: $self->{COURSE_OPT} = $courseopt; 2172: $self->{USER_OPT} = $useropt; 2173: 2174: $self->{COURSE_USER_OPT_GENERATED} = 1; 2175: 2176: return; 2177: } 2178: 2179: 2180: 2181: sub generate_email_discuss_status { 2182: my $self = shift; 2183: my $symb = shift; 2184: if ($self->{EMAIL_DISCUSS_GENERATED}) { return; } 2185: 2186: my $cid=$env{'request.course.id'}; 2187: my $cdom=$env{'course.'.$cid.'.domain'}; 2188: my $cnum=$env{'course.'.$cid.'.num'}; 2189: 2190: my %emailstatus = &Apache::lonnet::dump('email_status',$self->{DOMAIN},$self->{USERNAME}); 2191: my $logoutTime = $emailstatus{'logout'}; 2192: my $courseLeaveTime = $emailstatus{'logout_'.$env{'request.course.id'}}; 2193: $self->{LAST_CHECK} = (($courseLeaveTime > $logoutTime) ? 2194: $courseLeaveTime : $logoutTime); 2195: my %discussiontime = &Apache::lonnet::dump('discussiontimes', 2196: $cdom, $cnum); 2197: my %lastread = &Apache::lonnet::dump('nohist_'.$cid.'_discuss', 2198: $self->{DOMAIN},$self->{USERNAME},'lastread'); 2199: my %lastreadtime = (); 2200: foreach my $key (keys(%lastread)) { 2201: my $shortkey = $key; 2202: $shortkey =~ s/_lastread$//; 2203: $lastreadtime{$shortkey} = $lastread{$key}; 2204: } 2205: 2206: my %feedback=(); 2207: my %error=(); 2208: my @keys = &Apache::lonnet::getkeys('nohist_email',$self->{DOMAIN}, 2209: $self->{USERNAME}); 2210: 2211: foreach my $msgid (@keys) { 2212: if ((!$emailstatus{$msgid}) || ($emailstatus{$msgid} eq 'new')) { 2213: my ($sendtime,$shortsubj,$fromname,$fromdomain,$status,$fromcid, 2214: $symb,$error) = &Apache::lonmsg::unpackmsgid($msgid); 2215: &Apache::lonenc::check_decrypt(\$symb); 2216: if (($fromcid ne '') && ($fromcid ne $cid)) { 2217: next; 2218: } 2219: if (defined($symb)) { 2220: if (defined($error) && $error == 1) { 2221: $error{$symb}.=','.$msgid; 2222: } else { 2223: $feedback{$symb}.=','.$msgid; 2224: } 2225: } else { 2226: my $plain= 2227: &LONCAPA::unescape(&LONCAPA::unescape($msgid)); 2228: if ($plain=~/ \[([^\]]+)\]\:/) { 2229: my $url=$1; 2230: if ($plain=~/\:Error \[/) { 2231: $error{$url}.=','.$msgid; 2232: } else { 2233: $feedback{$url}.=','.$msgid; 2234: } 2235: } 2236: } 2237: } 2238: } 2239: 2240: #symbs of resources that have feedbacks (will be urls pre-2.3) 2241: $self->{FEEDBACK} = \%feedback; 2242: #or errors (will be urls pre 2.3) 2243: $self->{ERROR_MSG} = \%error; 2244: $self->{DISCUSSION_TIME} = \%discussiontime; 2245: $self->{EMAIL_STATUS} = \%emailstatus; 2246: $self->{LAST_READ} = \%lastreadtime; 2247: 2248: $self->{EMAIL_DISCUSS_GENERATED} = 1; 2249: } 2250: 2251: sub get_user_data { 2252: my $self = shift; 2253: if ($self->{RETRIEVED_USER_DATA}) { return; } 2254: 2255: # Retrieve performance data on problems 2256: my %student_data = Apache::lonnet::currentdump($env{'request.course.id'}, 2257: $self->{DOMAIN}, 2258: $self->{USERNAME}); 2259: $self->{STUDENT_DATA} = \%student_data; 2260: 2261: $self->{RETRIEVED_USER_DATA} = 1; 2262: } 2263: 2264: sub get_discussion_data { 2265: my $self = shift; 2266: if ($self->{RETRIEVED_DISCUSSION_DATA}) { 2267: return $self->{DISCUSSION_DATA}; 2268: } 2269: 2270: $self->generate_email_discuss_status(); 2271: 2272: my $cid=$env{'request.course.id'}; 2273: my $cdom=$env{'course.'.$cid.'.domain'}; 2274: my $cnum=$env{'course.'.$cid.'.num'}; 2275: # Retrieve discussion data for resources in course 2276: my %discussion_data = &Apache::lonnet::dumpstore($cid,$cdom,$cnum); 2277: 2278: 2279: $self->{DISCUSSION_DATA} = \%discussion_data; 2280: $self->{RETRIEVED_DISCUSSION_DATA} = 1; 2281: return $self->{DISCUSSION_DATA}; 2282: } 2283: 2284: 2285: # Internal function: Takes a key to look up in the nav hash and implements internal 2286: # memory caching of that key. 2287: sub navhash { 2288: my $self = shift; my $key = shift; 2289: return $self->{NAV_HASH}->{$key}; 2290: } 2291: 2292: =pod 2293: 2294: =item * B<courseMapDefined>(): Returns true if the course map is defined, 2295: false otherwise. Undefined course maps indicate an error somewhere in 2296: LON-CAPA, and you will not be able to proceed with using the navmap. 2297: See the B<NAV> screen for an example of using this. 2298: 2299: =cut 2300: 2301: # Checks to see if coursemap is defined, matching test in old lonnavmaps 2302: sub courseMapDefined { 2303: my $self = shift; 2304: my $uri = &Apache::lonnet::clutter($env{'request.course.uri'}); 2305: 2306: my $firstres = $self->navhash("map_start_$uri"); 2307: my $lastres = $self->navhash("map_finish_$uri"); 2308: return $firstres && $lastres; 2309: } 2310: 2311: sub getIterator { 2312: my $self = shift; 2313: my $iterator = Apache::lonnavmaps::iterator->new($self, shift, shift, 2314: shift, undef, shift, 2315: shift, shift); 2316: return $iterator; 2317: } 2318: 2319: # Private method: Does the given resource (as a symb string) have 2320: # current discussion? Returns 0 if chat/mail data not extracted. 2321: sub hasDiscussion { 2322: my $self = shift; 2323: my $symb = shift; 2324: $self->generate_email_discuss_status(); 2325: 2326: if (!defined($self->{DISCUSSION_TIME})) { return 0; } 2327: 2328: #return defined($self->{DISCUSSION_TIME}->{$symb}); 2329: 2330: # backward compatibility (bulletin boards used to be 'wrapped') 2331: my $ressymb = $self->wrap_symb($symb); 2332: if ( defined ( $self->{LAST_READ}->{$ressymb} ) ) { 2333: return $self->{DISCUSSION_TIME}->{$ressymb} > $self->{LAST_READ}->{$ressymb}; 2334: } else { 2335: # return $self->{DISCUSSION_TIME}->{$ressymb} > $self->{LAST_CHECK}; # v.1.1 behavior 2336: return $self->{DISCUSSION_TIME}->{$ressymb} > 0; # in 1.2 will display speech bubble icons for all items with posts until marked as read (even if read in v 1.1). 2337: } 2338: } 2339: 2340: sub last_post_time { 2341: my $self = shift; 2342: my $symb = shift; 2343: my $ressymb = $self->wrap_symb($symb); 2344: return $self->{DISCUSSION_TIME}->{$ressymb}; 2345: } 2346: 2347: sub discussion_info { 2348: my $self = shift; 2349: my $symb = shift; 2350: my $filter = shift; 2351: 2352: $self->get_discussion_data(); 2353: 2354: my $ressymb = $self->wrap_symb($symb); 2355: # keys used to store bulletinboard postings use 'unwrapped' symb. 2356: my $discsymb = &escape($self->unwrap_symb($ressymb)); 2357: my $version = $self->{DISCUSSION_DATA}{'version:'.$discsymb}; 2358: if (!$version) { return; } 2359: 2360: my $prevread = $self->{LAST_READ}{$ressymb}; 2361: 2362: my $count = 0; 2363: my $hiddenflag = 0; 2364: my $deletedflag = 0; 2365: my ($hidden,$deleted,%info); 2366: 2367: for (my $id=$version; $id>0; $id--) { 2368: my $vkeys=$self->{DISCUSSION_DATA}{$id.':keys:'.$discsymb}; 2369: my @keys=split(/:/,$vkeys); 2370: if (grep(/^hidden$/ ,@keys)) { 2371: if (!$hiddenflag) { 2372: $hidden = $self->{DISCUSSION_DATA}{$id.':'.$discsymb.':hidden'}; 2373: $hiddenflag = 1; 2374: } 2375: } elsif (grep(/^deleted$/,@keys)) { 2376: if (!$deletedflag) { 2377: $deleted = $self->{DISCUSSION_DATA}{$id.':'.$discsymb.':deleted'}; 2378: $deletedflag = 1; 2379: } 2380: } else { 2381: if (($hidden !~/\.$id\./) && ($deleted !~/\.$id\./)) { 2382: if ($filter eq 'unread') { 2383: if ($prevread >= $self->{DISCUSSION_DATA}{$id.':'.$discsymb.':timestamp'}) { 2384: next; 2385: } 2386: } 2387: $count++; 2388: $info{$count}{'subject'} = 2389: $self->{DISCUSSION_DATA}{$id.':'.$discsymb.':subject'}; 2390: $info{$count}{'id'} = $id; 2391: $info{$count}{'timestamp'} = $self->{DISCUSSION_DATA}{$id.':'.$discsymb.':timestamp'}; 2392: } 2393: } 2394: } 2395: if (wantarray) { 2396: return ($count,%info); 2397: } 2398: return $count; 2399: } 2400: 2401: sub wrap_symb { 2402: my $self = shift; 2403: my $symb = shift; 2404: if ($symb =~ m-___(adm/[^/]+/[^/]+/)(\d+)(/bulletinboard)$-) { 2405: unless ($symb =~ m|adm/wrapper/adm|) { 2406: $symb = 'bulletin___'.$2.'___adm/wrapper/'.$1.$2.$3; 2407: } 2408: } 2409: return $symb; 2410: } 2411: 2412: sub unwrap_symb { 2413: my $self = shift; 2414: my $ressymb = shift; 2415: my $discsymb = $ressymb; 2416: if ($ressymb =~ m-^(bulletin___\d+___)adm/wrapper/(adm/[^/]+/[^/]+/\d+/bulletinboard)$-) { 2417: $discsymb = $1.$2; 2418: } 2419: return $discsymb; 2420: } 2421: 2422: # Private method: Does the given resource (as a symb string) have 2423: # current feedback? Returns the string in the feedback hash, which 2424: # will be false if it does not exist. 2425: 2426: sub getFeedback { 2427: my $self = shift; 2428: my $symb = shift; 2429: my $source = shift; 2430: 2431: $self->generate_email_discuss_status(); 2432: 2433: if (!defined($self->{FEEDBACK})) { return ""; } 2434: 2435: my $feedback; 2436: if ($self->{FEEDBACK}->{$symb}) { 2437: $feedback = $self->{FEEDBACK}->{$symb}; 2438: if ($self->{FEEDBACK}->{$source}) { 2439: $feedback .= ','.$self->{FEEDBACK}->{$source}; 2440: } 2441: } else { 2442: if ($self->{FEEDBACK}->{$source}) { 2443: $feedback = $self->{FEEDBACK}->{$source}; 2444: } 2445: } 2446: return $feedback; 2447: } 2448: 2449: # Private method: Get the errors for that resource (by source). 2450: sub getErrors { 2451: my $self = shift; 2452: my $symb = shift; 2453: my $src = shift; 2454: 2455: $self->generate_email_discuss_status(); 2456: 2457: if (!defined($self->{ERROR_MSG})) { return ""; } 2458: 2459: my $errors; 2460: if ($self->{ERROR_MSG}->{$symb}) { 2461: $errors = $self->{ERROR_MSG}->{$symb}; 2462: if ($self->{ERROR_MSG}->{$src}) { 2463: $errors .= ','.$self->{ERROR_MSG}->{$src}; 2464: } 2465: } else { 2466: if ($self->{ERROR_MSG}->{$src}) { 2467: $errors = $self->{ERROR_MSG}->{$src}; 2468: } 2469: } 2470: return $errors; 2471: } 2472: 2473: =pod 2474: 2475: =item * B<getById>(id): 2476: 2477: Based on the ID of the resource (1.1, 3.2, etc.), get a resource 2478: object for that resource. This method, or other methods that use it 2479: (as in the resource object) is the only proper way to obtain a 2480: resource object. 2481: 2482: =item * B<getBySymb>(symb): 2483: 2484: Based on the symb of the resource, get a resource object for that 2485: resource. This is one of the proper ways to get a resource object. 2486: 2487: =item * B<getByMapPc>(map_pc): 2488: 2489: Based on the map_pc of the resource, get a resource object for 2490: the given map. This is one of the proper ways to get a resource object. 2491: 2492: =cut 2493: 2494: # The strategy here is to cache the resource objects, and only construct them 2495: # as we use them. The real point is to prevent reading any more from the tied 2496: # hash than we have to, which should hopefully alleviate speed problems. 2497: 2498: sub getById { 2499: my $self = shift; 2500: my $id = shift; 2501: 2502: if (defined ($self->{RESOURCE_CACHE}->{$id})) 2503: { 2504: return $self->{RESOURCE_CACHE}->{$id}; 2505: } 2506: 2507: # resource handles inserting itself into cache. 2508: # Not clear why the quotes are necessary, but as of this 2509: # writing it doesn't work without them. 2510: return "Apache::lonnavmaps::resource"->new($self, $id); 2511: } 2512: 2513: sub getBySymb { 2514: my $self = shift; 2515: my $symb = shift; 2516: 2517: my ($mapUrl, $id, $filename) = &Apache::lonnet::decode_symb($symb); 2518: my $map = $self->getResourceByUrl($mapUrl); 2519: my $returnvalue = undef; 2520: if (ref($map)) { 2521: $returnvalue = $self->getById($map->map_pc() .'.'.$id); 2522: } 2523: return $returnvalue; 2524: } 2525: 2526: sub getByMapPc { 2527: my $self = shift; 2528: my $map_pc = shift; 2529: my $map_id = $self->{NAV_HASH}->{'map_id_' . $map_pc}; 2530: $map_id = $self->{NAV_HASH}->{'ids_' . $map_id}; 2531: return $self->getById($map_id); 2532: } 2533: 2534: =pod 2535: 2536: =item * B<firstResource>(): 2537: 2538: Returns a resource object reference corresponding to the first 2539: resource in the navmap. 2540: 2541: =cut 2542: 2543: sub firstResource { 2544: my $self = shift; 2545: my $firstResource = $self->navhash('map_start_' . 2546: &Apache::lonnet::clutter($env{'request.course.uri'})); 2547: return $self->getById($firstResource); 2548: } 2549: 2550: =pod 2551: 2552: =item * B<finishResource>(): 2553: 2554: Returns a resource object reference corresponding to the last resource 2555: in the navmap. 2556: 2557: =cut 2558: 2559: sub finishResource { 2560: my $self = shift; 2561: my $firstResource = $self->navhash('map_finish_' . 2562: &Apache::lonnet::clutter($env{'request.course.uri'})); 2563: return $self->getById($firstResource); 2564: } 2565: 2566: # Parmval reads the parm hash and cascades the lookups. parmval_real does 2567: # the actual lookup; parmval caches the results. 2568: sub parmval { 2569: my $self = shift; 2570: my ($what,$symb,$recurse)=@_; 2571: my $hashkey = $what."|||".$symb; 2572: my $cache = $self->{PARM_CACHE}; 2573: if (defined($self->{PARM_CACHE}->{$hashkey})) { 2574: if (ref($self->{PARM_CACHE}->{$hashkey}) eq 'ARRAY') { 2575: if (defined($self->{PARM_CACHE}->{$hashkey}->[0])) { 2576: if (wantarray) { 2577: return @{$self->{PARM_CACHE}->{$hashkey}}; 2578: } else { 2579: return $self->{PARM_CACHE}->{$hashkey}->[0]; 2580: } 2581: } 2582: } else { 2583: return $self->{PARM_CACHE}->{$hashkey}; 2584: } 2585: } 2586: my $result = $self->parmval_real($what, $symb, $recurse); 2587: $self->{PARM_CACHE}->{$hashkey} = $result; 2588: if (wantarray) { 2589: return @{$result}; 2590: } 2591: return $result->[0]; 2592: } 2593: 2594: 2595: sub parmval_real { 2596: my $self = shift; 2597: my ($what,$symb,$recurse) = @_; 2598: 2599: 2600: # Make sure the {USER_OPT} and {COURSE_OPT} hashes are populated 2601: $self->generate_course_user_opt(); 2602: 2603: my $cid=$env{'request.course.id'}; 2604: my $csec=$env{'request.course.sec'}; 2605: my $cgroup=''; 2606: my @cgrps=split(/:/,$env{'request.course.groups'}); 2607: if (@cgrps > 0) { 2608: @cgrps = sort(@cgrps); 2609: $cgroup = $cgrps[0]; 2610: } 2611: my $uname=$self->{USERNAME}; 2612: my $udom=$self->{DOMAIN}; 2613: 2614: unless ($symb) { return ['']; } 2615: my $result=''; 2616: 2617: my ($mapname,$id,$fn)=&Apache::lonnet::decode_symb($symb); 2618: $mapname = &Apache::lonnet::deversion($mapname); 2619: # ----------------------------------------------------- Cascading lookup scheme 2620: my $rwhat=$what; 2621: $what=~s/^parameter\_//; 2622: $what=~s/\_/\./; 2623: 2624: my $symbparm=$symb.'.'.$what; 2625: my $mapparm=$mapname.'___(all).'.$what; 2626: my $usercourseprefix=$cid; 2627: 2628: 2629: 2630: my $grplevel=$usercourseprefix.'.['.$cgroup.'].'.$what; 2631: my $grplevelr=$usercourseprefix.'.['.$cgroup.'].'.$symbparm; 2632: my $grplevelm=$usercourseprefix.'.['.$cgroup.'].'.$mapparm; 2633: 2634: 2635: my $seclevel= $usercourseprefix.'.['.$csec.'].'.$what; 2636: my $seclevelr=$usercourseprefix.'.['.$csec.'].'.$symbparm; 2637: my $seclevelm=$usercourseprefix.'.['.$csec.'].'.$mapparm; 2638: 2639: 2640: my $courselevel= $usercourseprefix.'.'.$what; 2641: my $courselevelr=$usercourseprefix.'.'.$symbparm; 2642: my $courselevelm=$usercourseprefix.'.'.$mapparm; 2643: 2644: 2645: my $useropt = $self->{USER_OPT}; 2646: my $courseopt = $self->{COURSE_OPT}; 2647: my $parmhash = $self->{PARM_HASH}; 2648: 2649: # ---------------------------------------------------------- first, check user 2650: if ($uname and defined($useropt)) { 2651: if (defined($$useropt{$courselevelr})) { return [$$useropt{$courselevelr},'resource']; } 2652: if (defined($$useropt{$courselevelm})) { return [$$useropt{$courselevelm},'map']; } 2653: if (defined($$useropt{$courselevel})) { return [$$useropt{$courselevel},'course']; } 2654: } 2655: 2656: # ------------------------------------------------------- second, check course 2657: if ($cgroup ne '' and defined($courseopt)) { 2658: if (defined($$courseopt{$grplevelr})) { return [$$courseopt{$grplevelr},'resource']; } 2659: if (defined($$courseopt{$grplevelm})) { return [$$courseopt{$grplevelm},'map']; } 2660: if (defined($$courseopt{$grplevel})) { return [$$courseopt{$grplevel},'course']; } 2661: } 2662: 2663: if ($csec and defined($courseopt)) { 2664: if (defined($$courseopt{$seclevelr})) { return [$$courseopt{$seclevelr},'resource']; } 2665: if (defined($$courseopt{$seclevelm})) { return [$$courseopt{$seclevelm},'map']; } 2666: if (defined($$courseopt{$seclevel})) { return [$$courseopt{$seclevel},'course']; } 2667: } 2668: 2669: if (defined($courseopt)) { 2670: if (defined($$courseopt{$courselevelr})) { return [$$courseopt{$courselevelr},'resource']; } 2671: } 2672: 2673: # ----------------------------------------------------- third, check map parms 2674: 2675: my $thisparm=$$parmhash{$symbparm}; 2676: if (defined($thisparm)) { return [$thisparm,'map']; } 2677: 2678: # ----------------------------------------------------- fourth , check default 2679: 2680: my $meta_rwhat=$rwhat; 2681: $meta_rwhat=~s/\./_/g; 2682: my $default=&Apache::lonnet::metadata($fn,$meta_rwhat); 2683: if (defined($default)) { return [$default,'resource']} 2684: $default=&Apache::lonnet::metadata($fn,'parameter_'.$meta_rwhat); 2685: if (defined($default)) { return [$default,'resource']} 2686: # --------------------------------------------------- fifth, check more course 2687: if (defined($courseopt)) { 2688: if (defined($$courseopt{$courselevelm})) { return [$$courseopt{$courselevelm},'map']; } 2689: if (defined($$courseopt{$courselevel})) { 2690: my $ret = [$$courseopt{$courselevel},'course']; 2691: return $ret; 2692: } 2693: } 2694: # --------------------------------------------------- sixth , cascade up parts 2695: 2696: my ($space,@qualifier)=split(/\./,$rwhat); 2697: my $qualifier=join('.',@qualifier); 2698: unless ($space eq '0') { 2699: my @parts=split(/_/,$space); 2700: my $id=pop(@parts); 2701: my $part=join('_',@parts); 2702: if ($part eq '') { $part='0'; } 2703: my @partgeneral=$self->parmval($part.".$qualifier",$symb,1); 2704: if (defined($partgeneral[0])) { return \@partgeneral; } 2705: } 2706: if ($recurse) { return []; } 2707: my $pack_def=&Apache::lonnet::packages_tab_default($fn,'resource.'.$rwhat); 2708: if (defined($pack_def)) { return [$pack_def,'resource']; } 2709: return ['']; 2710: } 2711: # 2712: # Determines the open/close dates for printing a map that 2713: # encloses a resource. 2714: # 2715: sub map_printdates { 2716: my ($self, $res, $part) = @_; 2717: 2718: 2719: 2720: 2721: 2722: my $opendate = $self->get_mapparam($res->symb(), "$part.printstartdate"); 2723: my $closedate= $self->get_mapparam($res->symb(), "$part.printenddate"); 2724: 2725: 2726: return ($opendate, $closedate); 2727: } 2728: 2729: sub get_mapparam { 2730: my ($self, $symb, $what) = @_; 2731: 2732: # Ensure the course option hash is populated: 2733: 2734: $self->generate_course_user_opt(); 2735: 2736: # Get the course id and section if there is one. 2737: 2738: my $cid=$env{'request.course.id'}; 2739: my $csec=$env{'request.course.sec'}; 2740: my $cgroup=''; 2741: my @cgrps=split(/:/,$env{'request.course.groups'}); 2742: if (@cgrps > 0) { 2743: @cgrps = sort(@cgrps); 2744: $cgroup = $cgrps[0]; 2745: } 2746: my $uname=$self->{USERNAME}; 2747: my $udom=$self->{DOMAIN}; 2748: 2749: unless ($symb) { return ['']; } 2750: my $result=''; 2751: 2752: 2753: # Figure out which map we are in. 2754: 2755: my ($mapname,$id,$fn)=&Apache::lonnet::decode_symb($symb); 2756: $mapname = &Apache::lonnet::deversion($mapname); 2757: 2758: 2759: my $rwhat=$what; 2760: $what=~s/^parameter\_//; 2761: $what=~s/\_/\./; 2762: 2763: # Build the hash keys for the lookup: 2764: 2765: my $symbparm=$symb.'.'.$what; 2766: my $mapparm=$mapname.'___(all).'.$what; 2767: my $usercourseprefix=$cid; 2768: 2769: 2770: my $grplevel = "$usercourseprefix.[$cgroup].$mapparm"; 2771: my $seclevel = "$usercourseprefix.[$csec].$mapparm"; 2772: my $courselevel = "$usercourseprefix.$mapparm"; 2773: 2774: 2775: # Get handy references to the hashes we need in $self: 2776: 2777: my $useropt = $self->{USER_OPT}; 2778: my $courseopt = $self->{COURSE_OPT}; 2779: my $parmhash = $self->{PARM_HASH}; 2780: 2781: # Check per user 2782: 2783: 2784: 2785: if ($uname and defined($useropt)) { 2786: if (defined($$useropt{$courselevel})) { 2787: return $$useropt{$courselevel}; 2788: } 2789: } 2790: 2791: # Check course -- group 2792: 2793: 2794: 2795: if ($cgroup ne '' and defined ($courseopt)) { 2796: if (defined($$courseopt{$grplevel})) { 2797: return $$courseopt{$grplevel}; 2798: } 2799: } 2800: 2801: # Check course -- section 2802: 2803: 2804: 2805: 2806: 2807: if ($csec and defined($courseopt)) { 2808: if (defined($$courseopt{$seclevel})) { 2809: return $$courseopt{$seclevel}; 2810: } 2811: } 2812: # Check the map parameters themselves: 2813: 2814: my $thisparm = $$parmhash{$symbparm}; 2815: if (defined($thisparm)) { 2816: return $thisparm; 2817: } 2818: 2819: 2820: # Additional course parameters: 2821: 2822: if (defined($courseopt)) { 2823: if (defined($$courseopt{$courselevel})) { 2824: return $$courseopt{$courselevel}; 2825: } 2826: } 2827: return undef; # Unefined if we got here. 2828: } 2829: 2830: sub course_printdates { 2831: my ($self, $symb, $part) = @_; 2832: 2833: 2834: my $opendate = $self->getcourseparam($symb, $part . '.printstartdate'); 2835: my $closedate = $self->getcourseparam($symb, $part . '.printenddate'); 2836: return ($opendate, $closedate); 2837: 2838: } 2839: 2840: sub getcourseparam { 2841: my ($self, $symb, $what) = @_; 2842: 2843: $self->generate_course_user_opt(); # If necessary populate the hashes. 2844: 2845: my $uname = $self->{USERNAME}; 2846: my $udom = $self->{DOMAIN}; 2847: 2848: # Course, section, group ids come from the env: 2849: 2850: my $cid = $env{'request.course.id'}; 2851: my $csec = $env{'request.course.sec'}; 2852: my $cgroup = ''; # Assume no group 2853: 2854: my @cgroups = split(/:/, $env{'request.course.groups'}); 2855: if(@cgroups > 0) { 2856: @cgroups = sort(@cgroups); 2857: $cgroup = $cgroups[0]; # There is a course group. 2858: } 2859: my ($mapname,$id,$fn)=&Apache::lonnet::decode_symb($symb); 2860: $mapname = &Apache::lonnet::deversion($mapname); 2861: 2862: # 2863: # Make the various lookup keys: 2864: # 2865: 2866: $what=~s/^parameter\_//; 2867: $what=~s/\_/\./; 2868: 2869: 2870: my $symbparm = $symb . '.' . $what; 2871: my $mapparm=$mapname.'___(all).'.$what; 2872: 2873: # Local refs to the hashes we're going to look at: 2874: 2875: my $useropt = $self->{USER_OPT}; 2876: my $courseopt = $self->{COURSE_OPT}; 2877: 2878: # 2879: # We want the course level stuff from the way 2880: # parmval_real operates 2881: # TODO: Fator some of this stuff out of 2882: # both parmval_real and here 2883: # 2884: my $courselevel = $cid . '.' . $what; 2885: my $grplevel = $cid . '.[' . $cgroup . ']' . $what; 2886: my $seclevel = $cid . '.[' . $csec . ']' . $what; 2887: 2888: 2889: # Try for the user's course level option: 2890: 2891: if ($uname and defined($useropt)) { 2892: if (defined($$useropt{$courselevel})) { 2893: return $$useropt{$courselevel}; 2894: } 2895: } 2896: # Try for the group's course level option: 2897: 2898: if ($uname ne '' and defined($courseopt)) { 2899: if (defined($$courseopt{$grplevel})) { 2900: return $$courseopt{$grplevel}; 2901: } 2902: } 2903: 2904: # Try for section level parameters: 2905: 2906: if ($csec and defined($courseopt)) { 2907: if (defined($$courseopt{$seclevel})) { 2908: return $$courseopt{$seclevel}; 2909: } 2910: } 2911: # Try for 'additional' course parameterse: 2912: 2913: if (defined($courseopt)) { 2914: if (defined($$courseopt{$courselevel})) { 2915: return $$courseopt{$courselevel}; 2916: } 2917: } 2918: return undef; 2919: 2920: } 2921: 2922: 2923: =pod 2924: 2925: =item * B<getResourceByUrl>(url,multiple): 2926: 2927: Retrieves a resource object by URL of the resource, unless the optional 2928: multiple parameter is included in which case an array of resource 2929: objects is returned. If passed a resource object, it will simply return 2930: it, so it is safe to use this method in code like 2931: "$res = $navmap->getResourceByUrl($res)" 2932: if you're not sure if $res is already an object, or just a URL. If the 2933: resource appears multiple times in the course, only the first instance 2934: will be returned (useful for maps), unless the multiple parameter has 2935: been included, in which case all instances are returned in an array. 2936: 2937: =item * B<retrieveResources>(map, filterFunc, recursive, bailout, showall, noblockcheck): 2938: 2939: The map is a specification of a map to retreive the resources from, 2940: either as a url or as an object. The filterFunc is a reference to a 2941: function that takes a resource object as its one argument and returns 2942: true if the resource should be included, or false if it should not 2943: be. If recursive is true, the map will be recursively examined, 2944: otherwise it will not be. If bailout is true, the function will return 2945: as soon as it finds a resource, if false it will finish. If showall is 2946: true it will not hide maps that contain nothing but one other map. The 2947: noblockcheck arg is propagated to become the sixth arg in the call to 2948: lonnet::allowed when checking a resource's availability during collection 2949: of resources using the iterator. noblockcheck needs to be true if 2950: retrieveResources() was called by a routine that itself was called by 2951: lonnet::allowed, in order to avoid recursion. By default the map 2952: is the top-level map of the course, filterFunc is a function that 2953: always returns 1, recursive is true, bailout is false, showall is 2954: false. The resources will be returned in a list containing the 2955: resource objects for the corresponding resources, with B<no structure 2956: information> in the list; regardless of branching, recursion, etc., 2957: it will be a flat list. 2958: 2959: Thus, this is suitable for cases where you don't want the structure, 2960: just a list of all resources. It is also suitable for finding out how 2961: many resources match a given description; for this use, if all you 2962: want to know is if I<any> resources match the description, the bailout 2963: parameter will allow you to avoid potentially expensive enumeration of 2964: all matching resources. 2965: 2966: =item * B<hasResource>(map, filterFunc, recursive, showall): 2967: 2968: Convenience method for 2969: 2970: scalar(retrieveResources($map, $filterFunc, $recursive, 1, $showall)) > 0 2971: 2972: which will tell whether the map has resources matching the description 2973: in the filter function. 2974: 2975: =item * B<usedVersion>(url): 2976: 2977: Retrieves version infomation for a url. Returns the version (a number, or 2978: the string "mostrecent") for resources which have version information in 2979: the big hash. 2980: 2981: =cut 2982: 2983: 2984: sub getResourceByUrl { 2985: my $self = shift; 2986: my $resUrl = shift; 2987: my $multiple = shift; 2988: 2989: if (ref($resUrl)) { return $resUrl; } 2990: 2991: $resUrl = &Apache::lonnet::clutter($resUrl); 2992: my $resId = $self->{NAV_HASH}->{'ids_' . $resUrl}; 2993: if (!$resId) { return ''; } 2994: if ($multiple) { 2995: my @resources = (); 2996: my @resIds = split (/,/, $resId); 2997: foreach my $id (@resIds) { 2998: my $resourceId = $self->getById($id); 2999: if ($resourceId) { 3000: push(@resources,$resourceId); 3001: } 3002: } 3003: return @resources; 3004: } else { 3005: if ($resId =~ /,/) { 3006: $resId = (split (/,/, $resId))[0]; 3007: } 3008: return $self->getById($resId); 3009: } 3010: } 3011: 3012: sub retrieveResources { 3013: my $self = shift; 3014: my $map = shift; 3015: my $filterFunc = shift; 3016: if (!defined ($filterFunc)) { 3017: $filterFunc = sub {return 1;}; 3018: } 3019: my $recursive = shift; 3020: if (!defined($recursive)) { $recursive = 1; } 3021: my $bailout = shift; 3022: if (!defined($bailout)) { $bailout = 0; } 3023: my $showall = shift; 3024: my $noblockcheck = shift; 3025: # Create the necessary iterator. 3026: if (!ref($map)) { # assume it's a url of a map. 3027: $map = $self->getResourceByUrl($map); 3028: } 3029: 3030: # If nothing was passed, assume top-level map 3031: if (!$map) { 3032: $map = $self->getById('0.0'); 3033: } 3034: 3035: # Check the map's validity. 3036: if (!$map->is_map()) { 3037: # Oh, to throw an exception.... how I'd love that! 3038: return (); 3039: } 3040: 3041: # Get an iterator. 3042: my $it = $self->getIterator($map->map_start(), $map->map_finish(), 3043: undef, $recursive, $showall); 3044: 3045: my @resources = (); 3046: 3047: if (&$filterFunc($map)) { 3048: push(@resources, $map); 3049: } 3050: 3051: # Run down the iterator and collect the resources. 3052: my $curRes; 3053: 3054: while ($curRes = $it->next(undef,$noblockcheck)) { 3055: if (ref($curRes)) { 3056: if (!&$filterFunc($curRes)) { 3057: next; 3058: } 3059: 3060: push(@resources, $curRes); 3061: 3062: if ($bailout) { 3063: return @resources; 3064: } 3065: } 3066: 3067: } 3068: 3069: return @resources; 3070: } 3071: 3072: sub hasResource { 3073: my $self = shift; 3074: my $map = shift; 3075: my $filterFunc = shift; 3076: my $recursive = shift; 3077: my $showall = shift; 3078: 3079: return scalar($self->retrieveResources($map, $filterFunc, $recursive, 1, $showall)) > 0; 3080: } 3081: 3082: sub usedVersion { 3083: my $self = shift; 3084: my $linkurl = shift; 3085: return $self->navhash("version_$linkurl"); 3086: } 3087: 3088: 1; 3089: 3090: package Apache::lonnavmaps::iterator; 3091: use Scalar::Util qw(weaken); 3092: use Apache::lonnet; 3093: 3094: =pod 3095: 3096: =back 3097: 3098: =head1 Object: navmap Iterator 3099: 3100: An I<iterator> encapsulates the logic required to traverse a data 3101: structure. navmap uses an iterator to traverse the course map 3102: according to the criteria you wish to use. 3103: 3104: To obtain an iterator, call the B<getIterator>() function of a 3105: B<navmap> object. (Do not instantiate Apache::lonnavmaps::iterator 3106: directly.) This will return a reference to the iterator: 3107: 3108: C<my $resourceIterator = $navmap-E<gt>getIterator();> 3109: 3110: To get the next thing from the iterator, call B<next>: 3111: 3112: C<my $nextThing = $resourceIterator-E<gt>next()> 3113: 3114: getIterator behaves as follows: 3115: 3116: =over 4 3117: 3118: =item * B<getIterator>(firstResource, finishResource, filterHash, condition, forceTop, returnTopMap): 3119: 3120: All parameters are optional. firstResource is a resource reference 3121: corresponding to where the iterator should start. It defaults to 3122: navmap->firstResource() for the corresponding nav map. finishResource 3123: corresponds to where you want the iterator to end, defaulting to 3124: navmap->finishResource(). filterHash is a hash used as a set 3125: containing strings representing the resource IDs, defaulting to 3126: empty. Condition is a 1 or 0 that sets what to do with the filter 3127: hash: If a 0, then only resources that exist IN the filterHash will be 3128: recursed on. If it is a 1, only resources NOT in the filterHash will 3129: be recursed on. Defaults to 0. forceTop is a boolean value. If it is 3130: false (default), the iterator will only return the first level of map 3131: that is not just a single, 'redirecting' map. If true, the iterator 3132: will return all information, starting with the top-level map, 3133: regardless of content. returnTopMap, if true (default false), will 3134: cause the iterator to return the top-level map object (resource 0.0) 3135: before anything else. 3136: 3137: Thus, by default, only top-level resources will be shown. Change the 3138: condition to a 1 without changing the hash, and all resources will be 3139: shown. Changing the condition to 1 and including some values in the 3140: hash will allow you to selectively suppress parts of the navmap, while 3141: leaving it on 0 and adding things to the hash will allow you to 3142: selectively add parts of the nav map. See the handler code for 3143: examples. 3144: 3145: The iterator will return either a reference to a resource object, or a 3146: token representing something in the map, such as the beginning of a 3147: new branch. The possible tokens are: 3148: 3149: =over 4 3150: 3151: =item * B<END_ITERATOR>: 3152: 3153: The iterator has returned all that it's going to. Further calls to the 3154: iterator will just produce more of these. This is a "false" value, and 3155: is the only false value the iterator which will be returned, so it can 3156: be used as a loop sentinel. 3157: 3158: =item * B<BEGIN_MAP>: 3159: 3160: A new map is being recursed into. This is returned I<after> the map 3161: resource itself is returned. 3162: 3163: =item * B<END_MAP>: 3164: 3165: The map is now done. 3166: 3167: =item * B<BEGIN_BRANCH>: 3168: 3169: A branch is now starting. The next resource returned will be the first 3170: in that branch. 3171: 3172: =item * B<END_BRANCH>: 3173: 3174: The branch is now done. 3175: 3176: =back 3177: 3178: The tokens are retreivable via methods on the iterator object, i.e., 3179: $iterator->END_MAP. 3180: 3181: Maps can contain empty resources. The iterator will automatically skip 3182: over such resources, but will still treat the structure 3183: correctly. Thus, a complicated map with several branches, but 3184: consisting entirely of empty resources except for one beginning or 3185: ending resource, will cause a lot of BRANCH_STARTs and BRANCH_ENDs, 3186: but only one resource will be returned. 3187: 3188: =back 3189: 3190: =head2 Normal Usage 3191: 3192: Normal usage of the iterator object is to do the following: 3193: 3194: my $it = $navmap->getIterator([your params here]); 3195: my $curRes; 3196: while ($curRes = $it->next()) { 3197: [your logic here] 3198: } 3199: 3200: Note that inside of the loop, it's frequently useful to check if 3201: "$curRes" is a reference or not with the reference function; only 3202: resource objects will be references, and any non-references will 3203: be the tokens described above. 3204: 3205: The next() routine can take two (optional) arguments: 3206: closeAllPages - if true will not recurse down a .page 3207: noblockcheck - passed to browsePriv() for passing as sixth arg to 3208: call to lonnet::allowed. This needs to be set if retrieveResources 3209: was already called from another routine called within lonnet::allowed, 3210: so as to prevent recursion. 3211: 3212: Also note there is some old code floating around that tries to track 3213: the depth of the iterator to see when it's done; do not copy that 3214: code. It is difficult to get right and harder to understand than 3215: this. They should be migrated to this new style. 3216: 3217: =cut 3218: 3219: # Here are the tokens for the iterator: 3220: 3221: sub END_ITERATOR { return 0; } 3222: sub BEGIN_MAP { return 1; } # begining of a new map 3223: sub END_MAP { return 2; } # end of the map 3224: sub BEGIN_BRANCH { return 3; } # beginning of a branch 3225: sub END_BRANCH { return 4; } # end of a branch 3226: sub FORWARD { return 1; } # go forward 3227: sub BACKWARD { return 2; } 3228: 3229: sub min { 3230: (my $a, my $b) = @_; 3231: if ($a < $b) { return $a; } else { return $b; } 3232: } 3233: 3234: sub new { 3235: # magic invocation to create a class instance 3236: my $proto = shift; 3237: my $class = ref($proto) || $proto; 3238: my $self = {}; 3239: 3240: weaken($self->{NAV_MAP} = shift); 3241: return undef unless ($self->{NAV_MAP}); 3242: 3243: $self->{USERNAME} = $self->{NAV_MAP}->{USERNAME}; 3244: $self->{DOMAIN} = $self->{NAV_MAP}->{DOMAIN}; 3245: 3246: # Handle the parameters 3247: $self->{FIRST_RESOURCE} = shift || $self->{NAV_MAP}->firstResource(); 3248: $self->{FINISH_RESOURCE} = shift || $self->{NAV_MAP}->finishResource(); 3249: 3250: # If the given resources are just the ID of the resource, get the 3251: # objects 3252: if (!ref($self->{FIRST_RESOURCE})) { $self->{FIRST_RESOURCE} = 3253: $self->{NAV_MAP}->getById($self->{FIRST_RESOURCE}); } 3254: if (!ref($self->{FINISH_RESOURCE})) { $self->{FINISH_RESOURCE} = 3255: $self->{NAV_MAP}->getById($self->{FINISH_RESOURCE}); } 3256: 3257: $self->{FILTER} = shift; 3258: 3259: # A hash, used as a set, of resource already seen 3260: $self->{ALREADY_SEEN} = shift; 3261: if (!defined($self->{ALREADY_SEEN})) { $self->{ALREADY_SEEN} = {} }; 3262: $self->{CONDITION} = shift; 3263: 3264: # Do we want to automatically follow "redirection" maps? 3265: $self->{FORCE_TOP} = shift; 3266: 3267: # Do we want to return the top-level map object (resource 0.0)? 3268: $self->{RETURN_0} = shift; 3269: # have we done that yet? 3270: $self->{HAVE_RETURNED_0} = 0; 3271: 3272: # Now, we need to pre-process the map, by walking forward and backward 3273: # over the parts of the map we're going to look at. 3274: 3275: # The processing steps are exactly the same, except for a few small 3276: # changes, so I bundle those up in the following list of two elements: 3277: # (direction_to_iterate, VAL_name, next_resource_method_to_call, 3278: # first_resource). 3279: # This prevents writing nearly-identical code twice. 3280: my @iterations = ( [FORWARD(), 'TOP_DOWN_VAL', 'getNext', 3281: 'FIRST_RESOURCE'], 3282: [BACKWARD(), 'BOT_UP_VAL', 'getPrevious', 3283: 'FINISH_RESOURCE'] ); 3284: 3285: my $maxDepth = 0; # tracks max depth 3286: 3287: # If there is only one resource in this map, and it's a map, we 3288: # want to remember that, so the user can ask for the first map 3289: # that isn't just a redirector. 3290: my $resource; my $resourceCount = 0; 3291: 3292: # Documentation on this algorithm can be found in the CVS repository at 3293: # /docs/lonnavdocs; these "**#**" markers correspond to documentation 3294: # in that file. 3295: # **1** 3296: 3297: foreach my $pass (@iterations) { 3298: my $direction = $pass->[0]; 3299: my $valName = $pass->[1]; 3300: my $nextResourceMethod = $pass->[2]; 3301: my $firstResourceName = $pass->[3]; 3302: 3303: my $iterator = Apache::lonnavmaps::DFSiterator->new($self->{NAV_MAP}, 3304: $self->{FIRST_RESOURCE}, 3305: $self->{FINISH_RESOURCE}, 3306: {}, undef, 0, $direction); 3307: 3308: # prime the recursion 3309: $self->{$firstResourceName}->{DATA}->{$valName} = 0; 3310: $iterator->next(); 3311: my $curRes = $iterator->next(); 3312: my $depth = 1; 3313: while ($depth > 0) { 3314: if ($curRes == $iterator->BEGIN_MAP()) { $depth++; } 3315: if ($curRes == $iterator->END_MAP()) { $depth--; } 3316: 3317: if (ref($curRes)) { 3318: # If there's only one resource, this will save it 3319: # we have to filter empty resources from consideration here, 3320: # or even "empty", redirecting maps have two (start & finish) 3321: # or three (start, finish, plus redirector) 3322: if($direction == FORWARD && $curRes->src()) { 3323: $resource = $curRes; $resourceCount++; 3324: } 3325: my $resultingVal = $curRes->{DATA}->{$valName}; 3326: my $nextResources = $curRes->$nextResourceMethod(); 3327: my $nextCount = scalar(@{$nextResources}); 3328: 3329: if ($nextCount == 1) { # **3** 3330: my $current = $nextResources->[0]->{DATA}->{$valName} || 999999999; 3331: $nextResources->[0]->{DATA}->{$valName} = min($resultingVal, $current); 3332: } 3333: 3334: if ($nextCount > 1) { # **4** 3335: foreach my $res (@{$nextResources}) { 3336: my $current = $res->{DATA}->{$valName} || 999999999; 3337: $res->{DATA}->{$valName} = min($current, $resultingVal + 1); 3338: } 3339: } 3340: } 3341: 3342: # Assign the final val (**2**) 3343: if (ref($curRes) && $direction == BACKWARD()) { 3344: my $finalDepth = min($curRes->{DATA}->{TOP_DOWN_VAL}, 3345: $curRes->{DATA}->{BOT_UP_VAL}); 3346: 3347: $curRes->{DATA}->{DISPLAY_DEPTH} = $finalDepth; 3348: if ($finalDepth > $maxDepth) {$maxDepth = $finalDepth;} 3349: } 3350: 3351: $curRes = $iterator->next(); 3352: } 3353: } 3354: 3355: # Check: Was this only one resource, a map? 3356: if ($resourceCount == 1 && $resource->is_sequence() && !$self->{FORCE_TOP}) { 3357: my $firstResource = $resource->map_start(); 3358: my $finishResource = $resource->map_finish(); 3359: return Apache::lonnavmaps::iterator->new($self->{NAV_MAP}, $firstResource, 3360: $finishResource, $self->{FILTER}, 3361: $self->{ALREADY_SEEN}, 3362: $self->{CONDITION}, 3363: $self->{FORCE_TOP}); 3364: } 3365: 3366: # Set up some bookkeeping information. 3367: $self->{CURRENT_DEPTH} = 0; 3368: $self->{MAX_DEPTH} = $maxDepth; 3369: $self->{STACK} = []; 3370: $self->{RECURSIVE_ITERATOR_FLAG} = 0; 3371: $self->{FINISHED} = 0; # When true, the iterator has finished 3372: 3373: for (my $i = 0; $i <= $self->{MAX_DEPTH}; $i++) { 3374: push @{$self->{STACK}}, []; 3375: } 3376: 3377: # Prime the recursion w/ the first resource **5** 3378: push @{$self->{STACK}->[0]}, $self->{FIRST_RESOURCE}; 3379: $self->{ALREADY_SEEN}->{$self->{FIRST_RESOURCE}->{ID}} = 1; 3380: 3381: bless ($self); 3382: return $self; 3383: } 3384: 3385: sub next { 3386: my $self = shift; 3387: my $closeAllPages=shift; 3388: my $noblockcheck = shift; 3389: if ($self->{FINISHED}) { 3390: return END_ITERATOR(); 3391: } 3392: 3393: # If we want to return the top-level map object, and haven't yet, 3394: # do so. 3395: if ($self->{RETURN_0} && !$self->{HAVE_RETURNED_0}) { 3396: $self->{HAVE_RETURNED_0} = 1; 3397: my $nextTopLevel = $self->{NAV_MAP}->getById('0.0'); 3398: return $self->{NAV_MAP}->getById('0.0'); 3399: } 3400: if ($self->{RETURN_0} && !$self->{HAVE_RETURNED_0_BEGIN_MAP}) { 3401: $self->{HAVE_RETURNED_0_BEGIN_MAP} = 1; 3402: return $self->BEGIN_MAP(); 3403: } 3404: 3405: if ($self->{RECURSIVE_ITERATOR_FLAG}) { 3406: # grab the next from the recursive iterator 3407: my $next = $self->{RECURSIVE_ITERATOR}->next($closeAllPages); 3408: 3409: # is it a begin or end map? If so, update the depth 3410: if ($next == BEGIN_MAP() ) { $self->{RECURSIVE_DEPTH}++; } 3411: if ($next == END_MAP() ) { $self->{RECURSIVE_DEPTH}--; } 3412: 3413: # Are we back at depth 0? If so, stop recursing 3414: if ($self->{RECURSIVE_DEPTH} == 0) { 3415: $self->{RECURSIVE_ITERATOR_FLAG} = 0; 3416: } 3417: return $next; 3418: } 3419: 3420: if (defined($self->{FORCE_NEXT})) { 3421: my $tmp = $self->{FORCE_NEXT}; 3422: $self->{FORCE_NEXT} = undef; 3423: return $tmp; 3424: } 3425: 3426: # Have we not yet begun? If not, return BEGIN_MAP and 3427: # remember we've started. 3428: if ( !$self->{STARTED} ) { 3429: $self->{STARTED} = 1; 3430: return $self->BEGIN_MAP(); 3431: } 3432: 3433: # Here's the guts of the iterator. 3434: 3435: # Find the next resource, if any. 3436: my $found = 0; 3437: my $i = $self->{MAX_DEPTH}; 3438: my $newDepth; 3439: my $here; 3440: while ( $i >= 0 && !$found ) { 3441: if ( scalar(@{$self->{STACK}->[$i]}) > 0 ) { # **6** 3442: $here = pop @{$self->{STACK}->[$i]}; # **7** 3443: $found = 1; 3444: $newDepth = $i; 3445: } 3446: $i--; 3447: } 3448: 3449: # If we still didn't find anything, we're done. 3450: if ( !$found ) { 3451: # We need to get back down to the correct branch depth 3452: if ( $self->{CURRENT_DEPTH} > 0 ) { 3453: $self->{CURRENT_DEPTH}--; 3454: return END_BRANCH(); 3455: } else { 3456: $self->{FINISHED} = 1; 3457: return END_MAP(); 3458: } 3459: } 3460: 3461: # If this is not a resource, it must be an END_BRANCH marker we want 3462: # to return directly. 3463: if (!ref($here)) { # **8** 3464: if ($here == END_BRANCH()) { # paranoia, in case of later extension 3465: $self->{CURRENT_DEPTH}--; 3466: return $here; 3467: } 3468: } 3469: 3470: # Otherwise, it is a resource and it's safe to store in $self->{HERE} 3471: $self->{HERE} = $here; 3472: 3473: # Get to the right level 3474: if ( $self->{CURRENT_DEPTH} > $newDepth ) { 3475: push @{$self->{STACK}->[$newDepth]}, $here; 3476: $self->{CURRENT_DEPTH}--; 3477: return END_BRANCH(); 3478: } 3479: if ( $self->{CURRENT_DEPTH} < $newDepth) { 3480: push @{$self->{STACK}->[$newDepth]}, $here; 3481: $self->{CURRENT_DEPTH}++; 3482: return BEGIN_BRANCH(); 3483: } 3484: 3485: # If we made it here, we have the next resource, and we're at the 3486: # right branch level. So let's examine the resource for where 3487: # we can get to from here. 3488: 3489: # So we need to look at all the resources we can get to from here, 3490: # categorize them if we haven't seen them, remember if we have a new 3491: my $nextUnfiltered = $here->getNext(); 3492: 3493: 3494: my $maxDepthAdded = -1; 3495: 3496: for (@$nextUnfiltered) { 3497: if (!defined($self->{ALREADY_SEEN}->{$_->{ID}})) { 3498: my $depth = $_->{DATA}->{DISPLAY_DEPTH}; 3499: push @{$self->{STACK}->[$depth]}, $_; 3500: $self->{ALREADY_SEEN}->{$_->{ID}} = 1; 3501: if ($maxDepthAdded < $depth) { $maxDepthAdded = $depth; } 3502: } 3503: } 3504: 3505: # Is this the end of a branch? If so, all of the resources examined above 3506: # led to lower levels than the one we are currently at, so we push a END_BRANCH 3507: # marker onto the stack so we don't forget. 3508: # Example: For the usual A(BC)(DE)F case, when the iterator goes down the 3509: # BC branch and gets to C, it will see F as the only next resource, but it's 3510: # one level lower. Thus, this is the end of the branch, since there are no 3511: # more resources added to this level or above. 3512: # We don't do this if the examined resource is the finish resource, 3513: # because the condition given above is true, but the "END_MAP" will 3514: # take care of things and we should already be at depth 0. 3515: my $isEndOfBranch = $maxDepthAdded < $self->{CURRENT_DEPTH}; 3516: if ($isEndOfBranch && $here != $self->{FINISH_RESOURCE}) { # **9** 3517: push @{$self->{STACK}->[$self->{CURRENT_DEPTH}]}, END_BRANCH(); 3518: } 3519: 3520: # That ends the main iterator logic. Now, do we want to recurse 3521: # down this map (if this resource is a map)? 3522: if ( ($self->{HERE}->is_sequence() || (!$closeAllPages && $self->{HERE}->is_page())) && 3523: (defined($self->{FILTER}->{$self->{HERE}->map_pc()}) xor $self->{CONDITION})) { 3524: $self->{RECURSIVE_ITERATOR_FLAG} = 1; 3525: my $firstResource = $self->{HERE}->map_start(); 3526: my $finishResource = $self->{HERE}->map_finish(); 3527: $self->{RECURSIVE_ITERATOR} = 3528: Apache::lonnavmaps::iterator->new($self->{NAV_MAP}, $firstResource, 3529: $finishResource, $self->{FILTER}, 3530: $self->{ALREADY_SEEN}, 3531: $self->{CONDITION}, 3532: $self->{FORCE_TOP}); 3533: } 3534: 3535: # If this is a blank resource, don't actually return it. 3536: # Should you ever find you need it, make sure to add an option to the code 3537: # that you can use; other things depend on this behavior. 3538: my $browsePriv = $self->{HERE}->browsePriv($noblockcheck); 3539: if (!$self->{HERE}->src() || 3540: (!($browsePriv eq 'F') && !($browsePriv eq '2')) ) { 3541: return $self->next($closeAllPages); 3542: } 3543: 3544: return $self->{HERE}; 3545: 3546: } 3547: 3548: =pod 3549: 3550: The other method available on the iterator is B<getStack>, which 3551: returns an array populated with the current 'stack' of maps, as 3552: references to the resource objects. Example: This is useful when 3553: making the navigation map, as we need to check whether we are under a 3554: page map to see if we need to link directly to the resource, or to the 3555: page. The first elements in the array will correspond to the top of 3556: the stack (most inclusive map). 3557: 3558: =cut 3559: 3560: sub getStack { 3561: my $self=shift; 3562: 3563: my @stack; 3564: 3565: $self->populateStack(\@stack); 3566: 3567: return \@stack; 3568: } 3569: 3570: # Private method: Calls the iterators recursively to populate the stack. 3571: sub populateStack { 3572: my $self=shift; 3573: my $stack = shift; 3574: 3575: push @$stack, $self->{HERE} if ($self->{HERE}); 3576: 3577: if ($self->{RECURSIVE_ITERATOR_FLAG}) { 3578: $self->{RECURSIVE_ITERATOR}->populateStack($stack); 3579: } 3580: } 3581: 3582: 1; 3583: 3584: package Apache::lonnavmaps::DFSiterator; 3585: use Scalar::Util qw(weaken); 3586: use Apache::lonnet; 3587: 3588: # Not documented in the perldoc: This is a simple iterator that just walks 3589: # through the nav map and presents the resources in a depth-first search 3590: # fashion, ignorant of conditionals, randomized resources, etc. It presents 3591: # BEGIN_MAP and END_MAP, but does not understand branches at all. It is 3592: # useful for pre-processing of some kind, and is in fact used by the main 3593: # iterator that way, but that's about it. 3594: # One could imagine merging this into the init routine of the main iterator, 3595: # but this might as well be left separate, since it is possible some other 3596: # use might be found for it. - Jeremy 3597: 3598: # Unlike the main iterator, this DOES return all resources, even blank ones. 3599: # The main iterator needs them to correctly preprocess the map. 3600: 3601: sub BEGIN_MAP { return 1; } # begining of a new map 3602: sub END_MAP { return 2; } # end of the map 3603: sub FORWARD { return 1; } # go forward 3604: sub BACKWARD { return 2; } 3605: 3606: # Params: Nav map ref, first resource id/ref, finish resource id/ref, 3607: # filter hash ref (or undef), already seen hash or undef, condition 3608: # (as in main iterator), direction FORWARD or BACKWARD (undef->forward). 3609: sub new { 3610: # magic invocation to create a class instance 3611: my $proto = shift; 3612: my $class = ref($proto) || $proto; 3613: my $self = {}; 3614: 3615: weaken($self->{NAV_MAP} = shift); 3616: return undef unless ($self->{NAV_MAP}); 3617: 3618: $self->{USERNAME} = $self->{NAV_MAP}->{USERNAME}; 3619: $self->{DOMAIN} = $self->{NAV_MAP}->{DOMAIN}; 3620: 3621: $self->{FIRST_RESOURCE} = shift || $self->{NAV_MAP}->firstResource(); 3622: $self->{FINISH_RESOURCE} = shift || $self->{NAV_MAP}->finishResource(); 3623: 3624: # If the given resources are just the ID of the resource, get the 3625: # objects 3626: if (!ref($self->{FIRST_RESOURCE})) { $self->{FIRST_RESOURCE} = 3627: $self->{NAV_MAP}->getById($self->{FIRST_RESOURCE}); } 3628: if (!ref($self->{FINISH_RESOURCE})) { $self->{FINISH_RESOURCE} = 3629: $self->{NAV_MAP}->getById($self->{FINISH_RESOURCE}); } 3630: 3631: $self->{FILTER} = shift; 3632: 3633: # A hash, used as a set, of resource already seen 3634: $self->{ALREADY_SEEN} = shift; 3635: if (!defined($self->{ALREADY_SEEN})) { $self->{ALREADY_SEEN} = {} }; 3636: $self->{CONDITION} = shift; 3637: $self->{DIRECTION} = shift || FORWARD(); 3638: 3639: # Flag: Have we started yet? 3640: $self->{STARTED} = 0; 3641: 3642: # Should we continue calling the recursive iterator, if any? 3643: $self->{RECURSIVE_ITERATOR_FLAG} = 0; 3644: # The recursive iterator, if any 3645: $self->{RECURSIVE_ITERATOR} = undef; 3646: # Are we recursing on a map, or a branch? 3647: $self->{RECURSIVE_MAP} = 1; # we'll manually unset this when recursing on branches 3648: # And the count of how deep it is, so that this iterator can keep track of 3649: # when to pick back up again. 3650: $self->{RECURSIVE_DEPTH} = 0; 3651: 3652: # For keeping track of our branches, we maintain our own stack 3653: $self->{STACK} = []; 3654: 3655: # Start with the first resource 3656: if ($self->{DIRECTION} == FORWARD) { 3657: push @{$self->{STACK}}, $self->{FIRST_RESOURCE}; 3658: } else { 3659: push @{$self->{STACK}}, $self->{FINISH_RESOURCE}; 3660: } 3661: 3662: bless($self); 3663: return $self; 3664: } 3665: 3666: sub next { 3667: my $self = shift; 3668: 3669: # Are we using a recursive iterator? If so, pull from that and 3670: # watch the depth; we want to resume our level at the correct time. 3671: if ($self->{RECURSIVE_ITERATOR_FLAG}) { 3672: # grab the next from the recursive iterator 3673: my $next = $self->{RECURSIVE_ITERATOR}->next(); 3674: 3675: # is it a begin or end map? Update depth if so 3676: if ($next == BEGIN_MAP() ) { $self->{RECURSIVE_DEPTH}++; } 3677: if ($next == END_MAP() ) { $self->{RECURSIVE_DEPTH}--; } 3678: 3679: # Are we back at depth 0? If so, stop recursing. 3680: if ($self->{RECURSIVE_DEPTH} == 0) { 3681: $self->{RECURSIVE_ITERATOR_FLAG} = 0; 3682: } 3683: 3684: return $next; 3685: } 3686: 3687: # Is there a current resource to grab? If not, then return 3688: # END_MAP, which will end the iterator. 3689: if (scalar(@{$self->{STACK}}) == 0) { 3690: return $self->END_MAP(); 3691: } 3692: 3693: # Have we not yet begun? If not, return BEGIN_MAP and 3694: # remember that we've started. 3695: if ( !$self->{STARTED} ) { 3696: $self->{STARTED} = 1; 3697: return $self->BEGIN_MAP; 3698: } 3699: 3700: # Get the next resource in the branch 3701: $self->{HERE} = pop @{$self->{STACK}}; 3702: 3703: # remember that we've seen this, so we don't return it again later 3704: $self->{ALREADY_SEEN}->{$self->{HERE}->{ID}} = 1; 3705: 3706: # Get the next possible resources 3707: my $nextUnfiltered; 3708: if ($self->{DIRECTION} == FORWARD()) { 3709: $nextUnfiltered = $self->{HERE}->getNext(); 3710: } else { 3711: $nextUnfiltered = $self->{HERE}->getPrevious(); 3712: } 3713: my $next = []; 3714: 3715: # filter the next possibilities to remove things we've 3716: # already seen. 3717: foreach my $item (@$nextUnfiltered) { 3718: if (!defined($self->{ALREADY_SEEN}->{$item->{ID}})) { 3719: push @$next, $item; 3720: } 3721: } 3722: 3723: while (@$next) { 3724: # copy the next possibilities over to the stack 3725: push @{$self->{STACK}}, shift @$next; 3726: } 3727: 3728: # If this is a map and we want to recurse down it... (not filtered out) 3729: if ($self->{HERE}->is_map() && 3730: (defined($self->{FILTER}->{$self->{HERE}->map_pc()}) xor $self->{CONDITION})) { 3731: $self->{RECURSIVE_ITERATOR_FLAG} = 1; 3732: my $firstResource = $self->{HERE}->map_start(); 3733: my $finishResource = $self->{HERE}->map_finish(); 3734: 3735: $self->{RECURSIVE_ITERATOR} = 3736: Apache::lonnavmaps::DFSiterator->new ($self->{NAV_MAP}, $firstResource, 3737: $finishResource, $self->{FILTER}, $self->{ALREADY_SEEN}, 3738: $self->{CONDITION}, $self->{DIRECTION}); 3739: } 3740: 3741: return $self->{HERE}; 3742: } 3743: 3744: # Identical to the full iterator methods of the same name. Hate to copy/paste 3745: # but I also hate to "inherit" either iterator from the other. 3746: 3747: sub getStack { 3748: my $self=shift; 3749: 3750: my @stack; 3751: 3752: $self->populateStack(\@stack); 3753: 3754: return \@stack; 3755: } 3756: 3757: # Private method: Calls the iterators recursively to populate the stack. 3758: sub populateStack { 3759: my $self=shift; 3760: my $stack = shift; 3761: 3762: push @$stack, $self->{HERE} if ($self->{HERE}); 3763: 3764: if ($self->{RECURSIVE_ITERATOR_FLAG}) { 3765: $self->{RECURSIVE_ITERATOR}->populateStack($stack); 3766: } 3767: } 3768: 3769: 1; 3770: 3771: package Apache::lonnavmaps::resource; 3772: use Scalar::Util qw(weaken); 3773: use Apache::lonnet; 3774: 3775: =pod 3776: 3777: =head1 Object: resource 3778: 3779: X<resource, navmap object> 3780: A resource object encapsulates a resource in a resource map, allowing 3781: easy manipulation of the resource, querying the properties of the 3782: resource (including user properties), and represents a reference that 3783: can be used as the canonical representation of the resource by 3784: lonnavmap clients like renderers. 3785: 3786: A resource only makes sense in the context of a navmap, as some of the 3787: data is stored in the navmap object. 3788: 3789: You will probably never need to instantiate this object directly. Use 3790: Apache::lonnavmaps::navmap, and use the "start" method to obtain the 3791: starting resource. 3792: 3793: Resource objects respect the parameter_hiddenparts, which suppresses 3794: various parts according to the wishes of the map author. As of this 3795: writing, there is no way to override this parameter, and suppressed 3796: parts will never be returned, nor will their response types or ids be 3797: stored. 3798: 3799: =head2 Overview 3800: 3801: A B<Resource> is the most granular type of object in LON-CAPA that can 3802: be included in a course. It can either be a particular resource, like 3803: an HTML page, external resource, problem, etc., or it can be a 3804: container sequence, such as a "page" or a "map". 3805: 3806: To see a sequence from the user's point of view, please see the 3807: B<Creating a Course: Maps and Sequences> chapter of the Author's 3808: Manual. 3809: 3810: A Resource Object, once obtained from a navmap object via a B<getBy*> 3811: method of the navmap, or from an iterator, allows you to query 3812: information about that resource. 3813: 3814: Generally, you do not ever want to create a resource object yourself, 3815: so creation has been left undocumented. Always retrieve resources 3816: from navmap objects. 3817: 3818: =head3 Identifying Resources 3819: 3820: X<big hash>Every resource is identified by a Resource ID in the big hash that is 3821: unique to that resource for a given course. X<resource ID, in big hash> 3822: The Resource ID has the form #.#, where the first number is the same 3823: for every resource in a map, and the second is unique. For instance, 3824: for a course laid out like this: 3825: 3826: * Problem 1 3827: * Map 3828: * Resource 2 3829: * Resource 3 3830: 3831: C<Problem 1> and C<Map> will share a first number, and C<Resource 2> 3832: C<Resource 3> will share a first number. The second number may end up 3833: re-used between the two groups. 3834: 3835: The resource ID is only used in the big hash, but can be used in the 3836: context of a course to identify a resource easily. (For instance, the 3837: printing system uses it to record which resources from a sequence you 3838: wish to print.) 3839: 3840: X<symb> X<resource, symb> 3841: All resources also have B<symb>s, which uniquely identify a resource 3842: in a course. Many internal LON-CAPA functions expect a symb. A symb 3843: carries along with it the URL of the resource, and the map it appears 3844: in. Symbs are much larger than resource IDs. 3845: 3846: =cut 3847: 3848: sub new { 3849: # magic invocation to create a class instance 3850: my $proto = shift; 3851: my $class = ref($proto) || $proto; 3852: my $self = {}; 3853: 3854: weaken($self->{NAV_MAP} = shift); 3855: $self->{ID} = shift; 3856: 3857: $self->{USERNAME} = $self->{NAV_MAP}->{USERNAME}; 3858: $self->{DOMAIN} = $self->{NAV_MAP}->{DOMAIN}; 3859: 3860: # Store this new resource in the parent nav map's cache. 3861: $self->{NAV_MAP}->{RESOURCE_CACHE}->{$self->{ID}} = $self; 3862: $self->{RESOURCE_ERROR} = 0; 3863: 3864: $self->{DUEDATE_CACHE} = undef; 3865: 3866: # A hash that can be used by two-pass algorithms to store data 3867: # about this resource in. Not used by the resource object 3868: # directly. 3869: $self->{DATA} = {}; 3870: 3871: bless($self); 3872: 3873: # This is a speed optimization, to avoid calling symb() too often. 3874: $self->{SYMB} = $self->symb(); 3875: 3876: return $self; 3877: } 3878: 3879: # private function: simplify the NAV_HASH lookups we keep doing 3880: # pass the name, and to automatically append my ID, pass a true val on the 3881: # second param 3882: sub navHash { 3883: my $self = shift; 3884: my $param = shift; 3885: my $id = shift; 3886: my $arg = $param . ($id?$self->{ID}:""); 3887: if (ref($self) && ref($self->{NAV_MAP}) && defined($arg)) { 3888: return $self->{NAV_MAP}->navhash($arg); 3889: } 3890: return; 3891: } 3892: 3893: =pod 3894: 3895: =head2 Methods 3896: 3897: Once you have a resource object, here's what you can do with it: 3898: 3899: =head3 Attribute Retrieval 3900: 3901: Every resource has certain attributes that can be retrieved and used: 3902: 3903: =over 4 3904: 3905: =item * B<ID>: Every resource has an ID that is unique for that 3906: resource in the course it is in. The ID is actually in the hash 3907: representing the resource, so for a resource object $res, obtain 3908: it via C<$res->{ID}). 3909: 3910: =item * B<compTitle>: 3911: 3912: Returns a "composite title", that is equal to $res->title() if the 3913: resource has a title, and is otherwise the last part of the URL (e.g., 3914: "problem.problem"). 3915: 3916: =item * B<ext>: 3917: 3918: Returns true if the resource is external. 3919: 3920: =item * B<kind>: 3921: 3922: Returns the kind of the resource from the compiled nav map. 3923: 3924: =item * B<randomout>: 3925: 3926: Returns true if this resource was chosen to NOT be shown to the user 3927: by the random map selection feature. In other words, this is usually 3928: false. 3929: 3930: =item * B<randompick>: 3931: 3932: Returns the number of randomly picked items for a map if the randompick 3933: feature is being used on the map. 3934: 3935: =item * B<randomorder>: 3936: 3937: Returns true for a map if the randomorder feature is being used on the 3938: map. 3939: 3940: =item * B<src>: 3941: 3942: Returns the source for the resource. 3943: 3944: =item * B<symb>: 3945: 3946: Returns the symb for the resource. 3947: 3948: =item * B<title>: 3949: 3950: Returns the title of the resource. 3951: 3952: =back 3953: 3954: =cut 3955: 3956: # These info functions can be used directly, as they don't return 3957: # resource information. 3958: sub comesfrom { my $self=shift; return $self->navHash("comesfrom_", 1); } 3959: sub encrypted { my $self=shift; return $self->navHash("encrypted_", 1); } 3960: sub ext { my $self=shift; return $self->navHash("ext_", 1) eq 'true:'; } 3961: sub from { my $self=shift; return $self->navHash("from_", 1); } 3962: # considered private and undocumented 3963: sub goesto { my $self=shift; return $self->navHash("goesto_", 1); } 3964: sub kind { my $self=shift; return $self->navHash("kind_", 1); } 3965: sub randomout { my $self=shift; return $self->navHash("randomout_", 1); } 3966: sub randompick { 3967: my $self = shift; 3968: my $randompick = $self->parmval('randompick'); 3969: return $randompick; 3970: } 3971: sub randomorder { 3972: my $self = shift; 3973: my $randomorder = $self->parmval('randomorder'); 3974: return ($randomorder =~ /^yes$/i); 3975: } 3976: sub link { 3977: my $self=shift; 3978: if ($self->encrypted()) { return &Apache::lonenc::encrypted($self->src); } 3979: return $self->src; 3980: } 3981: sub src { 3982: my $self=shift; 3983: return $self->navHash("src_", 1); 3984: } 3985: sub shown_symb { 3986: my $self=shift; 3987: if ($self->encrypted()) {return &Apache::lonenc::encrypted($self->{SYMB});} 3988: return $self->{SYMB}; 3989: } 3990: sub id { 3991: my $self=shift; 3992: return $self->{ID}; 3993: } 3994: sub enclosing_map_src { 3995: my $self=shift; 3996: (my $first, my $second) = $self->{ID} =~ /(\d+).(\d+)/; 3997: return $self->navHash('map_id_'.$first); 3998: } 3999: sub symb { 4000: my $self=shift; 4001: (my $first, my $second) = $self->{ID} =~ /(\d+).(\d+)/; 4002: my $symbSrc = &Apache::lonnet::declutter($self->src()); 4003: my $symb = &Apache::lonnet::declutter($self->navHash('map_id_'.$first)) 4004: . '___' . $second . '___' . $symbSrc; 4005: return &Apache::lonnet::symbclean($symb); 4006: } 4007: sub wrap_symb { 4008: my $self = shift; 4009: return $self->{NAV_MAP}->wrap_symb($self->{SYMB}); 4010: } 4011: sub title { 4012: my $self=shift; 4013: if ($self->{ID} eq '0.0') { 4014: # If this is the top-level map, return the title of the course 4015: # since this map can not be titled otherwise. 4016: return $env{'course.'.$env{'request.course.id'}.'.description'}; 4017: } 4018: return $self->navHash("title_", 1); } 4019: # considered private and undocumented 4020: sub to { my $self=shift; return $self->navHash("to_", 1); } 4021: sub condition { 4022: my $self=shift; 4023: my $undercond=$self->navHash("undercond_", 1); 4024: if (!defined($undercond)) { return 1; }; 4025: my $condid=$self->navHash("condid_$undercond"); 4026: if (!defined($condid)) { return 1; }; 4027: my $condition=&Apache::lonnet::directcondval($condid); 4028: return $condition; 4029: } 4030: sub condval { 4031: my $self=shift; 4032: my ($pathname,$filename) = 4033: &Apache::lonnet::split_uri_for_cond($self->src()); 4034: 4035: my $match=($env{'acc.res.'.$env{'request.course.id'}.'.'.$pathname}=~ 4036: /\&\Q$filename\E\:([\d\|]+)\&/); 4037: if ($match) { 4038: return &Apache::lonnet::condval($1); 4039: } 4040: return 0; 4041: } 4042: sub compTitle { 4043: my $self = shift; 4044: my $title = $self->title(); 4045: $title=~s/\&colon\;/\:/gs; 4046: if (!$title) { 4047: $title = $self->src(); 4048: $title = substr($title, rindex($title, '/') + 1); 4049: } 4050: return $title; 4051: } 4052: 4053: =pod 4054: 4055: B<Predicate Testing the Resource> 4056: 4057: These methods are shortcuts to deciding if a given resource has a given property. 4058: 4059: =over 4 4060: 4061: =item * B<is_map>: 4062: 4063: Returns true if the resource is a map type. 4064: 4065: =item * B<is_problem>: 4066: 4067: Returns true if the resource is a problem type, false 4068: otherwise. (Looks at the extension on the src field; might need more 4069: to work correctly.) 4070: 4071: =item * B<is_page>: 4072: 4073: Returns true if the resource is a page. 4074: 4075: =item * B<is_sequence>: 4076: 4077: Returns true if the resource is a sequence. 4078: 4079: =back 4080: 4081: =cut 4082: 4083: sub hasResource { 4084: my $self = shift; 4085: return $self->{NAV_MAP}->hasResource(@_); 4086: } 4087: 4088: sub retrieveResources { 4089: my $self = shift; 4090: return $self->{NAV_MAP}->retrieveResources(@_); 4091: } 4092: 4093: sub is_exam { 4094: my ($self,$part) = @_; 4095: my $type = $self->parmval('type',$part); 4096: if ($type eq 'exam') { 4097: return 1; 4098: } 4099: if ($self->src() =~ /\.(exam)$/) { 4100: return 1; 4101: } 4102: return 0; 4103: } 4104: sub is_html { 4105: my $self=shift; 4106: my $src = $self->src(); 4107: return ($src =~ /html$/); 4108: } 4109: sub is_map { my $self=shift; return defined($self->navHash("is_map_", 1)); } 4110: sub is_page { 4111: my $self=shift; 4112: my $src = $self->src(); 4113: return $self->navHash("is_map_", 1) && 4114: $self->navHash("map_type_" . $self->map_pc()) eq 'page'; 4115: } 4116: sub is_practice { 4117: my $self=shift; 4118: my ($part) = @_; 4119: my $type = $self->parmval('type',$part); 4120: if ($type eq 'practice') { 4121: return 1; 4122: } 4123: return 0; 4124: } 4125: sub is_problem { 4126: my $self=shift; 4127: my $src = $self->src(); 4128: if ($src =~ /$LONCAPA::assess_re/) { 4129: return !($self->is_practice()); 4130: } 4131: return 0; 4132: } 4133: # 4134: # The has below is the set of status that are considered 'incomplete' 4135: # 4136: my %incomplete_hash = 4137: ( 4138: TRIES_LEFT() => 1, 4139: OPEN() => 1, 4140: ATTEMPTED() => 1 4141: 4142: ); 4143: # 4144: # Return tru if a problem is incomplete... for now incomplete means that 4145: # any part of the problem is incomplete. 4146: # Note that if the resources is not a problem, 0 is returned. 4147: # 4148: sub is_incomplete { 4149: my $self = shift; 4150: if ($self->is_problem()) { 4151: foreach my $part (@{$self->parts()}) { 4152: if (exists($incomplete_hash{$self->status($part)})) { 4153: return 1; 4154: } 4155: } 4156: } 4157: return 0; 4158: 4159: } 4160: sub is_raw_problem { 4161: my $self=shift; 4162: my $src = $self->src(); 4163: if ($src =~ /$LONCAPA::assess_re/) { 4164: return 1; 4165: } 4166: return 0; 4167: } 4168: 4169: sub contains_problem { 4170: my $self=shift; 4171: if ($self->is_page()) { 4172: my $hasProblem=$self->hasResource($self,sub { $_[0]->is_problem() },1); 4173: return $hasProblem; 4174: } 4175: return 0; 4176: } 4177: sub map_contains_problem { 4178: my $self=shift; 4179: if ($self->is_map()) { 4180: my $has_problem= 4181: $self->hasResource($self,sub { $_[0]->is_problem() },1); 4182: return $has_problem; 4183: } 4184: return 0; 4185: } 4186: sub is_sequence { 4187: my $self=shift; 4188: return $self->navHash("is_map_", 1) && 4189: $self->navHash("map_type_" . $self->map_pc()) eq 'sequence'; 4190: } 4191: sub is_survey { 4192: my $self = shift(); 4193: my $part = shift(); 4194: my $type = $self->parmval('type',$part); 4195: if (($type eq 'survey') || ($type eq 'surveycred')) { 4196: return 1; 4197: } 4198: if ($self->src() =~ /\.(survey)$/) { 4199: return 1; 4200: } 4201: return 0; 4202: } 4203: sub is_anonsurvey { 4204: my $self = shift(); 4205: my $part = shift(); 4206: my $type = $self->parmval('type',$part); 4207: if (($type eq 'anonsurvey') || ($type eq 'anonsurveycred')) { 4208: return 1; 4209: } 4210: return 0; 4211: } 4212: sub is_task { 4213: my $self=shift; 4214: my $src = $self->src(); 4215: return ($src =~ /\.(task)$/) 4216: } 4217: 4218: sub is_empty_sequence { 4219: my $self=shift; 4220: my $src = $self->src(); 4221: return !$self->is_page() && $self->navHash("is_map_", 1) && !$self->navHash("map_type_" . $self->map_pc()); 4222: } 4223: 4224: # Private method: Shells out to the parmval in the nav map, handler parts. 4225: sub parmval { 4226: my $self = shift; 4227: my $what = shift; 4228: my $part = shift; 4229: if (!defined($part)) { 4230: $part = '0'; 4231: } 4232: return $self->{NAV_MAP}->parmval($part.'.'.$what, $self->{SYMB}); 4233: } 4234: 4235: =pod 4236: 4237: B<Map Methods> 4238: 4239: These methods are useful for getting information about the map 4240: properties of the resource, if the resource is a map (B<is_map>). 4241: 4242: =over 4 4243: 4244: =item * B<map_finish>: 4245: 4246: Returns a reference to a resource object corresponding to the finish 4247: resource of the map. 4248: 4249: =item * B<map_pc>: 4250: 4251: Returns the pc value of the map, which is the first number that 4252: appears in the resource ID of the resources in the map, and is the 4253: number that appears around the middle of the symbs of the resources in 4254: that map. 4255: 4256: =item * B<map_start>: 4257: 4258: Returns a reference to a resource object corresponding to the start 4259: resource of the map. 4260: 4261: =item * B<map_type>: 4262: 4263: Returns a string with the type of the map in it. 4264: 4265: =item * B<map_hierarchy>: 4266: 4267: Returns a string with a comma-separated ordered list of map_pc IDs 4268: for the hierarchy of maps containing a map, with the top level 4269: map first, then descending to deeper levels, with the enclosing map last. 4270: 4271: =back 4272: 4273: =cut 4274: 4275: sub map_finish { 4276: my $self = shift; 4277: my $src = $self->src(); 4278: $src = &Apache::lonnet::clutter($src); 4279: my $res = $self->navHash("map_finish_$src", 0); 4280: $res = $self->{NAV_MAP}->getById($res); 4281: return $res; 4282: } 4283: sub map_pc { 4284: my $self = shift; 4285: my $src = $self->src(); 4286: return $self->navHash("map_pc_$src", 0); 4287: } 4288: sub map_start { 4289: my $self = shift; 4290: my $src = $self->src(); 4291: $src = &Apache::lonnet::clutter($src); 4292: my $res = $self->navHash("map_start_$src", 0); 4293: $res = $self->{NAV_MAP}->getById($res); 4294: return $res; 4295: } 4296: sub map_type { 4297: my $self = shift; 4298: my $pc = $self->map_pc(); 4299: return $self->navHash("map_type_$pc", 0); 4300: } 4301: sub map_hierarchy { 4302: my $self = shift; 4303: my $pc = $self->map_pc(); 4304: return $self->navHash("map_hierarchy_$pc", 0); 4305: } 4306: 4307: ##### 4308: # Property queries 4309: ##### 4310: 4311: # These functions will be responsible for returning the CORRECT 4312: # VALUE for the parameter, no matter what. So while they may look 4313: # like direct calls to parmval, they can be more than that. 4314: # So, for instance, the duedate function should use the "duedatetype" 4315: # information, rather than the resource object user. 4316: 4317: =pod 4318: 4319: =head2 Resource Parameters 4320: 4321: In order to use the resource parameters correctly, the nav map must 4322: have been instantiated with genCourseAndUserOptions set to true, so 4323: the courseopt and useropt is read correctly. Then, you can call these 4324: functions to get the relevant parameters for the resource. Each 4325: function defaults to part "0", but can be directed to another part by 4326: passing the part as the parameter. 4327: 4328: These methods are responsible for getting the parameter correct, not 4329: merely reflecting the contents of the GDBM hashes. As we move towards 4330: dates relative to other dates, these methods should be updated to 4331: reflect that. (Then, anybody using these methods will not have to update 4332: their code.) 4333: 4334: =over 4 4335: 4336: 4337: =item * B<printable> 4338: 4339: returns true if the current date is such that the 4340: specified resource part is printable. 4341: 4342: 4343: =item * B<resprintable> 4344: 4345: Returns true if all parts in the resource are printable making the 4346: entire resource printable. 4347: 4348: =item * B<acc> 4349: 4350: Get the Client IP/Name Access Control information. 4351: 4352: =item * B<answerdate>: 4353: 4354: Get the answer-reveal date for the problem. 4355: 4356: =item * B<awarded>: 4357: 4358: Gets the awarded value for the problem part. Requires genUserData set to 4359: true when the navmap object was created. 4360: 4361: =item * B<duedate>: 4362: 4363: Get the due date for the problem. 4364: 4365: =item * B<tries>: 4366: 4367: Get the number of tries the student has used on the problem. 4368: 4369: =item * B<maxtries>: 4370: 4371: Get the number of max tries allowed. 4372: 4373: =item * B<opendate>: 4374: 4375: Get the open date for the problem. 4376: 4377: =item * B<sig>: 4378: 4379: Get the significant figures setting. 4380: 4381: =item * B<tol>: 4382: 4383: Get the tolerance for the problem. 4384: 4385: =item * B<tries>: 4386: 4387: Get the number of tries the user has already used on the problem. 4388: 4389: =item * B<type>: 4390: 4391: Get the question type for the problem. 4392: 4393: =item * B<weight>: 4394: 4395: Get the weight for the problem. 4396: 4397: =back 4398: 4399: =cut 4400: 4401: 4402: 4403: 4404: sub printable { 4405: 4406: my ($self, $part) = @_; 4407: 4408: # The following cases apply: 4409: # - If a start date is not set, it is replaced by the open date. 4410: # - Ditto for start/open replaced by content open. 4411: # - If neither start nor printdates are set the part is printable. 4412: # - Start date set but no end date: Printable if now >= start date. 4413: # - End date set but no start date: Printable if now <= end date. 4414: # - both defined: printable if start <= now <= end 4415: # 4416: 4417: # Get the print open/close dates for the resource. 4418: 4419: my $start = $self->parmval("printstartdate", $part); 4420: my $end = $self->parmval("printenddate", $part); 4421: 4422: if (!$start) { 4423: $start = $self->parmval("opendate", $part); 4424: } 4425: if (!$start) { 4426: $start = $self->parmval("contentopen", $part); 4427: } 4428: 4429: 4430: my $now = time(); 4431: 4432: 4433: my $startok = 1; 4434: my $endok = 1; 4435: 4436: if ((defined $start) && ($start ne '')) { 4437: $startok = $start <= $now; 4438: } 4439: if ((defined $end) && ($end != '')) { 4440: $endok = $end >= $now; 4441: } 4442: return $startok && $endok; 4443: } 4444: 4445: sub resprintable { 4446: my $self = shift; 4447: 4448: # get parts...or realize there are no parts. 4449: 4450: my $partsref = $self->parts(); 4451: my @parts = @$partsref; 4452: 4453: if (!@parts) { 4454: return $self->printable(0); 4455: } else { 4456: foreach my $part (@parts) { 4457: if (!$self->printable($part)) { 4458: return 0; 4459: } 4460: } 4461: return 1; 4462: } 4463: } 4464: 4465: sub acc { 4466: (my $self, my $part) = @_; 4467: my $acc = $self->parmval("acc", $part); 4468: return $acc; 4469: } 4470: sub answerdate { 4471: (my $self, my $part) = @_; 4472: # Handle intervals 4473: my $answerdatetype = $self->parmval("answerdate.type", $part); 4474: my $answerdate = $self->parmval("answerdate", $part); 4475: my $duedate = $self->parmval("duedate", $part); 4476: if ($answerdatetype eq 'date_interval') { 4477: $answerdate = $duedate + $answerdate; 4478: } 4479: return $answerdate; 4480: } 4481: sub awarded { 4482: my $self = shift; my $part = shift; 4483: $self->{NAV_MAP}->get_user_data(); 4484: if (!defined($part)) { $part = '0'; } 4485: return $self->{NAV_MAP}->{STUDENT_DATA}->{$self->{SYMB}}->{'resource.'.$part.'.awarded'}; 4486: } 4487: sub taskversion { 4488: my $self = shift; my $part = shift; 4489: $self->{NAV_MAP}->get_user_data(); 4490: if (!defined($part)) { $part = '0'; } 4491: return $self->{NAV_MAP}->{STUDENT_DATA}->{$self->{SYMB}}->{'resource.'.$part.'.version'}; 4492: } 4493: sub taskstatus { 4494: my $self = shift; my $part = shift; 4495: $self->{NAV_MAP}->get_user_data(); 4496: if (!defined($part)) { $part = '0'; } 4497: return $self->{NAV_MAP}->{STUDENT_DATA}->{$self->{SYMB}}->{'resource.'.$self->taskversion($part).'.'.$part.'.status'}; 4498: } 4499: sub solved { 4500: my $self = shift; my $part = shift; 4501: $self->{NAV_MAP}->get_user_data(); 4502: if (!defined($part)) { $part = '0'; } 4503: return $self->{NAV_MAP}->{STUDENT_DATA}->{$self->{SYMB}}->{'resource.'.$part.'.solved'}; 4504: } 4505: sub checkedin { 4506: my $self = shift; my $part = shift; 4507: $self->{NAV_MAP}->get_user_data(); 4508: if (!defined($part)) { $part = '0'; } 4509: if ($self->is_task()) { 4510: my $version = $self->taskversion($part); 4511: return ($self->{NAV_MAP}->{STUDENT_DATA}->{$self->{SYMB}}->{'resource.'.$version .'.'.$part.'.checkedin'},$self->{NAV_MAP}->{STUDENT_DATA}->{$self->{SYMB}}->{'resource.'.$version .'.'.$part.'.checkedin.slot'}); 4512: } else { 4513: return ($self->{NAV_MAP}->{STUDENT_DATA}->{$self->{SYMB}}->{'resource.'.$part.'.checkedin'},$self->{NAV_MAP}->{STUDENT_DATA}->{$self->{SYMB}}->{'resource.'.$part.'.checkedin.slot'}); 4514: } 4515: } 4516: # this should work exactly like the copy in lonhomework.pm 4517: # Why is there a copy in lonhomework? Why not centralized? 4518: # 4519: # TODO: Centralize duedate. 4520: # 4521: 4522: sub duedate { 4523: (my $self, my $part) = @_; 4524: if (defined ($self->{DUEDATE_CACHE}->{$part})) { 4525: return $self->{DUEDATE_CACHE}->{$part}; 4526: } 4527: my $date; 4528: my @interval=$self->parmval("interval", $part); 4529: my $due_date=$self->parmval("duedate", $part); 4530: if ($interval[0] =~ /\d+/) { 4531: my $first_access=&Apache::lonnet::get_first_access($interval[1], 4532: $self->symb); 4533: if (defined($first_access)) { 4534: my $interval = $first_access+$interval[0]; 4535: $date = (!$due_date || $interval < $due_date) ? $interval 4536: : $due_date; 4537: } else { 4538: $date = $due_date; 4539: } 4540: } else { 4541: $date = $due_date; 4542: } 4543: $self->{DUEDATE_CACHE}->{$part} = $date; 4544: return $date; 4545: } 4546: sub handgrade { 4547: (my $self, my $part) = @_; 4548: my @response_ids = $self->responseIds($part); 4549: if (@response_ids) { 4550: foreach my $response_id (@response_ids) { 4551: my $handgrade = $self->parmval("handgrade",$part.'_'.$response_id); 4552: if (lc($handgrade) eq 'yes') { 4553: return 'yes'; 4554: } 4555: } 4556: } 4557: my $handgrade = $self->parmval("handgrade", $part); 4558: return $handgrade; 4559: } 4560: sub maxtries { 4561: (my $self, my $part) = @_; 4562: my $maxtries = $self->parmval("maxtries", $part); 4563: return $maxtries; 4564: } 4565: sub opendate { 4566: (my $self, my $part) = @_; 4567: my $opendatetype = $self->parmval("opendate.type", $part); 4568: my $opendate = $self->parmval("opendate", $part); 4569: if ($opendatetype eq 'date_interval') { 4570: my $duedate = $self->duedate($part); 4571: $opendate = $duedate - $opendate; 4572: } 4573: return $opendate; 4574: } 4575: sub problemstatus { 4576: (my $self, my $part) = @_; 4577: my $problemstatus = $self->parmval("problemstatus", $part); 4578: return lc($problemstatus); 4579: } 4580: sub sig { 4581: (my $self, my $part) = @_; 4582: my $sig = $self->parmval("sig", $part); 4583: return $sig; 4584: } 4585: sub tol { 4586: (my $self, my $part) = @_; 4587: my $tol = $self->parmval("tol", $part); 4588: return $tol; 4589: } 4590: sub tries { 4591: my $self = shift; 4592: my $tries = $self->queryRestoreHash('tries', shift); 4593: if (!defined($tries)) { return '0';} 4594: return $tries; 4595: } 4596: sub type { 4597: (my $self, my $part) = @_; 4598: my $type = $self->parmval("type", $part); 4599: return $type; 4600: } 4601: sub weight { 4602: my $self = shift; my $part = shift; 4603: if (!defined($part)) { $part = '0'; } 4604: my $weight = &Apache::lonnet::EXT('resource.'.$part.'.weight', 4605: $self->{SYMB}, $self->{DOMAIN}, 4606: $self->{USERNAME}, 4607: $env{'request.course.sec'}); 4608: return $weight; 4609: } 4610: sub part_display { 4611: my $self= shift(); my $partID = shift(); 4612: if (! defined($partID)) { $partID = '0'; } 4613: my $display=&Apache::lonnet::EXT('resource.'.$partID.'.display', 4614: $self->symb); 4615: if (! defined($display) || $display eq '') { 4616: $display = $partID; 4617: } 4618: return $display; 4619: } 4620: sub slot_control { 4621: my $self=shift(); my $part = shift(); 4622: if (!defined($part)) { $part = '0'; } 4623: my $useslots = $self->parmval("useslots", $part); 4624: my $availablestudent = $self->parmval("availablestudent", $part); 4625: my $available = $self->parmval("available", $part); 4626: return ($useslots,$availablestudent,$available); 4627: } 4628: 4629: # Multiple things need this 4630: sub getReturnHash { 4631: my $self = shift; 4632: 4633: if (!defined($self->{RETURN_HASH})) { 4634: my %tmpHash = &Apache::lonnet::restore($self->{SYMB},undef,$self->{DOMAIN},$self->{USERNAME}); 4635: $self->{RETURN_HASH} = \%tmpHash; 4636: } 4637: } 4638: 4639: ###### 4640: # Status queries 4641: ###### 4642: 4643: # These methods query the status of problems. 4644: 4645: # If we need to count parts, this function determines the number of 4646: # parts from the metadata. When called, it returns a reference to a list 4647: # of strings corresponding to the parts. (Thus, using it in a scalar context 4648: # tells you how many parts you have in the problem: 4649: # $partcount = scalar($resource->countParts()); 4650: # Don't use $self->{PARTS} directly because you don't know if it's been 4651: # computed yet. 4652: 4653: =pod 4654: 4655: =head2 Resource misc 4656: 4657: Misc. functions for the resource. 4658: 4659: =over 4 4660: 4661: =item * B<hasDiscussion>: 4662: 4663: Returns a false value if there has been discussion since the user last 4664: logged in, true if there has. Always returns false if the discussion 4665: data was not extracted when the nav map was constructed. 4666: 4667: =item * B<last_post_time>: 4668: 4669: Returns a false value if there hasn't been discussion otherwise returns 4670: unix timestamp of last time a discussion posting (or edit) was made. 4671: 4672: =item * B<discussion_info>: 4673: 4674: optional argument is a filter (currently can be 'unread'); 4675: returns in scalar context the count of the number of discussion postings. 4676: 4677: returns in list context both the count of postings and a hash ref 4678: containing information about the postings (subject, id, timestamp) in a hash. 4679: 4680: Default is to return counts for all postings. However if called with a second argument set to 'unread', will return information about only unread postings. 4681: 4682: =item * B<getFeedback>: 4683: 4684: Gets the feedback for the resource and returns the raw feedback string 4685: for the resource, or the null string if there is no feedback or the 4686: email data was not extracted when the nav map was constructed. Usually 4687: used like this: 4688: 4689: for my $url (split(/\,/, $res->getFeedback())) { 4690: my $link = &escape($url); 4691: ... 4692: 4693: and use the link as appropriate. 4694: 4695: =cut 4696: 4697: sub hasDiscussion { 4698: my $self = shift; 4699: return $self->{NAV_MAP}->hasDiscussion($self->{SYMB}); 4700: } 4701: 4702: sub last_post_time { 4703: my $self = shift; 4704: return $self->{NAV_MAP}->last_post_time($self->{SYMB}); 4705: } 4706: 4707: sub discussion_info { 4708: my ($self,$filter) = @_; 4709: return $self->{NAV_MAP}->discussion_info($self->{SYMB},$filter); 4710: } 4711: 4712: sub getFeedback { 4713: my $self = shift; 4714: my $source = $self->src(); 4715: my $symb = $self->{SYMB}; 4716: if ($source =~ /^\/res\//) { $source = substr $source, 5; } 4717: return $self->{NAV_MAP}->getFeedback($symb,$source); 4718: } 4719: 4720: sub getErrors { 4721: my $self = shift; 4722: my $source = $self->src(); 4723: my $symb = $self->{SYMB}; 4724: if ($source =~ /^\/res\//) { $source = substr $source, 5; } 4725: return $self->{NAV_MAP}->getErrors($symb,$source); 4726: } 4727: 4728: =pod 4729: 4730: =item * B<parts>(): 4731: 4732: Returns a list reference containing sorted strings corresponding to 4733: each part of the problem. Single part problems have only a part '0'. 4734: Multipart problems do not return their part '0', since they typically 4735: do not really matter. 4736: 4737: =item * B<countParts>(): 4738: 4739: Returns the number of parts of the problem a student can answer. Thus, 4740: for single part problems, returns 1. For multipart, it returns the 4741: number of parts in the problem, not including psuedo-part 0. 4742: 4743: =item * B<countResponses>(): 4744: 4745: Returns the total number of responses in the problem a student can answer. 4746: 4747: =item * B<responseTypes>(): 4748: 4749: Returns a hash whose keys are the response types. The values are the number 4750: of times each response type is used. This is for the I<entire> problem, not 4751: just a single part. 4752: 4753: =item * B<multipart>(): 4754: 4755: Returns true if the problem is multipart, false otherwise. Use this instead 4756: of countParts if all you want is multipart/not multipart. 4757: 4758: =item * B<responseType>($part): 4759: 4760: Returns the response type of the part, without the word "response" on the 4761: end. Example return values: 'string', 'essay', 'numeric', etc. 4762: 4763: =item * B<responseIds>($part): 4764: 4765: Retreives the response IDs for the given part as an array reference containing 4766: strings naming the response IDs. This may be empty. 4767: 4768: =back 4769: 4770: =cut 4771: 4772: sub parts { 4773: my $self = shift; 4774: 4775: if ($self->ext) { return []; } 4776: 4777: $self->extractParts(); 4778: return $self->{PARTS}; 4779: } 4780: 4781: sub countParts { 4782: my $self = shift; 4783: 4784: my $parts = $self->parts(); 4785: 4786: # If I left this here, then it's not necessary. 4787: #my $delta = 0; 4788: #for my $part (@$parts) { 4789: # if ($part eq '0') { $delta--; } 4790: #} 4791: 4792: if ($self->{RESOURCE_ERROR}) { 4793: return 0; 4794: } 4795: 4796: return scalar(@{$parts}); # + $delta; 4797: } 4798: 4799: sub countResponses { 4800: my $self = shift; 4801: my $count; 4802: foreach my $part (@{$self->parts()}) { 4803: $count+= scalar($self->responseIds($part)); 4804: } 4805: return $count; 4806: } 4807: 4808: sub responseTypes { 4809: my $self = shift; 4810: my %responses; 4811: foreach my $part (@{$self->parts()}) { 4812: foreach my $responsetype ($self->responseType($part)) { 4813: $responses{$responsetype}++ if (defined($responsetype)); 4814: } 4815: } 4816: return %responses; 4817: } 4818: 4819: sub multipart { 4820: my $self = shift; 4821: return $self->countParts() > 1; 4822: } 4823: 4824: sub singlepart { 4825: my $self = shift; 4826: return $self->countParts() == 1; 4827: } 4828: 4829: sub responseType { 4830: my $self = shift; 4831: my $part = shift; 4832: 4833: $self->extractParts(); 4834: if (defined($self->{RESPONSE_TYPES}->{$part})) { 4835: return @{$self->{RESPONSE_TYPES}->{$part}}; 4836: } else { 4837: return undef; 4838: } 4839: } 4840: 4841: sub responseIds { 4842: my $self = shift; 4843: my $part = shift; 4844: 4845: $self->extractParts(); 4846: if (defined($self->{RESPONSE_IDS}->{$part})) { 4847: return @{$self->{RESPONSE_IDS}->{$part}}; 4848: } else { 4849: return undef; 4850: } 4851: } 4852: 4853: # Private function: Extracts the parts information, both part names and 4854: # part types, and saves it. 4855: sub extractParts { 4856: my $self = shift; 4857: 4858: return if (defined($self->{PARTS})); 4859: return if ($self->ext); 4860: 4861: $self->{PARTS} = []; 4862: 4863: my %parts; 4864: 4865: # Retrieve part count, if this is a problem 4866: if ($self->is_problem()) { 4867: my $partorder = &Apache::lonnet::metadata($self->src(), 'partorder'); 4868: my $metadata = &Apache::lonnet::metadata($self->src(), 'packages'); 4869: 4870: if ($partorder) { 4871: my @parts; 4872: for my $part (split (/,/,$partorder)) { 4873: if (!Apache::loncommon::check_if_partid_hidden($part, $self->{SYMB})) { 4874: push @parts, $part; 4875: $parts{$part} = 1; 4876: } 4877: } 4878: $self->{PARTS} = \@parts; 4879: } else { 4880: if (!$metadata) { 4881: $self->{RESOURCE_ERROR} = 1; 4882: $self->{PARTS} = []; 4883: $self->{PART_TYPE} = {}; 4884: return; 4885: } 4886: foreach my $entry (split(/\,/,$metadata)) { 4887: if ($entry =~ /^(?:part|Task)_(.*)$/) { 4888: my $part = $1; 4889: # This floods the logs if it blows up 4890: if (defined($parts{$part})) { 4891: &Apache::lonnet::logthis("$part multiply defined in metadata for " . $self->{SYMB}); 4892: } 4893: 4894: # check to see if part is turned off. 4895: 4896: if (!Apache::loncommon::check_if_partid_hidden($part, $self->{SYMB})) { 4897: $parts{$part} = 1; 4898: } 4899: } 4900: } 4901: my @sortedParts = sort(keys(%parts)); 4902: $self->{PARTS} = \@sortedParts; 4903: } 4904: 4905: 4906: # These hashes probably do not need names that end with "Hash".... 4907: my %responseIdHash; 4908: my %responseTypeHash; 4909: 4910: 4911: # Init the responseIdHash 4912: foreach my $part (@{$self->{PARTS}}) { 4913: $responseIdHash{$part} = []; 4914: } 4915: 4916: # Now, the unfortunate thing about this is that parts, part name, and 4917: # response id are delimited by underscores, but both the part 4918: # name and response id can themselves have underscores in them. 4919: # So we have to use our knowlege of part names to figure out 4920: # where the part names begin and end, and even then, it is possible 4921: # to construct ambiguous situations. 4922: foreach my $data (split(/,/, $metadata)) { 4923: if ($data =~ /^([a-zA-Z]+)response_(.*)/ 4924: || $data =~ /^(Task)_(.*)/) { 4925: my $responseType = $1; 4926: my $partStuff = $2; 4927: my $partIdSoFar = ''; 4928: my @partChunks = split(/_/, $partStuff); 4929: my $i = 0; 4930: for ($i = 0; $i < scalar(@partChunks); $i++) { 4931: if ($partIdSoFar) { $partIdSoFar .= '_'; } 4932: $partIdSoFar .= $partChunks[$i]; 4933: if ($parts{$partIdSoFar}) { 4934: my @otherChunks = @partChunks[$i+1..$#partChunks]; 4935: my $responseId = join('_', @otherChunks); 4936: if ($self->is_task()) { 4937: push(@{$responseIdHash{$partIdSoFar}}, 4938: $partIdSoFar); 4939: } else { 4940: push(@{$responseIdHash{$partIdSoFar}}, 4941: $responseId); 4942: } 4943: push(@{$responseTypeHash{$partIdSoFar}}, 4944: $responseType); 4945: } 4946: } 4947: } 4948: } 4949: my $resorder = &Apache::lonnet::metadata($self->src(),'responseorder'); 4950: # 4951: # Reorder the arrays in the %responseIdHash and %responseTypeHash 4952: if ($resorder) { 4953: my @resorder=split(/,/,$resorder); 4954: foreach my $part (keys(%responseIdHash)) { 4955: my $i=0; 4956: my %resids = map { ($_,$i++) } @{ $responseIdHash{$part} }; 4957: my @neworder; 4958: foreach my $possibleid (@resorder) { 4959: if (exists($resids{$possibleid})) { 4960: push(@neworder,$resids{$possibleid}); 4961: } 4962: } 4963: my @ids; 4964: my @type; 4965: foreach my $element (@neworder) { 4966: push (@ids,$responseIdHash{$part}->[$element]); 4967: push (@type,$responseTypeHash{$part}->[$element]); 4968: } 4969: $responseIdHash{$part}=\@ids; 4970: $responseTypeHash{$part}=\@type; 4971: } 4972: } 4973: $self->{RESPONSE_IDS} = \%responseIdHash; 4974: $self->{RESPONSE_TYPES} = \%responseTypeHash; 4975: } 4976: 4977: return; 4978: } 4979: 4980: =pod 4981: 4982: =head2 Resource Status 4983: 4984: Problem resources have status information, reflecting their various 4985: dates and completion statuses. 4986: 4987: There are two aspects to the status: the date-related information and 4988: the completion information. 4989: 4990: Idiomatic usage of these two methods would probably look something 4991: like 4992: 4993: foreach my $part ($resource->parts()) { 4994: my $dateStatus = $resource->getDateStatus($part); 4995: my $completionStatus = $resource->getCompletionStatus($part); 4996: 4997: or 4998: 4999: my $status = $resource->status($part); 5000: 5001: ... use it here ... 5002: } 5003: 5004: Which you use depends on exactly what you are looking for. The 5005: status() function has been optimized for the nav maps display and may 5006: not precisely match what you need elsewhere. 5007: 5008: The symbolic constants shown below can be accessed through the 5009: resource object: C<$res->OPEN>. 5010: 5011: =over 4 5012: 5013: =item * B<getDateStatus>($part): 5014: 5015: ($part defaults to 0). A convenience function that returns a symbolic 5016: constant telling you about the date status of the part. The possible 5017: return values are: 5018: 5019: =back 5020: 5021: B<Date Codes> 5022: 5023: =over 4 5024: 5025: =item * B<OPEN_LATER>: 5026: 5027: The problem will be opened later. 5028: 5029: =item * B<OPEN>: 5030: 5031: Open and not yet due. 5032: 5033: 5034: =item * B<PAST_DUE_ANSWER_LATER>: 5035: 5036: The due date has passed, but the answer date has not yet arrived. 5037: 5038: =item * B<PAST_DUE_NO_ANSWER>: 5039: 5040: The due date has passed and there is no answer opening date set. 5041: 5042: =item * B<ANSWER_OPEN>: 5043: 5044: The answer date is here. 5045: 5046: =item * B<NETWORK_FAILURE>: 5047: 5048: The information is unknown due to network failure. 5049: 5050: =back 5051: 5052: =cut 5053: 5054: # Apparently the compiler optimizes these into constants automatically 5055: sub OPEN_LATER { return 0; } 5056: sub OPEN { return 1; } 5057: sub PAST_DUE_NO_ANSWER { return 2; } 5058: sub PAST_DUE_ANSWER_LATER { return 3; } 5059: sub ANSWER_OPEN { return 4; } 5060: sub NOTHING_SET { return 5; } 5061: sub NETWORK_FAILURE { return 100; } 5062: 5063: # getDateStatus gets the date status for a given problem part. 5064: # Because answer date, due date, and open date are fully independent 5065: # (i.e., it is perfectly possible to *only* have an answer date), 5066: # we have to completely cover the 3x3 maxtrix of (answer, due, open) x 5067: # (past, future, none given). This function handles this with a decision 5068: # tree. Read the comments to follow the decision tree. 5069: 5070: sub getDateStatus { 5071: my $self = shift; 5072: my $part = shift; 5073: $part = "0" if (!defined($part)); 5074: 5075: # Always return network failure if there was one. 5076: return $self->NETWORK_FAILURE if ($self->{NAV_MAP}->{NETWORK_FAILURE}); 5077: 5078: my $now = time(); 5079: 5080: my $open = $self->opendate($part); 5081: my $due = $self->duedate($part); 5082: my $answer = $self->answerdate($part); 5083: 5084: if (!$open && !$due && !$answer) { 5085: # no data on the problem at all 5086: # should this be the same as "open later"? think multipart. 5087: return $self->NOTHING_SET; 5088: } 5089: if (!$open || $now < $open) {return $self->OPEN_LATER} 5090: if (!$due || $now < $due) {return $self->OPEN} 5091: if ($answer && $now < $answer) {return $self->PAST_DUE_ANSWER_LATER} 5092: if ($answer) { return $self->ANSWER_OPEN; } 5093: return PAST_DUE_NO_ANSWER; 5094: } 5095: 5096: =pod 5097: 5098: B<> 5099: 5100: =over 4 5101: 5102: =item * B<getCompletionStatus>($part): 5103: 5104: ($part defaults to 0.) A convenience function that returns a symbolic 5105: constant telling you about the completion status of the part, with the 5106: following possible results: 5107: 5108: =back 5109: 5110: B<Completion Codes> 5111: 5112: =over 4 5113: 5114: =item * B<NOT_ATTEMPTED>: 5115: 5116: Has not been attempted at all. 5117: 5118: =item * B<INCORRECT>: 5119: 5120: Attempted, but wrong by student. 5121: 5122: =item * B<INCORRECT_BY_OVERRIDE>: 5123: 5124: Attempted, but wrong by instructor override. 5125: 5126: =item * B<CORRECT>: 5127: 5128: Correct or correct by instructor. 5129: 5130: =item * B<CORRECT_BY_OVERRIDE>: 5131: 5132: Correct by instructor override. 5133: 5134: =item * B<EXCUSED>: 5135: 5136: Excused. Not yet implemented. 5137: 5138: =item * B<NETWORK_FAILURE>: 5139: 5140: Information not available due to network failure. 5141: 5142: =item * B<ATTEMPTED>: 5143: 5144: Attempted, and not yet graded. 5145: 5146: =item * B<CREDIT_ATTEMPTED>: 5147: 5148: Attempted, and credit received for attempt (survey and anonymous survey only). 5149: 5150: =back 5151: 5152: =cut 5153: 5154: sub NOT_ATTEMPTED { return 10; } 5155: sub INCORRECT { return 11; } 5156: sub INCORRECT_BY_OVERRIDE { return 12; } 5157: sub CORRECT { return 13; } 5158: sub CORRECT_BY_OVERRIDE { return 14; } 5159: sub EXCUSED { return 15; } 5160: sub ATTEMPTED { return 16; } 5161: sub CREDIT_ATTEMPTED { return 17; } 5162: 5163: sub getCompletionStatus { 5164: my $self = shift; 5165: my $part = shift; 5166: return $self->NETWORK_FAILURE if ($self->{NAV_MAP}->{NETWORK_FAILURE}); 5167: 5168: my $status = $self->queryRestoreHash('solved', $part); 5169: 5170: # Left as separate if statements in case we ever do more with this 5171: if ($status eq 'correct_by_student') {return $self->CORRECT;} 5172: if ($status eq 'correct_by_scantron') {return $self->CORRECT;} 5173: if ($status eq 'correct_by_override') { 5174: return $self->CORRECT_BY_OVERRIDE; 5175: } 5176: if ($status eq 'incorrect_attempted') {return $self->INCORRECT; } 5177: if ($status eq 'incorrect_by_override') {return $self->INCORRECT_BY_OVERRIDE; } 5178: if ($status eq 'excused') {return $self->EXCUSED; } 5179: if ($status eq 'ungraded_attempted') {return $self->ATTEMPTED; } 5180: if ($status eq 'credit_attempted') { 5181: if ($self->is_anonsurvey($part) || $self->is_survey($part)) { 5182: return $self->CREDIT_ATTEMPTED; 5183: } else { 5184: return $self->ATTEMPTED; 5185: } 5186: } 5187: return $self->NOT_ATTEMPTED; 5188: } 5189: 5190: sub queryRestoreHash { 5191: my $self = shift; 5192: my $hashentry = shift; 5193: my $part = shift; 5194: $part = "0" if (!defined($part) || $part eq ''); 5195: return $self->NETWORK_FAILURE if ($self->{NAV_MAP}->{NETWORK_FAILURE}); 5196: 5197: $self->getReturnHash(); 5198: 5199: return $self->{RETURN_HASH}->{'resource.'.$part.'.'.$hashentry}; 5200: } 5201: 5202: =pod 5203: 5204: B<Composite Status> 5205: 5206: Along with directly returning the date or completion status, the 5207: resource object includes a convenience function B<status>() that will 5208: combine the two status tidbits into one composite status that can 5209: represent the status of the resource as a whole. This method represents 5210: the concept of the thing we want to display to the user on the nav maps 5211: screen, which is a combination of completion and open status. The precise logic is 5212: documented in the comments of the status method. The following results 5213: may be returned, all available as methods on the resource object 5214: ($res->NETWORK_FAILURE): In addition to the return values that match 5215: the date or completion status, this function can return "ANSWER_SUBMITTED" 5216: if that problemstatus parameter value is set to No, suppressing the 5217: incorrect/correct feedback. 5218: 5219: =over 4 5220: 5221: =item * B<NETWORK_FAILURE>: 5222: 5223: The network has failed and the information is not available. 5224: 5225: =item * B<NOTHING_SET>: 5226: 5227: No dates have been set for this problem (part) at all. (Because only 5228: certain parts of a multi-part problem may be assigned, this can not be 5229: collapsed into "open later", as we do not know a given part will EVER 5230: be opened. For single part, this is the same as "OPEN_LATER".) 5231: 5232: =item * B<CORRECT>: 5233: 5234: For any reason at all, the part is considered correct. 5235: 5236: =item * B<EXCUSED>: 5237: 5238: For any reason at all, the problem is excused. 5239: 5240: =item * B<PAST_DUE_NO_ANSWER>: 5241: 5242: The problem is past due, not considered correct, and no answer date is 5243: set. 5244: 5245: =item * B<PAST_DUE_ANSWER_LATER>: 5246: 5247: The problem is past due, not considered correct, and an answer date in 5248: the future is set. 5249: 5250: =item * B<ANSWER_OPEN>: 5251: 5252: The problem is past due, not correct, and the answer is now available. 5253: 5254: =item * B<OPEN_LATER>: 5255: 5256: The problem is not yet open. 5257: 5258: =item * B<TRIES_LEFT>: 5259: 5260: The problem is open, has been tried, is not correct, but there are 5261: tries left. 5262: 5263: =item * B<INCORRECT>: 5264: 5265: The problem is open, and all tries have been used without getting the 5266: correct answer. 5267: 5268: =item * B<OPEN>: 5269: 5270: The item is open and not yet tried. 5271: 5272: =item * B<ATTEMPTED>: 5273: 5274: The problem has been attempted. 5275: 5276: =item * B<CREDIT_ATTEMPTED>: 5277: 5278: The problem has been attempted, and credit given for the attempt (survey and anonymous survey only). 5279: 5280: =item * B<ANSWER_SUBMITTED>: 5281: 5282: An answer has been submitted, but the student should not see it. 5283: 5284: =back 5285: 5286: =cut 5287: 5288: sub TRIES_LEFT { return 20; } 5289: sub ANSWER_SUBMITTED { return 21; } 5290: sub PARTIALLY_CORRECT { return 22; } 5291: 5292: sub RESERVED_LATER { return 30; } 5293: sub RESERVED { return 31; } 5294: sub RESERVED_LOCATION { return 32; } 5295: sub RESERVABLE { return 33; } 5296: sub RESERVABLE_LATER { return 34; } 5297: sub NOTRESERVABLE { return 35; } 5298: sub NOT_IN_A_SLOT { return 36; } 5299: sub NEEDS_CHECKIN { return 37; } 5300: sub WAITING_FOR_GRADE { return 38; } 5301: sub UNKNOWN { return 39; } 5302: 5303: sub status { 5304: my $self = shift; 5305: my $part = shift; 5306: if (!defined($part)) { $part = "0"; } 5307: my $completionStatus = $self->getCompletionStatus($part); 5308: my $dateStatus = $self->getDateStatus($part); 5309: 5310: # What we have is a two-dimensional matrix with 4 entries on one 5311: # dimension and 5 entries on the other, which we want to colorize, 5312: # plus network failure and "no date data at all". 5313: 5314: #if ($self->{RESOURCE_ERROR}) { return NETWORK_FAILURE; } 5315: if ($completionStatus == NETWORK_FAILURE) { return NETWORK_FAILURE; } 5316: 5317: my $suppressFeedback = 0; 5318: if (($self->problemstatus($part) eq 'no') || 5319: ($self->problemstatus($part) eq 'no_feedback_ever')) { 5320: $suppressFeedback = 1; 5321: } 5322: # If there's an answer date and we're past it, don't 5323: # suppress the feedback; student should know 5324: if ($self->duedate($part) && $self->duedate($part) < time() && 5325: $self->answerdate($part) && $self->answerdate($part) < time()) { 5326: $suppressFeedback = 0; 5327: } 5328: 5329: # There are a few whole rows we can dispose of: 5330: if ($completionStatus == CORRECT || 5331: $completionStatus == CORRECT_BY_OVERRIDE ) { 5332: if ( $suppressFeedback ) { return ANSWER_SUBMITTED } 5333: my $awarded=$self->awarded($part); 5334: if ($awarded < 1 && $awarded > 0) { 5335: return PARTIALLY_CORRECT; 5336: } elsif ($awarded<1) { 5337: return INCORRECT; 5338: } 5339: return CORRECT; 5340: } 5341: 5342: # If it's WRONG... and not open 5343: if ( ($completionStatus == INCORRECT || 5344: $completionStatus == INCORRECT_BY_OVERRIDE) 5345: && (!$self->opendate($part) || $self->opendate($part) > time()) ) { 5346: return INCORRECT; 5347: } 5348: 5349: if ($completionStatus == ATTEMPTED) { 5350: return ATTEMPTED; 5351: } 5352: 5353: if ($completionStatus == CREDIT_ATTEMPTED) { 5354: return CREDIT_ATTEMPTED; 5355: } 5356: 5357: # If it's EXCUSED, then return that no matter what 5358: if ($completionStatus == EXCUSED) { 5359: return EXCUSED; 5360: } 5361: 5362: if ($dateStatus == NOTHING_SET) { 5363: return NOTHING_SET; 5364: } 5365: 5366: # Now we're down to a 4 (incorrect, incorrect_override, not_attempted) 5367: # by 4 matrix (date statuses). 5368: 5369: if ($dateStatus == PAST_DUE_ANSWER_LATER || 5370: $dateStatus == PAST_DUE_NO_ANSWER ) { 5371: return $suppressFeedback ? ANSWER_SUBMITTED : $dateStatus; 5372: } 5373: 5374: if ($dateStatus == ANSWER_OPEN) { 5375: return ANSWER_OPEN; 5376: } 5377: 5378: # Now: (incorrect, incorrect_override, not_attempted) x 5379: # (open_later), (open) 5380: 5381: if ($dateStatus == OPEN_LATER) { 5382: return OPEN_LATER; 5383: } 5384: 5385: # If it's WRONG... 5386: if ($completionStatus == INCORRECT || $completionStatus == INCORRECT_BY_OVERRIDE) { 5387: # and there are TRIES LEFT: 5388: if ($self->tries($part) < $self->maxtries($part) || !$self->maxtries($part)) { 5389: return $suppressFeedback ? ANSWER_SUBMITTED : TRIES_LEFT; 5390: } 5391: return $suppressFeedback ? ANSWER_SUBMITTED : INCORRECT; # otherwise, return orange; student can't fix this 5392: } 5393: 5394: # Otherwise, it's untried and open 5395: return OPEN; 5396: } 5397: 5398: sub check_for_slot { 5399: my $self = shift; 5400: my $part = shift; 5401: my $symb = $self->{SYMB}; 5402: my ($use_slots,$available,$availablestudent) = $self->slot_control($part); 5403: if (($use_slots ne '') && ($use_slots !~ /^\s*no\s*$/i)) { 5404: my @slots = (split(/:/,$availablestudent),split(/:/,$available)); 5405: my $cid=$env{'request.course.id'}; 5406: my $cdom=$env{'course.'.$cid.'.domain'}; 5407: my $cnum=$env{'course.'.$cid.'.num'}; 5408: my $now = time; 5409: my $num_usable_slots = 0; 5410: if (@slots > 0) { 5411: my %slots=&Apache::lonnet::get('slots',[@slots],$cdom,$cnum); 5412: if (&Apache::lonnet::error(%slots)) { 5413: return (UNKNOWN); 5414: } 5415: my @sorted_slots = &Apache::loncommon::sorted_slots(\@slots,\%slots,'starttime'); 5416: my ($checkedin,$checkedinslot); 5417: my ($map) = &Apache::lonnet::decode_symb($symb); 5418: foreach my $slot_name (@sorted_slots) { 5419: next if (!defined($slots{$slot_name}) || !ref($slots{$slot_name})); 5420: my $end = $slots{$slot_name}->{'endtime'}; 5421: my $start = $slots{$slot_name}->{'starttime'}; 5422: my $ip = $slots{$slot_name}->{'ip'}; 5423: if ($self->simpleStatus() == OPEN) { 5424: if ($end > $now) { 5425: if ($start > $now) { 5426: return (RESERVED_LATER,$start,$slot_name); 5427: } else { 5428: if ($ip ne '') { 5429: if (!&Apache::loncommon::check_ip_acc($ip)) { 5430: return (RESERVED_LOCATION,$end,$slot_name); 5431: } 5432: } 5433: my @proctors; 5434: if ($slots{$slot_name}->{'proctor'} ne '') { 5435: @proctors = split(',',$slots{$slot_name}->{'proctor'}); 5436: } 5437: if (@proctors > 0) { 5438: ($checkedin,$checkedinslot) = $self->checkedin(); 5439: unless ((grep(/^\Q$checkedin\E/,@proctors)) && 5440: ($checkedinslot eq $slot_name)) { 5441: return (NEEDS_CHECKIN,undef,$slot_name); 5442: } 5443: } 5444: return (RESERVED,$end,$slot_name); 5445: } 5446: } 5447: } elsif ($end > $now) { 5448: $num_usable_slots ++; 5449: } 5450: } 5451: my ($is_correct,$got_grade); 5452: if ($self->is_task()) { 5453: my $taskstatus = $self->taskstatus(); 5454: $is_correct = (($taskstatus eq 'pass') || 5455: ($self->solved() =~ /^correct_/)); 5456: $got_grade = ($taskstatus =~ /^(?:pass|fail)$/); 5457: } else { 5458: $got_grade = 1; 5459: $is_correct = ($self->solved() =~ /^correct_/); 5460: } 5461: ($checkedin,$checkedinslot) = $self->checkedin(); 5462: if ($checkedin) { 5463: if (!$got_grade) { 5464: return (WAITING_FOR_GRADE); 5465: } elsif ($is_correct) { 5466: return (CORRECT); 5467: } 5468: } 5469: if ($num_usable_slots) { 5470: return(NOT_IN_A_SLOT); 5471: } 5472: } 5473: my $reservable = &Apache::lonnet::get_reservable_slots($cnum,$cdom,$env{'user.name'}, 5474: $env{'user.domain'}); 5475: if (ref($reservable) eq 'HASH') { 5476: if ((ref($reservable->{'now_order'}) eq 'ARRAY') && (ref($reservable->{'now'}) eq 'HASH')) { 5477: foreach my $slot (reverse (@{$reservable->{'now_order'}})) { 5478: my $canuse; 5479: if ($reservable->{'now'}{$slot}{'symb'} eq '') { 5480: $canuse = 1; 5481: } else { 5482: my %oksymbs; 5483: my @slotsymbs = split(/\s*,\s*/,$reservable->{'now'}{$slot}{'symb'}); 5484: map { $oksymbs{$_} = 1; } @slotsymbs; 5485: if ($oksymbs{$symb}) { 5486: $canuse = 1; 5487: } else { 5488: foreach my $item (@slotsymbs) { 5489: if ($item =~ /\.(page|sequence)$/) { 5490: (undef,undef, my $sloturl) = &Apache::lonnet::decode_symb($item); 5491: if (($map ne '') && ($map eq $sloturl)) { 5492: $canuse = 1; 5493: last; 5494: } 5495: } 5496: } 5497: } 5498: } 5499: if ($canuse) { 5500: return(RESERVABLE,$reservable->{'now'}{$slot}{'endreserve'}); 5501: } 5502: } 5503: } 5504: if ((ref($reservable->{'future_order'}) eq 'ARRAY') && (ref($reservable->{'future'}) eq 'HASH')) { 5505: foreach my $slot (@{$reservable->{'future_order'}}) { 5506: my $canuse; 5507: if ($reservable->{'future'}{$slot}{'symb'} eq '') { 5508: $canuse = 1; 5509: } elsif ($reservable->{'future'}{$slot}{'symb'} =~ /,/) { 5510: my %oksymbs; 5511: my @slotsymbs = split(/\s*,\s*/,$reservable->{'future'}{$slot}{'symb'}); 5512: map { $oksymbs{$_} = 1; } @slotsymbs; 5513: if ($oksymbs{$symb}) { 5514: $canuse = 1; 5515: } else { 5516: foreach my $item (@slotsymbs) { 5517: if ($item =~ /\.(page|sequence)$/) { 5518: (undef,undef, my $sloturl) = &Apache::lonnet::decode_symb($item); 5519: if (($map ne '') && ($map eq $sloturl)) { 5520: $canuse = 1; 5521: last; 5522: } 5523: } 5524: } 5525: } 5526: } elsif ($reservable->{'future'}{$slot}{'symb'} eq $symb) { 5527: $canuse = 1; 5528: } 5529: if ($canuse) { 5530: return(RESERVABLE_LATER,$reservable->{'future'}{$slot}{'startreserve'}); 5531: } 5532: } 5533: } 5534: } 5535: return(NOTRESERVABLE); 5536: } 5537: return; 5538: } 5539: 5540: sub CLOSED { return 23; } 5541: sub ERROR { return 24; } 5542: 5543: =pod 5544: 5545: B<Simple Status> 5546: 5547: Convenience method B<simpleStatus> provides a "simple status" for the resource. 5548: "Simple status" corresponds to "which icon is shown on the 5549: Navmaps". There are six "simple" statuses: 5550: 5551: =over 4 5552: 5553: =item * B<CLOSED>: The problem is currently closed. (No icon shown.) 5554: 5555: =item * B<OPEN>: The problem is open and unattempted. 5556: 5557: =item * B<CORRECT>: The problem is correct for any reason. 5558: 5559: =item * B<INCORRECT>: The problem is incorrect and can still be 5560: completed successfully. 5561: 5562: =item * B<ATTEMPTED>: The problem has been attempted, but the student 5563: does not know if they are correct. (The ellipsis icon.) 5564: 5565: =item * B<ERROR>: There is an error retrieving information about this 5566: problem. 5567: 5568: =back 5569: 5570: =cut 5571: 5572: # This hash maps the composite status to this simple status, and 5573: # can be used directly, if you like 5574: my %compositeToSimple = 5575: ( 5576: NETWORK_FAILURE() => ERROR, 5577: NOTHING_SET() => CLOSED, 5578: CORRECT() => CORRECT, 5579: PARTIALLY_CORRECT() => PARTIALLY_CORRECT, 5580: EXCUSED() => CORRECT, 5581: PAST_DUE_NO_ANSWER() => INCORRECT, 5582: PAST_DUE_ANSWER_LATER() => INCORRECT, 5583: ANSWER_OPEN() => INCORRECT, 5584: OPEN_LATER() => CLOSED, 5585: TRIES_LEFT() => OPEN, 5586: INCORRECT() => INCORRECT, 5587: OPEN() => OPEN, 5588: ATTEMPTED() => ATTEMPTED, 5589: CREDIT_ATTEMPTED() => CORRECT, 5590: ANSWER_SUBMITTED() => ATTEMPTED 5591: ); 5592: 5593: sub simpleStatus { 5594: my $self = shift; 5595: my $part = shift; 5596: my $status = $self->status($part); 5597: return $compositeToSimple{$status}; 5598: } 5599: 5600: =pod 5601: 5602: B<simpleStatusCount> will return an array reference containing, in 5603: this order, the number of OPEN, CLOSED, CORRECT, INCORRECT, ATTEMPTED, 5604: and ERROR parts the given problem has. 5605: 5606: =cut 5607: 5608: # This maps the status to the slot we want to increment 5609: my %statusToSlotMap = 5610: ( 5611: OPEN() => 0, 5612: CLOSED() => 1, 5613: CORRECT() => 2, 5614: INCORRECT() => 3, 5615: ATTEMPTED() => 4, 5616: ERROR() => 5 5617: ); 5618: 5619: sub statusToSlot { return $statusToSlotMap{shift()}; } 5620: 5621: sub simpleStatusCount { 5622: my $self = shift; 5623: 5624: my @counts = (0, 0, 0, 0, 0, 0, 0); 5625: foreach my $part (@{$self->parts()}) { 5626: $counts[$statusToSlotMap{$self->simpleStatus($part)}]++; 5627: } 5628: 5629: return \@counts; 5630: } 5631: 5632: =pod 5633: 5634: B<Completable> 5635: 5636: The completable method represents the concept of I<whether the student can 5637: currently do the problem>. If the student can do the problem, which means 5638: that it is open, there are tries left, and if the problem is manually graded 5639: or the grade is suppressed via problemstatus, the student has not tried it 5640: yet, then the method returns 1. Otherwise, it returns 0, to indicate that 5641: either the student has tried it and there is no feedback, or that for 5642: some reason it is no longer completable (not open yet, successfully completed, 5643: out of tries, etc.). As an example, this is used as the filter for the 5644: "Uncompleted Homework" option for the nav maps. 5645: 5646: If this does not quite meet your needs, do not fiddle with it (unless you are 5647: fixing it to better match the student's conception of "completable" because 5648: it's broken somehow)... make a new method. 5649: 5650: =cut 5651: 5652: sub completable { 5653: my $self = shift; 5654: if (!$self->is_problem()) { return 0; } 5655: my $partCount = $self->countParts(); 5656: 5657: foreach my $part (@{$self->parts()}) { 5658: if ($part eq '0' && $partCount != 1) { next; } 5659: my $status = $self->status($part); 5660: # "If any of the parts are open, or have tries left (implies open), 5661: # and it is not "attempted" (manually graded problem), it is 5662: # not "complete" 5663: if ($self->getCompletionStatus($part) == ATTEMPTED() || 5664: $self->getCompletionStatus($part) == CREDIT_ATTEMPTED() || 5665: $status == ANSWER_SUBMITTED() ) { 5666: # did this part already, as well as we can 5667: next; 5668: } 5669: if ($status == OPEN() || $status == TRIES_LEFT()) { 5670: return 1; 5671: } 5672: } 5673: 5674: # If all the parts were complete, so was this problem. 5675: return 0; 5676: } 5677: 5678: =pod 5679: 5680: B<Answerable> 5681: 5682: The answerable method differs from the completable method in its handling of problem parts 5683: for which feedback on correctness is suppressed, but the student still has tries left, and 5684: the problem part is not past due, (i.e., the student could submit a different answer if 5685: he/she so chose). For that case completable will return 0, whereas answerable will return 1. 5686: 5687: =cut 5688: 5689: sub answerable { 5690: my $self = shift; 5691: if (!$self->is_problem()) { return 0; } 5692: my $partCount = $self->countParts(); 5693: foreach my $part (@{$self->parts()}) { 5694: if ($part eq '0' && $partCount != 1) { next; } 5695: my $status = $self->status($part); 5696: if ($self->getCompletionStatus($part) == ATTEMPTED() || 5697: $self->getCompletionStatus($part) == CREDIT_ATTEMPTED() || 5698: $status == ANSWER_SUBMITTED() ) { 5699: if ($self->tries($part) < $self->maxtries($part) || !$self->maxtries($part)) { 5700: return 1; 5701: } 5702: } 5703: if ($status == OPEN() || $status == TRIES_LEFT() || $status == NETWORK_FAILURE()) { 5704: return 1; 5705: } 5706: } 5707: # None of the parts were answerable, so neither is this problem. 5708: return 0; 5709: } 5710: 5711: =pod 5712: 5713: =head2 Resource/Nav Map Navigation 5714: 5715: =over 4 5716: 5717: =item * B<getNext>(): 5718: 5719: Retreive an array of the possible next resources after this 5720: one. Always returns an array, even in the one- or zero-element case. 5721: 5722: =item * B<getPrevious>(): 5723: 5724: Retreive an array of the possible previous resources from this 5725: one. Always returns an array, even in the one- or zero-element case. 5726: 5727: =cut 5728: 5729: sub getNext { 5730: my $self = shift; 5731: my @branches; 5732: my $to = $self->to(); 5733: foreach my $branch ( split(/,/, $to) ) { 5734: my $choice = $self->{NAV_MAP}->getById($branch); 5735: #if (!$choice->condition()) { next; } 5736: my $next = $choice->goesto(); 5737: $next = $self->{NAV_MAP}->getById($next); 5738: 5739: push @branches, $next; 5740: } 5741: return \@branches; 5742: } 5743: 5744: sub getPrevious { 5745: my $self = shift; 5746: my @branches; 5747: my $from = $self->from(); 5748: foreach my $branch ( split(/,/, $from)) { 5749: my $choice = $self->{NAV_MAP}->getById($branch); 5750: my $prev = $choice->comesfrom(); 5751: $prev = $self->{NAV_MAP}->getById($prev); 5752: 5753: push @branches, $prev; 5754: } 5755: return \@branches; 5756: } 5757: 5758: sub browsePriv { 5759: my $self = shift; 5760: my $noblockcheck = shift; 5761: if (defined($self->{BROWSE_PRIV})) { 5762: return $self->{BROWSE_PRIV}; 5763: } 5764: 5765: $self->{BROWSE_PRIV} = &Apache::lonnet::allowed('bre',$self->src(), 5766: $self->{SYMB},undef, 5767: undef,$noblockcheck); 5768: } 5769: 5770: =pod 5771: 5772: =back 5773: 5774: =cut 5775: 5776: 1; 5777: 5778: __END__ 5779: 5780: