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