Annotation of loncom/interface/lonnavmaps.pm, revision 1.129.2.3

1.72      bowersj2    1: 
1.2       www         2: # The LearningOnline Network with CAPA
                      3: # Navigate Maps Handler
1.1       www         4: #
1.129.2.3! albertel    5: # $Id: lonnavmaps.pm,v 1.129.2.2 2003/03/20 20:40:42 albertel Exp $
1.20      albertel    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: #
1.2       www        29: # (Page Handler
1.1       www        30: #
1.2       www        31: # (TeX Content Handler
1.1       www        32: #
1.2       www        33: # 05/29/00,05/30 Gerd Kortemeyer)
                     34: # 08/30,08/31,09/06,09/14,09/15,09/16,09/19,09/20,09/21,09/23,
                     35: # 10/02,10/10,10/14,10/16,10/18,10/19,10/31,11/6,11/14,11/16 Gerd Kortemeyer)
1.1       www        36: #
1.17      www        37: # 3/1/1,6/1,17/1,29/1,30/1,2/8,9/21,9/24,9/25 Gerd Kortemeyer
1.21      www        38: # YEAR=2002
                     39: # 1/1 Gerd Kortemeyer
1.105     bowersj2   40: # Oct-Nov Jeremy Bowers
1.2       www        41: 
1.1       www        42: package Apache::lonnavmaps;
                     43: 
                     44: use strict;
1.2       www        45: use Apache::Constants qw(:common :http);
1.18      albertel   46: use Apache::loncommon();
1.73      bowersj2   47: use POSIX qw (floor strftime);
1.2       www        48: 
1.1       www        49: sub handler {
1.99      bowersj2   50:     my $r = shift;
1.118     bowersj2   51:     real_handler($r);
                     52: }
                     53: 
                     54: sub real_handler {
                     55:     my $r = shift;
1.2       www        56: 
1.51      bowersj2   57:     &Apache::loncommon::get_unprocessed_cgi($ENV{QUERY_STRING});
                     58: 
                     59:     # Handle header-only request
                     60:     if ($r->header_only) {
                     61:         if ($ENV{'browser.mathml'}) {
                     62:             $r->content_type('text/xml');
                     63:         } else {
                     64:             $r->content_type('text/html');
                     65:         }
                     66:         $r->send_http_header;
                     67:         return OK;
                     68:     }
                     69: 
                     70:     # Send header, don't cache this page
                     71:     if ($ENV{'browser.mathml'}) {
                     72:         $r->content_type('text/xml');
                     73:     } else {
                     74:         $r->content_type('text/html');
                     75:     }
                     76:     &Apache::loncommon::no_cache($r);
                     77:     $r->send_http_header;
                     78: 
1.106     bowersj2   79:     # Create the nav map
1.51      bowersj2   80:     my $navmap = Apache::lonnavmaps::navmap->new(
                     81:                         $ENV{"request.course.fn"}.".db",
1.80      bowersj2   82:                         $ENV{"request.course.fn"}."_parms.db", 1, 1);
1.51      bowersj2   83: 
1.55      bowersj2   84: 
                     85:     if (!defined($navmap)) {
                     86:         my $requrl = $r->uri;
                     87:         $ENV{'user.error.msg'} = "$requrl:bre:0:0:Course not initialized";
                     88:         return HTTP_NOT_ACCEPTABLE;
                     89:     }
1.64      bowersj2   90: 
1.111     bowersj2   91:     $r->print("<html><head>\n");
1.118     bowersj2   92:     $r->print("<title>Navigate Course Contents</title></head>");
1.111     bowersj2   93: 
1.64      bowersj2   94:     # Header
1.111     bowersj2   95:     $r->print(&Apache::loncommon::bodytag('Navigate Course Contents','',
1.64      bowersj2   96:                                           ''));
                     97:     $r->print('<script>window.focus();</script>');
1.101     bowersj2   98: 
1.124     bowersj2   99:     $r->rflush();
                    100: 
                    101:     # Now that we've displayed some stuff to the user, init the navmap
                    102:     $navmap->init();
                    103: 
1.95      bowersj2  104:     $r->print('<table border="0" cellpadding="2" cellspacing="0">');
1.64      bowersj2  105:     my $date=localtime;
1.95      bowersj2  106:     $r->print('<tr><td align="right" valign="bottom">Key:&nbsp;&nbsp;</td>');
1.101     bowersj2  107: 
                    108:     # Print discussions and feedback header
1.65      bowersj2  109:     if ($navmap->{LAST_CHECK}) {
1.95      bowersj2  110:         $r->print('<td align="center" valign="bottom">&nbsp;&nbsp;'.
                    111:                   '<img src="/adm/lonMisc/chat.gif"> New discussion since '.
1.73      bowersj2  112:                   strftime("%A, %b %e at %I:%M %P", localtime($navmap->{LAST_CHECK})).
1.95      bowersj2  113:                   '</td><td align="center" valign="bottom">&nbsp;&nbsp;'.
                    114:                   '<img src="/adm/lonMisc/feedback.gif"> New message (click to open)<p>'.
                    115:                   '</td>'); 
                    116:     } else {
                    117:         $r->print('<td align="center" valign="bottom">&nbsp;&nbsp;'.
                    118:                   '<img src="/adm/lonMisc/chat.gif"> Discussions</td><td align="center" valign="bottom">'.
                    119:                   '&nbsp;&nbsp;<img src="/adm/lonMisc/feedback.gif"> New message (click to open)'.
                    120:                   '</td>'); 
                    121:     }
                    122:     $r->print('</tr></table>');
1.101     bowersj2  123: 
1.95      bowersj2  124:     my $condition = 0;
                    125:     if ($ENV{'form.condition'}) {
                    126:         $condition = 1;
                    127:     }
                    128: 
1.118     bowersj2  129:     # Determine where the "here" marker is and where the screen jumps to.
                    130:     my $SYMB = 1; my $URL = 2; my $NOTHING = 3; # symbolic constants
                    131:     my $hereType; # the type of marker, $SYMB, $URL, or $NOTHING
                    132:     my $here; # the actual URL or SYMB for the here marker
                    133:     my $jumpType; # The type of the thing we have a jump for, $SYMB or $URL
                    134:     my $jump; # the SYMB/URL of the resource we need to jump to
                    135: 
                    136:     if ( $ENV{'form.alreadyHere'} ) { # we came from a user's manipulation of the nav page
                    137:         # If this is a click on a folder or something, we want to preserve the "here"
                    138:         # from the querystring, and get the new "jump" marker
                    139:         $hereType = $ENV{'form.hereType'};
                    140:         $here = $ENV{'form.here'};
                    141:         $jumpType = $ENV{'form.jumpType'} || $NOTHING;
                    142:         $jump = $ENV{'form.jump'};
                    143:     } else { # the user is visiting the nav map from the remote
                    144:         # We're coming from the remote. We have either a url, a symb, or nothing,
                    145:         # and we need to figure out what.
                    146:         # Preference: Symb
                    147:         
                    148:         if ($ENV{'form.symb'}) {
                    149:             $hereType = $jumpType = $SYMB;
                    150:             $here = $jump = $ENV{'form.symb'};
                    151:         } elsif ($ENV{'form.postdata'}) {
                    152:             # couldn't find a symb, is there a URL?
                    153:             my $currenturl = $ENV{'form.postdata'};
                    154:             $currenturl=~s/^http\:\/\///;
                    155:             $currenturl=~s/^[^\/]+//;
                    156: 
                    157:             $hereType = $jumpType = $URL;
                    158:             $here = $jump = $currenturl;
                    159:         } else {
                    160:             # Nothing
                    161:             $hereType = $jumpType = $NOTHING;
                    162:         }
                    163:     }
1.110     bowersj2  164: 
1.118     bowersj2  165:     
1.110     bowersj2  166:     # alreadyHere allows us to only open the maps necessary to view
                    167:     # the current location once, while at the same time remembering
                    168:     # the current location. Without that check, the user would never
                    169:     # be able to close those maps; the user would close it, and the
                    170:     # currenturl scan would re-open it.
1.118     bowersj2  171:     my $queryAdd = "&alreadyHere=1";
1.110     bowersj2  172: 
1.95      bowersj2  173:     if ($condition) {
1.118     bowersj2  174:         $r->print("<a href=\"navmaps?condition=0&filter=&$queryAdd" .
                    175:                   "&hereType=$hereType&here=" . Apache::lonnet::escape($here) .
                    176:                   "\">Close All Folders</a>");
1.65      bowersj2  177:     } else {
1.118     bowersj2  178:         $r->print("<a href=\"navmaps?condition=1&filter=&$queryAdd" .
                    179:                   "&hereType=$hereType&here=" . Apache::lonnet::escape($here) . 
                    180:                   "\">Open All Folders</a>");
1.65      bowersj2  181:     }
1.55      bowersj2  182: 
1.95      bowersj2  183:     $r->print('<br>&nbsp;');
                    184:     $r->rflush();
                    185: 
1.55      bowersj2  186:     # Check that it's defined
                    187:     if (!($navmap->courseMapDefined())) {
                    188:         $r->print('<font size="+2" color="red">Coursemap undefined.</font>' .
                    189:                   '</body></html>');
                    190:         return OK;
                    191:     }
                    192: 
1.51      bowersj2  193:     # Grab a resource object so we have access to the constants; this
                    194:     # is technically not proper, but should be harmless
                    195:     my $res = $navmap->firstResource();
                    196: 
1.101     bowersj2  197:     # These are some data tables, which make it easy to change some of
                    198:     # of the specific visualization parameters if desired.
                    199: 
1.51      bowersj2  200:     # Defines a status->color mapping, null string means don't color
                    201:     my %colormap = 
1.54      bowersj2  202:     ( $res->NETWORK_FAILURE        => '',
1.59      bowersj2  203:       $res->CORRECT                => '',
1.112     bowersj2  204:       $res->EXCUSED                => '#3333FF',
1.59      bowersj2  205:       $res->PAST_DUE_ANSWER_LATER  => '',
                    206:       $res->PAST_DUE_NO_ANSWER     => '',
1.112     bowersj2  207:       $res->ANSWER_OPEN            => '#006600',
1.54      bowersj2  208:       $res->OPEN_LATER             => '',
1.59      bowersj2  209:       $res->TRIES_LEFT             => '',
                    210:       $res->INCORRECT              => '',
                    211:       $res->OPEN                   => '',
1.54      bowersj2  212:       $res->NOTHING_SET            => ''        );
1.59      bowersj2  213:     # And a special case in the nav map; what to do when the assignment
                    214:     # is not yet done and due in less then 24 hours
1.86      bowersj2  215:     my $hurryUpColor = "#FF0000";
1.59      bowersj2  216: 
1.115     bowersj2  217:     # Keep these mappings in sync with lonquickgrades, which uses the colors
                    218:     # instead of the icons.
1.59      bowersj2  219:     my %statusIconMap = 
1.66      bowersj2  220:         ( $res->NETWORK_FAILURE    => '',
                    221:           $res->NOTHING_SET        => '',
                    222:           $res->CORRECT            => 'navmap.correct.gif',
                    223:           $res->EXCUSED            => 'navmap.correct.gif',
                    224:           $res->PAST_DUE_NO_ANSWER => 'navmap.wrong.gif',
                    225:           $res->PAST_DUE_ANSWER_LATER => 'navmap.wrong.gif',
                    226:           $res->ANSWER_OPEN        => 'navmap.wrong.gif',
                    227:           $res->OPEN_LATER         => '',
                    228:           $res->TRIES_LEFT         => 'navmap.open.gif',
                    229:           $res->INCORRECT          => 'navmap.wrong.gif',
1.69      bowersj2  230:           $res->OPEN               => 'navmap.open.gif',
1.85      bowersj2  231:           $res->ATTEMPTED          => 'navmap.open.gif' );
1.69      bowersj2  232: 
                    233:     my %iconAltTags = 
                    234:         ( 'navmap.correct.gif' => 'Correct',
                    235:           'navmap.wrong.gif'   => 'Incorrect',
                    236:           'navmap.open.gif'    => 'Open' );
1.59      bowersj2  237: 
                    238:     my %condenseStatuses =
1.66      bowersj2  239:         ( $res->NETWORK_FAILURE    => 1,
                    240:           $res->NOTHING_SET        => 1,
                    241:           $res->CORRECT            => 1 );
1.51      bowersj2  242: 
                    243:     my %filterHash;
                    244:     # Figure out what we're not displaying
                    245:     foreach (split(/\,/, $ENV{"form.filter"})) {
                    246:         if ($_) {
                    247:             $filterHash{$_} = "1";
                    248:         }
                    249:     }
                    250: 
1.88      bowersj2  251:     # Is this a new-style course? If so, we want to suppress showing the top-level
                    252:     # maps in their own folders, in favor of "inlining" them.
                    253:     my $topResource = $navmap->getById("0.0");
1.63      bowersj2  254: 
1.51      bowersj2  255:     # Begin the HTML table
1.59      bowersj2  256:     # four cols: resource + indent, chat+feedback, icon, text string
1.85      bowersj2  257:     $r->print('<table cellspacing="0" cellpadding="3" border="0" bgcolor="#FFFFFF">' ."\n");
1.51      bowersj2  258: 
1.74      bowersj2  259:     # This needs to be updated to use symbs from the remote, 
                    260:     # instead of uris. The changes to this and the main rendering
                    261:     # loop should be obvious.
                    262:     # Here's a simple example of the iterator.
1.88      bowersj2  263:     # Preprocess the map: Look for current URL, force inlined maps to display
                    264: 
1.118     bowersj2  265:     my $mapIterator = $navmap->getIterator(undef, undef, undef, 1);
1.88      bowersj2  266:     my $found = 0;
                    267:     my $depth = 1;
1.118     bowersj2  268:     my $currentJumpIndex = 0; # keeps track of when the current resource is found,
1.91      bowersj2  269:                              # so we can back up a few and put the anchor above the
                    270:                              # current resource
1.118     bowersj2  271:     my $currentJumpDelta = 2; # change this to change how many resources are displayed
1.101     bowersj2  272:                              # before the current resource when using #current
1.88      bowersj2  273:     $mapIterator->next(); # discard the first BEGIN_MAP
                    274:     my $curRes = $mapIterator->next();
1.91      bowersj2  275:     my $counter = 0;
1.118     bowersj2  276:     my $foundJump = ($jumpType == $NOTHING); # look for jump point if we have one
                    277:     my $looped = 0; 
1.116     bowersj2  278: 
                    279:     # We only need to do this if we need to open the maps to show the
1.118     bowersj2  280:     # current position. This will change the counter so we can't count
                    281:     # for the jump marker with this loop.
1.116     bowersj2  282:     while ($depth > 0 && !$ENV{'form.alreadyHere'}) {
1.96      bowersj2  283:         if ($curRes == $mapIterator->BEGIN_MAP()) { $depth++; }
                    284:         if ($curRes == $mapIterator->END_MAP()) { $depth--; }
1.120     bowersj2  285: 
1.118     bowersj2  286:         if (ref($curRes) && !$ENV{'form.alreadyHere'} && 
                    287:             ($hereType == $SYMB && $curRes->symb() eq $here) ||
1.119     bowersj2  288:             (ref($curRes) && $hereType == $URL && $curRes->src() eq $here)) {
1.118     bowersj2  289:             my $mapStack = $mapIterator->getStack();
                    290:             
                    291:             # Ensure the parent maps are open
                    292:             for my $map (@{$mapStack}) {
                    293:                 if ($condition) {
                    294:                     undef $filterHash{$map->map_pc()};
                    295:                 } else {
                    296:                     $filterHash{$map->map_pc()} = 1;
                    297:                 }
                    298:             }
                    299:             $ENV{'form.alreadyHere'} = 1;
                    300:         }
                    301:         $looped = 1;
                    302: 
                    303:         $curRes = $mapIterator->next();
                    304:     }            
                    305:     
                    306:     $mapIterator = $navmap->getIterator(undef, undef, \%filterHash, 0);
                    307:     $depth = 1;
                    308:     $mapIterator->next();
                    309:     $curRes = $mapIterator->next();
1.88      bowersj2  310: 
1.118     bowersj2  311:     while ($depth > 0 && !$foundJump) {
                    312:         if ($curRes == $mapIterator->BEGIN_MAP()) { $depth++; }
                    313:         if ($curRes == $mapIterator->END_MAP()) { $depth--; }
1.91      bowersj2  314:         if (ref($curRes)) { $counter++; }
                    315: 
1.118     bowersj2  316:         if (ref($curRes) && 
                    317:             (($jumpType == $SYMB && $curRes->symb() eq $jump) ||
                    318:             ($jumpType == $URL && $curRes->src() eq $jump))) {
1.88      bowersj2  319:             # If this is the correct resource, be sure to 
                    320:             # show it by making sure the containing maps
                    321:             # are open.
1.91      bowersj2  322: 
1.101     bowersj2  323:             # This is why we have to use the main iterator instead of the
                    324:             # potentially faster DFS: The count has to be the same, so
                    325:             # the order has to be the same, which DFS won't give us.
1.118     bowersj2  326:             $currentJumpIndex = $counter;
                    327:             $foundJump = 1;
1.88      bowersj2  328:         }
1.118     bowersj2  329: 
1.88      bowersj2  330:         $curRes = $mapIterator->next();
1.74      bowersj2  331:     }
1.88      bowersj2  332:     
1.53      bowersj2  333:     undef $res; # so we don't accidentally use it later
1.72      bowersj2  334:     my $indentLevel = 0;
1.61      bowersj2  335:     my $indentString = "<img src=\"/adm/lonIcons/whitespace1.gif\" width=\"25\" height=\"1\" alt=\"\" border=\"0\" />";
1.51      bowersj2  336: 
                    337:     my $isNewBranch = 0;
1.59      bowersj2  338:     my $now = time();
                    339:     my $in24Hours = $now + 24 * 60 * 60;
1.78      bowersj2  340:     my $displayedHereMarker = 0;
1.118     bowersj2  341:     my $displayedJumpMarker = 0;
1.88      bowersj2  342:     
1.72      bowersj2  343:     # We know the first thing is a BEGIN_MAP (see "$self->{STARTED}"
                    344:     # code in iterator->next), so ignore the first one
1.89      bowersj2  345:     $mapIterator = $navmap->getIterator(undef, undef, \%filterHash,
1.74      bowersj2  346:                                            $condition);
1.72      bowersj2  347:     $mapIterator->next();
1.89      bowersj2  348:     $curRes = $mapIterator->next();
1.90      bowersj2  349:     $depth = 1;
1.88      bowersj2  350: 
                    351:     my @backgroundColors = ("#FFFFFF", "#F6F6F6");
                    352:     my $rowNum = 0;
1.51      bowersj2  353: 
1.91      bowersj2  354:     $counter = 0;
                    355: 
1.72      bowersj2  356:     while ($depth > 0) {
1.51      bowersj2  357:         if ($curRes == $mapIterator->BEGIN_MAP() ||
1.52      bowersj2  358:             $curRes == $mapIterator->BEGIN_BRANCH()) {
1.51      bowersj2  359:             $indentLevel++;
                    360:         }
                    361:         if ($curRes == $mapIterator->END_MAP() ||
1.52      bowersj2  362:             $curRes == $mapIterator->END_BRANCH()) {
1.51      bowersj2  363:             $indentLevel--;
                    364:         }
1.52      bowersj2  365:         if ($curRes == $mapIterator->BEGIN_BRANCH()) {
                    366:             $isNewBranch = 1;
1.72      bowersj2  367:         }
1.96      bowersj2  368:         if ($curRes == $mapIterator->BEGIN_MAP()) { $depth++; }
                    369:         if ($curRes == $mapIterator->END_MAP()) { $depth--; }
1.51      bowersj2  370: 
1.91      bowersj2  371:         if (ref($curRes)) { $counter++; }
                    372: 
1.101     bowersj2  373:         # Is this resource being ignored because it is in a random-out
                    374:         # map and it was not selected?
1.68      bowersj2  375:         if (ref($curRes) && !advancedUser() && $curRes->randomout()) {
                    376:             $curRes = $mapIterator->next();
1.101     bowersj2  377:             next; # if yes, then just ignore this resource
1.68      bowersj2  378:         }
                    379: 
1.116     bowersj2  380:         if (ref($curRes)) {
1.51      bowersj2  381: 
1.113     bowersj2  382:             my $deltalevel = $isNewBranch? 1 : 0; # reserves space for branch icon
                    383: 
1.116     bowersj2  384:             if ($indentLevel - $deltalevel < 0) {
1.113     bowersj2  385:                 # If this would be at a negative depth (top-level maps in
                    386:                 # new-style courses, we want to suppress their title display)
                    387:                 # then ignore it.
                    388:                 $curRes = $mapIterator->next();
                    389:                 next;
                    390:             }
                    391: 
1.66      bowersj2  392:             # Step one: Decide which parts to show
                    393:             my @parts = @{$curRes->parts()};
                    394:             my $multipart = scalar(@parts) > 1;
                    395:             my $condensed = 0;
                    396:                 
1.51      bowersj2  397:             if ($curRes->is_problem()) {
1.101     bowersj2  398: 
1.66      bowersj2  399:                 # Is it multipart?
                    400:                 if ($multipart) {
                    401:                     # If it's multipart, see if part 0 is "open"
                    402:                     # if it is, display all parts, if it isn't,
                    403:                     # just display first
                    404:                     if (!$curRes->opendate("0")) {
1.101     bowersj2  405:                         # no parts are open, display as one part
1.129.2.2  albertel  406:                         @parts = ();
1.68      bowersj2  407:                         $condensed = 1;
1.66      bowersj2  408:                     } else {
                    409:                         # Otherwise, only display part 0 if we want to 
                    410:                         # attach feedback or email information to it
                    411:                         if ($curRes->hasDiscussion() || $curRes->getFeedback()) {
1.129.2.3! albertel  412:                             #shift @parts;
1.66      bowersj2  413:                         } else {
                    414:                             # Now, we decide whether to condense the
                    415:                             # parts due to similarity
                    416:                             my $status = $curRes->status($parts[1]);
                    417:                             my $due = $curRes->duedate($parts[1]);
                    418:                             my $open = $curRes->opendate($parts[1]);
                    419:                             my $statusAllSame = 1;
                    420:                             my $dueAllSame = 1;
                    421:                             my $openAllSame = 1;
                    422:                             for (my $i = 2; $i < scalar(@parts); $i++) {
                    423:                                 if ($curRes->status($parts[$i]) != $status){
                    424:                                     $statusAllSame = 0;
                    425:                                 }
                    426:                                 if ($curRes->duedate($parts[$i]) != $due ) {
                    427:                                     $dueAllSame = 0;
                    428:                                 }
                    429:                                 if ($curRes->opendate($parts[$i]) != $open) {
                    430:                                     $openAllSame = 0;
                    431:                                 }
                    432:                             }
                    433:                             
                    434:                             # $allSame is true if all the statuses were
                    435:                             # the same. Now, if they are all the same and
                    436:                             # match one of the statuses to condense, or they
                    437:                             # are all open with the same due date, or they are
                    438:                             # all OPEN_LATER with the same open date, display the
                    439:                             # status of the first non-zero part (to get the 'correct'
                    440:                             # status right, since 0 is never 'correct' or 'open').
                    441:                             if (($statusAllSame && defined($condenseStatuses{$status})) ||
                    442:                                 ($dueAllSame && $status == $curRes->OPEN && $statusAllSame)||
                    443:                                 ($openAllSame && $status == $curRes->OPEN_LATER && $statusAllSame) ){
1.129.2.2  albertel  444:                                 @parts = ();
1.66      bowersj2  445:                                 $condensed = 1;
                    446:                             }
                    447:                         }
                    448:                     }
                    449:                 }
1.59      bowersj2  450: 
1.51      bowersj2  451:             }
                    452: 
1.83      bowersj2  453:             # Is it a multipart problem with a single part, now in 
1.101     bowersj2  454:             # @parts with "0" filtered out? If so, 'forget' it's a multi-part
1.83      bowersj2  455:             # problem and treat it like a single-part problem.
1.129.2.2  albertel  456:             if ( scalar(@parts) == 0 ) {
1.83      bowersj2  457:                 $multipart = 0;
                    458:             }
                    459: 
1.66      bowersj2  460:             # Display one part, in event of network error.
                    461:             # If this is a single part, we can at least show the correct
1.101     bowersj2  462:             # status, but if it's multipart, we're lost, since we can't
                    463:             # retreive the metadata to count the parts
1.66      bowersj2  464:             if ($curRes->{RESOURCE_ERROR}) {
1.129.2.2  albertel  465:                 @parts = ();
1.66      bowersj2  466:             }
                    467: 
1.101     bowersj2  468:             # Step Two: Print the actual data.
                    469: 
                    470:             # For each part we intend to display...
1.129.2.2  albertel  471:             foreach my $part ('', @parts) {
                    472:                 if ($part eq '0') {
                    473:                     next;
                    474:                 }
1.59      bowersj2  475: 
1.68      bowersj2  476:                 my $nonLinkedText = ""; # unlinked stuff after title
1.51      bowersj2  477:                 
                    478:                 my $stack = $mapIterator->getStack();
                    479:                 my $src = getLinkForResource($stack);
                    480: 
1.101     bowersj2  481:                 # Pass the correct symb on the querystring, so the
                    482:                 # remote will figure out where we are if we click a link
1.51      bowersj2  483:                 my $srcHasQuestion = $src =~ /\?/;
                    484:                 my $link = $src.
                    485:                     ($srcHasQuestion?'&':'?') .
                    486:                     'symb='.&Apache::lonnet::escape($curRes->symb()).
                    487:                     '"';
1.101     bowersj2  488: 
1.106     bowersj2  489:                 my $title = $curRes->compTitle();
1.122     www       490:                 if ($src=~/^\/uploaded\//) {
                    491: 		    $nonLinkedText=$title;
                    492:                     $title='';
                    493:                 }
1.51      bowersj2  494:                 my $partLabel = "";
1.52      bowersj2  495:                 my $newBranchText = "";
                    496: 
                    497:                 # If this is a new branch, label it so
                    498:                 if ($isNewBranch) {
1.59      bowersj2  499:                     $newBranchText = "<img src=\"/adm/lonIcons/branch.gif\" border=\"0\">";
1.52      bowersj2  500:                     $isNewBranch = 0;
                    501:                 }
1.51      bowersj2  502: 
                    503:                 # links to open and close the folders
                    504:                 my $linkopen = "<a href=\"$link\">";
                    505:                 my $linkclose = "</a>";
                    506: 
1.61      bowersj2  507:                 my $icon = "<img src=\"/adm/lonIcons/html.gif\" alt=\"\" border=\"0\" />";
1.51      bowersj2  508:                 if ($curRes->is_problem()) { 
1.129.2.2  albertel  509:                     if ($part eq "" || $condensed) {
1.66      bowersj2  510:                         $icon = '<img src="/adm/lonIcons/problem.gif" alt="" border=\"0\" />'; 
                    511:                     } else {
                    512:                         $icon = $indentString;
                    513:                     }
1.51      bowersj2  514:                 }
                    515: 
                    516:                 # Display the correct icon, link to open or shut map
                    517:                 if ($curRes->is_map()) { 
                    518:                     my $mapId = $curRes->map_pc();
1.82      bowersj2  519:                     my $nowOpen = (!defined($filterHash{$mapId}));
                    520:                     if ($condition) {$nowOpen = !$nowOpen;}
1.51      bowersj2  521:                     $icon = $nowOpen ?
1.77      bowersj2  522:                         "navmap.folder.closed.gif" : "navmap.folder.open.gif";
1.66      bowersj2  523:                     $icon = "<img src=\"/adm/lonIcons/$icon\" alt=\"\" border=\"0\" />";
1.52      bowersj2  524:                     $linkopen = "<a href=\"/adm/navmaps?filter=";
1.66      bowersj2  525:                     $linkopen .= ($nowOpen xor $condition) ? 
1.51      bowersj2  526:                         addToFilter(\%filterHash, $mapId) :
                    527:                         removeFromFilter(\%filterHash, $mapId);
1.118     bowersj2  528:                     $linkopen .= "&condition=$condition&$queryAdd" . 
                    529:                         "&hereType=$hereType&here=" . 
                    530:                         Apache::lonnet::escape($here) . "&jumpType=$SYMB&" .
                    531:                         "jump=" . Apache::lonnet::escape($curRes->symb()) ."\">";
1.51      bowersj2  532:                     $linkclose = "</a>";
1.68      bowersj2  533: 
1.51      bowersj2  534:                 }
                    535:                 
                    536:                 my $colorizer = "";
1.86      bowersj2  537:                 my $color;
1.51      bowersj2  538:                 if ($curRes->is_problem()) {
1.115     bowersj2  539:                     $color = $colormap{$curRes->status};
1.74      bowersj2  540: 
1.115     bowersj2  541:                     if (dueInLessThen24Hours($curRes, $part) ||
                    542:                         lastTry($curRes, $part)) {
1.79      bowersj2  543:                         $color = $hurryUpColor;
                    544:                     }
1.115     bowersj2  545: 
1.51      bowersj2  546:                     if ($color ne "") {
                    547:                         $colorizer = "bgcolor=\"$color\"";
                    548:                     }
                    549:                 }
                    550: 
1.68      bowersj2  551:                 if ($curRes->randomout()) {
                    552:                     $nonLinkedText .= ' <i>(hidden)</i> ';
                    553:                 }
                    554: 
1.88      bowersj2  555:                 $rowNum++;
                    556:                 my $backgroundColor = $backgroundColors[$rowNum % scalar(@backgroundColors)];
                    557: 
1.91      bowersj2  558:                 # FIRST COL: The resource indentation, branch icon, name, and anchor
1.116     bowersj2  559:                 $r->print("  <tr bgcolor=\"$backgroundColor\"><td align=\"left\" valign=\"center\">\n");
1.51      bowersj2  560: 
1.101     bowersj2  561:                 # Print the anchor if necessary
1.118     bowersj2  562:                 if ($counter == $currentJumpIndex - $currentJumpDelta ) {
                    563:                     $r->print('<a name="curloc" />');
                    564:                     $displayedJumpMarker = 1;
1.91      bowersj2  565:                 }
                    566: 
1.51      bowersj2  567:                 # print indentation
1.116     bowersj2  568:                 for (my $i = 0; $i < $indentLevel - $deltalevel; $i++) {
1.51      bowersj2  569:                     $r->print($indentString);
                    570:                 }
                    571: 
1.61      bowersj2  572:                 $r->print("  ${newBranchText}${linkopen}$icon${linkclose}\n");
1.51      bowersj2  573: 
1.74      bowersj2  574:                 my $curMarkerBegin = "";
                    575:                 my $curMarkerEnd = "";
                    576: 
                    577:                 # Is this the current resource?
1.118     bowersj2  578:                 if (!$displayedHereMarker && 
                    579:                     (($hereType == $SYMB && $curRes->symb eq $here) ||
                    580:                     ($hereType == $URL && $curRes->src eq $here))) {
                    581:                     $curMarkerBegin = '<font color="red" size="+2">&gt; </font>';
1.74      bowersj2  582:                     $curMarkerEnd = '<font color="red" size="+2"> &lt;</font>';
1.78      bowersj2  583:                     $displayedHereMarker = 1;
1.74      bowersj2  584:                 }
                    585: 
1.129.2.2  albertel  586:                 if ($curRes->is_problem() && $part ne "" && !$condensed) { 
1.66      bowersj2  587:                     $partLabel = " (Part $part)"; 
                    588:                     $title = "";
                    589:                 }
1.129.2.2  albertel  590:                 if ($condensed && $curRes->countParts() > 1) {
1.68      bowersj2  591:                     $nonLinkedText .= ' (' . $curRes->countParts() . ' parts)';
1.66      bowersj2  592:                 }
1.59      bowersj2  593: 
1.74      bowersj2  594:                 $r->print("  $curMarkerBegin<a href=\"$link\">$title$partLabel</a> $curMarkerEnd $nonLinkedText");
1.66      bowersj2  595: 
1.118     bowersj2  596:                 #if ($curRes->{RESOURCE_ERROR}) {
                    597:                 #    $r->print(&Apache::loncommon::help_open_topic ("Navmap_Host_Down",
                    598:                 #                              '<font size="-1">Host down</font>'));
                    599:                 #    }
1.66      bowersj2  600: 
1.113     bowersj2  601:                 $r->print("</td>\n");
                    602: 
1.101     bowersj2  603:                 # SECOND COL: Is there text, feedback, errors??
1.124     bowersj2  604:                 my $discussionHTML = ""; my $feedbackHTML = ""; my $errorHTML = "";
1.66      bowersj2  605: 
                    606:                 if ($curRes->hasDiscussion()) {
                    607:                     $discussionHTML = $linkopen .
                    608:                         '<img border="0" src="/adm/lonMisc/chat.gif" />' .
                    609:                         $linkclose;
                    610:                 }
                    611: 
                    612:                 if ($curRes->getFeedback()) {
                    613:                     my $feedback = $curRes->getFeedback();
                    614:                     foreach (split(/\,/, $feedback)) {
                    615:                         if ($_) {
                    616:                             $feedbackHTML .= '&nbsp;<a href="/adm/email?display='
                    617:                                 . &Apache::lonnet::escape($_) . '">'
                    618:                                 . '<img src="/adm/lonMisc/feedback.gif" '
                    619:                                 . 'border="0" /></a>';
                    620:                         }
                    621:                     }
                    622:                 }
                    623: 
1.124     bowersj2  624:                 if ($curRes->getErrors()) {
                    625:                     my $errors = $curRes->getErrors();
                    626:                     foreach (split(/,/, $errors)) {
                    627:                         if ($_) {
                    628:                             $errorHTML .= '&nbsp;<a href="/adm/email?display='
                    629:                                 . &Apache::lonnet::escape($_) . '">'
                    630:                                 . '<img src="/adm/lonMisc/bomb.gif" '
                    631:                                 . 'border="0" /></a>';
                    632:                         }
                    633:                     }
                    634:                 }
                    635: 
                    636:                 $r->print("<td width=\"75\" align=\"left\" valign=\"center\">$discussionHTML$feedbackHTML$errorHTML&nbsp;</td>");
1.66      bowersj2  637: 
                    638:                 # Is this the first displayed part of a multi-part problem
                    639:                 # that has not been condensed, so we should suppress these two
1.101     bowersj2  640:                 # columns so we don't display useless status info about part
                    641:                 # "0"?
1.66      bowersj2  642:                 my $firstDisplayed = !$condensed && $multipart && $part eq "0";
                    643: 
1.69      bowersj2  644:                 # THIRD COL: Problem status icon
1.66      bowersj2  645:                 if ($curRes->is_problem() &&
                    646:                     !$firstDisplayed) {
                    647:                     my $icon = $statusIconMap{$curRes->status($part)};
1.69      bowersj2  648:                     my $alt = $iconAltTags{$icon};
1.66      bowersj2  649:                     if ($icon) {
1.84      bowersj2  650:                         $r->print("<td width=\"30\" valign=\"center\" width=\"50\" align=\"right\">$linkopen<img width=\"25\" height=\"25\" src=\"/adm/lonIcons/$icon\" border=\"0\" alt=\"$alt\" />$linkclose</td>\n");
1.66      bowersj2  651:                     } else {
1.84      bowersj2  652:                         $r->print("<td width=\"30\">&nbsp;</td>\n");
1.66      bowersj2  653:                     }
                    654:                 } else { # not problem, no icon
1.84      bowersj2  655:                     $r->print("<td width=\"30\">&nbsp;</td>\n");
1.66      bowersj2  656:                 }
                    657: 
1.69      bowersj2  658:                 # FOURTH COL: Text description
1.86      bowersj2  659:                 $r->print("<td align=\"right\" valign=\"center\">\n");
1.51      bowersj2  660:                 
1.61      bowersj2  661:                 if ($curRes->kind() eq "res" &&
                    662:                     $curRes->is_problem() &&
1.66      bowersj2  663:                     !$firstDisplayed) {
1.86      bowersj2  664:                     $r->print ("<font color=\"$color\"><b>") if ($color);
1.53      bowersj2  665:                     $r->print (getDescription($curRes, $part));
1.86      bowersj2  666:                     $r->print ("</b></font>") if ($color);
1.51      bowersj2  667:                 }
1.68      bowersj2  668:                 if ($curRes->is_map() && advancedUser() && $curRes->randompick()) {
                    669:                     $r->print('(randomly select ' . $curRes->randompick() .')');
                    670:                 }
1.59      bowersj2  671: 
1.84      bowersj2  672:                 $r->print("&nbsp;</td></tr>\n");
1.113     bowersj2  673: 
                    674:                 if (!($counter % 20)) { $r->rflush(); }
                    675:                 if ($counter == 2) { $r->rflush(); }
1.51      bowersj2  676:             }
                    677:         }
                    678:         $curRes = $mapIterator->next();
                    679:     }
                    680: 
1.118     bowersj2  681:     $r->print("</table>");
                    682: 
                    683:     # Print out the part that jumps to #curloc if it exists
                    684:     if ($displayedJumpMarker) {
                    685:         $r->print('<script>location += "#curloc";</script>');
                    686:     }
                    687: 
1.126     bowersj2  688:     $navmap->untieHashes();
1.51      bowersj2  689: 
1.128     bowersj2  690:     $r->print("</body></html>");
1.59      bowersj2  691: 
1.51      bowersj2  692:     return OK;
                    693: }
                    694: 
                    695: # Convenience functions: Returns a string that adds or subtracts
                    696: # the second argument from the first hash, appropriate for the 
                    697: # query string that determines which folders to recurse on
                    698: sub addToFilter {
                    699:     my $hashIn = shift;
                    700:     my $addition = shift;
                    701:     my %hash = %$hashIn;
                    702:     $hash{$addition} = 1;
                    703: 
                    704:     return join (",", keys(%hash));
                    705: }
                    706: 
                    707: sub removeFromFilter {
                    708:     my $hashIn = shift;
                    709:     my $subtraction = shift;
                    710:     my %hash = %$hashIn;
                    711: 
                    712:     delete $hash{$subtraction};
                    713:     return join(",", keys(%hash));
                    714: }
                    715: 
                    716: # Convenience function: Given a stack returned from getStack on the iterator,
                    717: # return the correct src() value.
                    718: # Later, this should add an anchor when we start putting anchors in pages.
                    719: sub getLinkForResource {
                    720:     my $stack = shift;
                    721:     my $res;
                    722: 
                    723:     # Check to see if there are any pages in the stack
                    724:     foreach $res (@$stack) {
                    725:         if (defined($res) && $res->is_page()) {
                    726:             return $res->src();
                    727:         }
                    728:     }
                    729: 
                    730:     # Failing that, return the src of the last resource that is defined
                    731:     # (when we first recurse on a map, it puts an undefined resource
                    732:     # on the bottom because $self->{HERE} isn't defined yet, and we
                    733:     # want the src for the map anyhow)
                    734:     foreach (@$stack) {
                    735:         if (defined($_)) { $res = $_; }
                    736:     }
                    737: 
                    738:     return $res->src();
                    739: }
                    740: 
1.53      bowersj2  741: # Convenience function: This seperates the logic of how to create
                    742: # the problem text strings ("Due: DATE", "Open: DATE", "Not yet assigned",
                    743: # etc.) into a seperate function. It takes a resource object as the
                    744: # first parameter, and the part number of the resource as the second.
                    745: # It's basically a big switch statement on the status of the resource.
                    746: 
                    747: sub getDescription {
                    748:     my $res = shift;
                    749:     my $part = shift;
1.69      bowersj2  750:     my $status = $res->status($part);
1.53      bowersj2  751: 
                    752:     if ($status == $res->NETWORK_FAILURE) { return ""; }
                    753:     if ($status == $res->NOTHING_SET) {
                    754:         return "Not currently assigned.";
                    755:     }
                    756:     if ($status == $res->OPEN_LATER) {
1.73      bowersj2  757:         return "Open " . timeToHumanString($res->opendate($part));
1.53      bowersj2  758:     }
                    759:     if ($status == $res->OPEN) {
1.79      bowersj2  760:         if ($res->duedate($part)) {
1.73      bowersj2  761:             return "Due " . timeToHumanString($res->duedate($part));
1.66      bowersj2  762:         } else {
                    763:             return "Open, no due date";
                    764:         }
1.53      bowersj2  765:     }
1.54      bowersj2  766:     if ($status == $res->PAST_DUE_ANSWER_LATER) {
1.73      bowersj2  767:         return "Answer open " . timeToHumanString($res->answerdate($part));
1.54      bowersj2  768:     }
                    769:     if ($status == $res->PAST_DUE_NO_ANSWER) {
1.73      bowersj2  770:         return "Was due " . timeToHumanString($res->duedate($part));
1.53      bowersj2  771:     }
                    772:     if ($status == $res->ANSWER_OPEN) {
                    773:         return "Answer available";
                    774:     }
1.59      bowersj2  775:     if ($status == $res->EXCUSED) {
1.66      bowersj2  776:         return "Excused by instructor";
1.59      bowersj2  777:     }
1.69      bowersj2  778:     if ($status == $res->ATTEMPTED) {
                    779:         return "Not yet graded.";
                    780:     }
1.59      bowersj2  781:     if ($status == $res->TRIES_LEFT) {
1.79      bowersj2  782:         my $tries = $res->tries($part);
                    783:         my $maxtries = $res->maxtries($part);
                    784:         my $triesString = "";
                    785:         if ($tries && $maxtries) {
                    786:             $triesString = "<font size=\"-1\"><i>($tries of $maxtries tries used)</i></font>";
                    787:             if ($maxtries > 1 && $maxtries - $tries == 1) {
                    788:                 $triesString = "<b>$triesString</b>";
                    789:             }
                    790:         }
1.66      bowersj2  791:         if ($res->duedate()) {
1.73      bowersj2  792:             return "Due " . timeToHumanString($res->duedate($part)) .
1.66      bowersj2  793:                 " $triesString";
                    794:         } else {
                    795:             return "No due date $triesString";
                    796:         }
1.59      bowersj2  797:     }
1.53      bowersj2  798: }
                    799: 
1.115     bowersj2  800: # Convenience function, so others can use it: Is the problem due in less then
                    801: # 24 hours, and still can be done?
                    802: 
                    803: sub dueInLessThen24Hours {
                    804:     my $res = shift;
                    805:     my $part = shift;
                    806:     my $status = $res->status($part);
                    807: 
                    808:     return ($status == $res->OPEN() || $status == $res->ATTEMPTED() ||
                    809:             $status == $res->TRIES_LEFT()) &&
                    810:            $res->duedate() && $res->duedate() < time()+(24*60*60) &&
                    811:            $res->duedate() > time();
                    812: }
                    813: 
                    814: # Convenience function, so others can use it: Is there only one try remaining for the
                    815: # part, with more then one try to begin with, not due yet and still can be done?
                    816: sub lastTry {
                    817:     my $res = shift;
                    818:     my $part = shift;
                    819: 
                    820:     my $tries = $res->tries($part);
                    821:     my $maxtries = $res->maxtries($part);
                    822:     return $tries && $maxtries && $maxtries > 1 &&
                    823:         $maxtries - $tries == 1 && $res->duedate() &&
                    824:         $res->duedate() > time();
                    825: }
                    826: 
1.101     bowersj2  827: # This puts a human-readable name on the ENV variable.
1.68      bowersj2  828: sub advancedUser {
                    829:     return $ENV{'user.adv'};
                    830: }
                    831: 
1.73      bowersj2  832: 
                    833: # timeToHumanString takes a time number and converts it to a
                    834: # human-readable representation, meant to be used in the following
                    835: # manner:
                    836: # print "Due $timestring"
                    837: # print "Open $timestring"
                    838: # print "Answer available $timestring"
                    839: # Very, very, very, VERY English-only... goodness help a localizer on
                    840: # this func...
1.53      bowersj2  841: sub timeToHumanString {
1.58      albertel  842:     my ($time) = @_;
                    843:     # zero, '0' and blank are bad times
1.73      bowersj2  844:     if (!$time) {
                    845:         return 'never';
                    846:     }
                    847: 
                    848:     my $now = time();
                    849: 
                    850:     my @time = localtime($time);
                    851:     my @now = localtime($now);
                    852: 
                    853:     # Positive = future
                    854:     my $delta = $time - $now;
                    855: 
                    856:     my $minute = 60;
                    857:     my $hour = 60 * $minute;
                    858:     my $day = 24 * $hour;
                    859:     my $week = 7 * $day;
                    860:     my $inPast = 0;
                    861: 
                    862:     # Logic in comments:
                    863:     # Is it now? (extremely unlikely)
                    864:     if ( $delta == 0 ) {
                    865:         return "this instant";
                    866:     }
                    867: 
                    868:     if ($delta < 0) {
                    869:         $inPast = 1;
                    870:         $delta = -$delta;
                    871:     }
                    872: 
                    873:     if ( $delta > 0 ) {
1.101     bowersj2  874: 
1.73      bowersj2  875:         my $tense = $inPast ? " ago" : "";
                    876:         my $prefix = $inPast ? "" : "in ";
1.101     bowersj2  877:         
                    878:         # Less then a minute
1.73      bowersj2  879:         if ( $delta < $minute ) {
                    880:             if ($delta == 1) { return "${prefix}1 second$tense"; }
                    881:             return "$prefix$delta seconds$tense";
                    882:         }
                    883: 
1.101     bowersj2  884:         # Less then an hour
1.73      bowersj2  885:         if ( $delta < $hour ) {
                    886:             # If so, use minutes
                    887:             my $minutes = floor($delta / 60);
                    888:             if ($minutes == 1) { return "${prefix}1 minute$tense"; }
                    889:             return "$prefix$minutes minutes$tense";
                    890:         }
                    891:         
                    892:         # Is it less then 24 hours away? If so,
                    893:         # display hours + minutes
                    894:         if ( $delta < $hour * 24) {
                    895:             my $hours = floor($delta / $hour);
                    896:             my $minutes = floor(($delta % $hour) / $minute);
                    897:             my $hourString = "$hours hours";
                    898:             my $minuteString = ", $minutes minutes";
                    899:             if ($hours == 1) {
                    900:                 $hourString = "1 hour";
                    901:             }
                    902:             if ($minutes == 1) {
                    903:                 $minuteString = ", 1 minute";
                    904:             }
                    905:             if ($minutes == 0) {
                    906:                 $minuteString = "";
                    907:             }
                    908:             return "$prefix$hourString$minuteString$tense";
                    909:         }
                    910: 
                    911:         # Less then 5 days away, display day of the week and
                    912:         # HH:MM
                    913:         if ( $delta < $day * 5 ) {
1.85      bowersj2  914:             my $timeStr = strftime("%A, %b %e at %I:%M %P", localtime($time));
1.73      bowersj2  915:             $timeStr =~ s/12:00 am/midnight/;
                    916:             $timeStr =~ s/12:00 pm/noon/;
                    917:             return ($inPast ? "last " : "next ") .
                    918:                 $timeStr;
                    919:         }
                    920:         
                    921:         # Is it this year?
                    922:         if ( $time[5] == $now[5]) {
                    923:             # Return on Month Day, HH:MM meridian
                    924:             my $timeStr = strftime("on %A, %b %e at %I:%M %P", localtime($time));
                    925:             $timeStr =~ s/12:00 am/midnight/;
                    926:             $timeStr =~ s/12:00 pm/noon/;
                    927:             return $timeStr;
                    928:         }
                    929: 
                    930:         # Not this year, so show the year
                    931:         my $timeStr = strftime("on %A, %b %e %G at %I:%M %P", localtime($time));
                    932:         $timeStr =~ s/12:00 am/midnight/;
                    933:         $timeStr =~ s/12:00 pm/noon/;
                    934:         return $timeStr;
1.58      albertel  935:     }
1.53      bowersj2  936: }
                    937: 
1.51      bowersj2  938: 1;
                    939: 
                    940: package Apache::lonnavmaps::navmap;
                    941: 
                    942: =pod
                    943: 
                    944: lonnavmaps provides functions and objects for dealing with the compiled course hashes generated when a user enters the course, and also provides the Apache handler for the "Navigation Map" button.
                    945: 
                    946: =head1 navmap object: Encapsulating the compiled nav map
                    947: 
                    948: navmap is an object that encapsulates a compiled course map and provides a reasonable interface to it.
                    949: 
                    950: Most notably it provides a way to navigate the map sensibly and a flexible iterator that makes it easy to write various renderers based on nav maps.
                    951: 
                    952: You must obtain resource objects through the navmap object.
                    953: 
                    954: =head2 Methods
                    955: 
                    956: =over 4
                    957: 
1.70      bowersj2  958: =item * B<new>(navHashFile, parmHashFile, genCourseAndUserOptions, genMailDiscussStatus): Binds a new navmap object to the compiled nav map hash and parm hash given as filenames. genCourseAndUserOptions is a flag saying whether the course options and user options hash should be generated. This is for when you are using the parameters of the resources that require them; see documentation in resource object documentation. genMailDiscussStatus causes the nav map to retreive information about the email and discussion status of resources. Returns the navmap object if this is successful, or B<undef> if not. You must check for undef; errors will occur when you try to use the other methods otherwise.
1.51      bowersj2  959: 
                    960: =item * B<getIterator>(first, finish, filter, condition): See iterator documentation below.
                    961: 
                    962: =cut
                    963: 
                    964: use strict;
                    965: use GDBM_File;
                    966: 
                    967: sub new {
                    968:     # magic invocation to create a class instance
                    969:     my $proto = shift;
                    970:     my $class = ref($proto) || $proto;
                    971:     my $self = {};
                    972: 
                    973:     $self->{NAV_HASH_FILE} = shift;
                    974:     $self->{PARM_HASH_FILE} = shift;
                    975:     $self->{GENERATE_COURSE_USER_OPT} = shift;
1.55      bowersj2  976:     $self->{GENERATE_EMAIL_DISCUSS_STATUS} = shift;
1.51      bowersj2  977: 
1.101     bowersj2  978:     # Resource cache stores navmap resources as we reference them. We generate
1.51      bowersj2  979:     # them on-demand so we don't pay for creating resources unless we use them.
                    980:     $self->{RESOURCE_CACHE} = {};
                    981: 
                    982:     # Network failure flag, if we accessed the course or user opt and
                    983:     # failed
                    984:     $self->{NETWORK_FAILURE} = 0;
                    985: 
                    986:     # tie the nav hash
                    987:     my %navmaphash;
                    988:     if (!(tie(%navmaphash, 'GDBM_File', $self->{NAV_HASH_FILE},
                    989:               &GDBM_READER(), 0640))) {
                    990:         return undef;
                    991:     }
                    992:     
                    993:     my %parmhash;
                    994:     if (!(tie(%parmhash, 'GDBM_File', $self->{PARM_HASH_FILE},
                    995:               &GDBM_READER(), 0640)))
                    996:     {
1.66      bowersj2  997:         untie $self->{PARM_HASH};
1.51      bowersj2  998:         return undef;
                    999:     }
1.115     bowersj2 1000: 
1.129     bowersj2 1001:     $self->{HASH_TIED} = 1;
1.123     bowersj2 1002:     $self->{NAV_HASH} = \%navmaphash;
                   1003:     $self->{PARM_HASH} = \%parmhash;
1.51      bowersj2 1004: 
1.92      bowersj2 1005:     bless($self);
                   1006:         
                   1007:     return $self;
                   1008: }
                   1009: 
                   1010: sub init {
1.93      bowersj2 1011:     my $self = shift;
1.92      bowersj2 1012: 
1.51      bowersj2 1013:     # If the course opt hash and the user opt hash should be generated,
                   1014:     # generate them
                   1015:     if ($self->{GENERATE_COURSE_USER_OPT}) {
                   1016:         my $uname=$ENV{'user.name'};
                   1017:         my $udom=$ENV{'user.domain'};
                   1018:         my $uhome=$ENV{'user.home'};
                   1019:         my $cid=$ENV{'request.course.id'};
                   1020:         my $chome=$ENV{'course.'.$cid.'.home'};
                   1021:         my ($cdom,$cnum)=split(/\_/,$cid);
                   1022:         
                   1023:         my $userprefix=$uname.'_'.$udom.'_';
                   1024:         
1.99      bowersj2 1025:         my %courserdatas; my %useropt; my %courseopt; my %userrdatas;
1.51      bowersj2 1026:         unless ($uhome eq 'no_host') { 
                   1027: # ------------------------------------------------- Get coursedata (if present)
                   1028:             unless ((time-$courserdatas{$cid.'.last_cache'})<240) {
                   1029:                 my $reply=&Apache::lonnet::reply('dump:'.$cdom.':'.$cnum.
                   1030:                                                  ':resourcedata',$chome);
                   1031:                 if ($reply!~/^error\:/) {
                   1032:                     $courserdatas{$cid}=$reply;
                   1033:                     $courserdatas{$cid.'.last_cache'}=time;
                   1034:                 }
                   1035:                 # check to see if network failed
                   1036:                 elsif ( $reply=~/no.such.host/i || $reply=~/con.*lost/i )
                   1037:                 {
                   1038:                     $self->{NETWORK_FAILURE} = 1;
                   1039:                 }
                   1040:             }
                   1041:             foreach (split(/\&/,$courserdatas{$cid})) {
                   1042:                 my ($name,$value)=split(/\=/,$_);
                   1043:                 $courseopt{$userprefix.&Apache::lonnet::unescape($name)}=
                   1044:                     &Apache::lonnet::unescape($value);
                   1045:             }
                   1046: # --------------------------------------------------- Get userdata (if present)
                   1047:             unless ((time-$userrdatas{$uname.'___'.$udom.'.last_cache'})<240) {
                   1048:                 my $reply=&Apache::lonnet::reply('dump:'.$udom.':'.$uname.':resourcedata',$uhome);
                   1049:                 if ($reply!~/^error\:/) {
                   1050:                     $userrdatas{$uname.'___'.$udom}=$reply;
                   1051:                     $userrdatas{$uname.'___'.$udom.'.last_cache'}=time;
                   1052:                 }
                   1053:                 # check to see if network failed
                   1054:                 elsif ( $reply=~/no.such.host/i || $reply=~/con.*lost/i )
                   1055:                 {
                   1056:                     $self->{NETWORK_FAILURE} = 1;
                   1057:                 }
                   1058:             }
                   1059:             foreach (split(/\&/,$userrdatas{$uname.'___'.$udom})) {
                   1060:                 my ($name,$value)=split(/\=/,$_);
                   1061:                 $useropt{$userprefix.&Apache::lonnet::unescape($name)}=
                   1062:                     &Apache::lonnet::unescape($value);
                   1063:             }
1.55      bowersj2 1064:             $self->{COURSE_OPT} = \%courseopt;
                   1065:             $self->{USER_OPT} = \%useropt;
1.51      bowersj2 1066:         }
                   1067:     }   
                   1068: 
1.55      bowersj2 1069:     if ($self->{GENERATE_EMAIL_DISCUSS_STATUS}) {
                   1070:         my $cid=$ENV{'request.course.id'};
                   1071:         my ($cdom,$cnum)=split(/\_/,$cid);
                   1072:         
                   1073:         my %emailstatus = &Apache::lonnet::dump('email_status');
1.56      bowersj2 1074:         my $logoutTime = $emailstatus{'logout'};
                   1075:         my $courseLeaveTime = $emailstatus{'logout_'.$ENV{'request.course.id'}};
1.124     bowersj2 1076:         $self->{LAST_CHECK} = ($courseLeaveTime < $logoutTime ?
1.55      bowersj2 1077:                                $courseLeaveTime : $logoutTime);
1.56      bowersj2 1078:         my %discussiontime = &Apache::lonnet::dump('discussiontimes', 
1.55      bowersj2 1079:                                                    $cdom, $cnum);
                   1080:         my %feedback=();
                   1081:         my %error=();
                   1082:         my $keys = &Apache::lonnet::reply('keys:'.
                   1083:                                           $ENV{'user.domain'}.':'.
                   1084:                                           $ENV{'user.name'}.':nohist_email',
                   1085:                                           $ENV{'user.home'});
                   1086: 
                   1087:         foreach my $msgid (split(/\&/, $keys)) {
                   1088:             $msgid=&Apache::lonnet::unescape($msgid);
                   1089:             my $plain=&Apache::lonnet::unescape(&Apache::lonnet::unescape($msgid));
                   1090:             if ($plain=~/(Error|Feedback) \[([^\]]+)\]/) {
                   1091:                 my ($what,$url)=($1,$2);
                   1092:                 my %status=
                   1093:                     &Apache::lonnet::get('email_status',[$msgid]);
                   1094:                 if ($status{$msgid}=~/^error\:/) { 
                   1095:                     $status{$msgid}=''; 
                   1096:                 }
                   1097:                 
                   1098:                 if (($status{$msgid} eq 'new') || 
                   1099:                     (!$status{$msgid})) { 
                   1100:                     if ($what eq 'Error') {
                   1101:                         $error{$url}.=','.$msgid; 
                   1102:                     } else {
                   1103:                         $feedback{$url}.=','.$msgid;
                   1104:                     }
                   1105:                 }
                   1106:             }
                   1107:         }
                   1108:         
                   1109:         $self->{FEEDBACK} = \%feedback;
                   1110:         $self->{ERROR_MSG} = \%error; # what is this? JB
                   1111:         $self->{DISCUSSION_TIME} = \%discussiontime;
                   1112:         $self->{EMAIL_STATUS} = \%emailstatus;
                   1113:         
                   1114:     }    
1.84      bowersj2 1115: 
                   1116:     $self->{PARM_CACHE} = {};
1.55      bowersj2 1117: }
1.51      bowersj2 1118: 
1.115     bowersj2 1119: # Internal function: Takes a key to look up in the nav hash and implements internal
                   1120: # memory caching of that key.
                   1121: sub navhash {
                   1122:     my $self = shift; my $key = shift;
                   1123:     return $self->{NAV_HASH}->{$key};
                   1124: }
                   1125: 
1.55      bowersj2 1126: # Checks to see if coursemap is defined, matching test in old lonnavmaps
                   1127: sub courseMapDefined {
                   1128:     my $self = shift;
                   1129:     my $uri = &Apache::lonnet::clutter($ENV{'request.course.uri'});
                   1130: 
1.115     bowersj2 1131:     my $firstres = $self->navhash("map_start_$uri");
                   1132:     my $lastres = $self->navhash("map_finish_$uri");
1.55      bowersj2 1133:     return $firstres && $lastres;
1.51      bowersj2 1134: }
                   1135: 
                   1136: sub getIterator {
                   1137:     my $self = shift;
1.98      bowersj2 1138:     my $iterator = Apache::lonnavmaps::iterator->new($self, shift, shift,
1.101     bowersj2 1139:                                                      shift, undef, shift);
1.51      bowersj2 1140:     return $iterator;
                   1141: }
                   1142: 
                   1143: # unties the hash when done
                   1144: sub untieHashes {
                   1145:     my $self = shift;
1.60      bowersj2 1146:     untie %{$self->{NAV_HASH}} if ($self->{HASH_TIED});
                   1147:     untie %{$self->{PARM_HASH}} if ($self->{HASH_TIED});
1.51      bowersj2 1148:     $self->{HASH_TIED} = 0;
                   1149: }
                   1150: 
                   1151: # when the object is destroyed, be sure to untie all the hashes we tied.
                   1152: sub DESTROY {
                   1153:     my $self = shift;
                   1154:     $self->untieHashes();
                   1155: }
                   1156: 
1.125     bowersj2 1157: # Private method: Does the given resource (as a symb string) have
1.59      bowersj2 1158: # current discussion? Returns 0 if chat/mail data not extracted.
                   1159: sub hasDiscussion {
                   1160:     my $self = shift;
                   1161:     my $symb = shift;
                   1162:     if (!defined($self->{DISCUSSION_TIME})) { return 0; }
                   1163: 
1.124     bowersj2 1164:     #return defined($self->{DISCUSSION_TIME}->{$symb});
1.59      bowersj2 1165:     return $self->{DISCUSSION_TIME}->{$symb} >
1.66      bowersj2 1166:            $self->{LAST_CHECK};
1.59      bowersj2 1167: }
                   1168: 
1.125     bowersj2 1169: # Private method: Does the given resource (as a symb string) have
1.59      bowersj2 1170: # current feedback? Returns the string in the feedback hash, which
                   1171: # will be false if it does not exist.
                   1172: sub getFeedback { 
                   1173:     my $self = shift;
                   1174:     my $symb = shift;
                   1175: 
                   1176:     if (!defined($self->{FEEDBACK})) { return ""; }
                   1177:     
                   1178:     return $self->{FEEDBACK}->{$symb};
                   1179: }
                   1180: 
1.125     bowersj2 1181: # Private method: Get the errors for that resource (by source).
1.124     bowersj2 1182: sub getErrors { 
                   1183:     my $self = shift;
                   1184:     my $src = shift;
                   1185:     
                   1186:     if (!defined($self->{ERROR_MSG})) { return ""; }
                   1187:     return $self->{ERROR_MSG}->{$src};
                   1188: }
                   1189: 
1.51      bowersj2 1190: =pod
                   1191: 
                   1192: =item * B<getById>(id): Based on the ID of the resource (1.1, 3.2, etc.), get a resource object for that resource. This method, or other methods that use it (as in the resource object) is the only proper way to obtain a resource object.
                   1193: 
                   1194: =cut
                   1195: 
                   1196: # The strategy here is to cache the resource objects, and only construct them
                   1197: # as we use them. The real point is to prevent reading any more from the tied
                   1198: # hash then we have to, which should hopefully alleviate speed problems.
                   1199: # Caching is just an incidental detail I throw in because it makes sense.
                   1200: 
                   1201: sub getById {
                   1202:     my $self = shift;
                   1203:     my $id = shift;
                   1204: 
                   1205:     if (defined ($self->{RESOURCE_CACHE}->{$id}))
                   1206:     {
                   1207:         return $self->{RESOURCE_CACHE}->{$id};
                   1208:     }
                   1209: 
                   1210:     # resource handles inserting itself into cache.
                   1211:     return Apache::lonnavmaps::resource->new($self, $id);
                   1212: }
                   1213: 
                   1214: =pod
                   1215: 
                   1216: =item * B<firstResource>(): Returns a resource object reference corresponding to the first resource in the navmap.
                   1217: 
                   1218: =cut
                   1219: 
                   1220: sub firstResource {
                   1221:     my $self = shift;
1.115     bowersj2 1222:     my $firstResource = $self->navhash('map_start_' .
                   1223:                      &Apache::lonnet::clutter($ENV{'request.course.uri'}));
1.51      bowersj2 1224:     return $self->getById($firstResource);
                   1225: }
                   1226: 
                   1227: =pod
                   1228: 
                   1229: =item * B<finishResource>(): Returns a resource object reference corresponding to the last resource in the navmap.
                   1230: 
                   1231: =cut
                   1232: 
                   1233: sub finishResource {
                   1234:     my $self = shift;
1.115     bowersj2 1235:     my $firstResource = $self->navhash('map_finish_' .
                   1236:                      &Apache::lonnet::clutter($ENV{'request.course.uri'}));
1.51      bowersj2 1237:     return $self->getById($firstResource);
                   1238: }
                   1239: 
1.101     bowersj2 1240: # Parmval reads the parm hash and cascades the lookups. parmval_real does
                   1241: # the actual lookup; parmval caches the results.
1.51      bowersj2 1242: sub parmval {
                   1243:     my $self = shift;
                   1244:     my ($what,$symb)=@_;
1.84      bowersj2 1245:     my $hashkey = $what."|||".$symb;
                   1246: 
                   1247:     if (defined($self->{PARM_CACHE}->{$hashkey})) {
                   1248:         return $self->{PARM_CACHE}->{$hashkey};
                   1249:     }
                   1250: 
                   1251:     my $result = $self->parmval_real($what, $symb);
                   1252:     $self->{PARM_CACHE}->{$hashkey} = $result;
                   1253:     return $result;
                   1254: }
                   1255: 
                   1256: sub parmval_real {
                   1257:     my $self = shift;
                   1258:     my ($what,$symb) = @_;
                   1259: 
1.51      bowersj2 1260:     my $cid=$ENV{'request.course.id'};
                   1261:     my $csec=$ENV{'request.course.sec'};
                   1262:     my $uname=$ENV{'user.name'};
                   1263:     my $udom=$ENV{'user.domain'};
                   1264: 
                   1265:     unless ($symb) { return ''; }
                   1266:     my $result='';
                   1267: 
                   1268:     my ($mapname,$id,$fn)=split(/\_\_\_/,$symb);
                   1269: 
                   1270: # ----------------------------------------------------- Cascading lookup scheme
                   1271:     my $rwhat=$what;
                   1272:     $what=~s/^parameter\_//;
                   1273:     $what=~s/\_/\./;
                   1274: 
                   1275:     my $symbparm=$symb.'.'.$what;
                   1276:     my $mapparm=$mapname.'___(all).'.$what;
                   1277:     my $usercourseprefix=$uname.'_'.$udom.'_'.$cid;
                   1278: 
                   1279:     my $seclevel= $usercourseprefix.'.['.$csec.'].'.$what;
                   1280:     my $seclevelr=$usercourseprefix.'.['.$csec.'].'.$symbparm;
                   1281:     my $seclevelm=$usercourseprefix.'.['.$csec.'].'.$mapparm;
                   1282: 
                   1283:     my $courselevel= $usercourseprefix.'.'.$what;
                   1284:     my $courselevelr=$usercourseprefix.'.'.$symbparm;
                   1285:     my $courselevelm=$usercourseprefix.'.'.$mapparm;
                   1286: 
                   1287:     my $useropt = $self->{USER_OPT};
                   1288:     my $courseopt = $self->{COURSE_OPT};
                   1289:     my $parmhash = $self->{PARM_HASH};
                   1290: 
                   1291: # ---------------------------------------------------------- first, check user
                   1292:     if ($uname and defined($useropt)) {
1.57      albertel 1293:         if (defined($$useropt{$courselevelr})) { return $$useropt{$courselevelr}; }
                   1294:         if (defined($$useropt{$courselevelm})) { return $$useropt{$courselevelm}; }
                   1295:         if (defined($$useropt{$courselevel})) { return $$useropt{$courselevel}; }
1.51      bowersj2 1296:     }
                   1297: 
                   1298: # ------------------------------------------------------- second, check course
                   1299:     if ($csec and defined($courseopt)) {
1.57      albertel 1300:         if (defined($$courseopt{$seclevelr})) { return $$courseopt{$seclevelr}; }
                   1301:         if (defined($$courseopt{$seclevelm})) { return $$courseopt{$seclevelm}; }
                   1302:         if (defined($$courseopt{$seclevel})) { return $$courseopt{$seclevel}; }
1.51      bowersj2 1303:     }
                   1304: 
                   1305:     if (defined($courseopt)) {
1.57      albertel 1306:         if (defined($$courseopt{$courselevelr})) { return $$courseopt{$courselevelr}; }
                   1307:         if (defined($$courseopt{$courselevelm})) { return $$courseopt{$courselevelm}; }
                   1308:         if (defined($$courseopt{$courselevel})) { return $$courseopt{$courselevel}; }
1.51      bowersj2 1309:     }
                   1310: 
                   1311: # ----------------------------------------------------- third, check map parms
                   1312: 
                   1313:     my $thisparm=$$parmhash{$symbparm};
1.57      albertel 1314:     if (defined($thisparm)) { return $thisparm; }
1.51      bowersj2 1315: 
                   1316: # ----------------------------------------------------- fourth , check default
                   1317: 
                   1318:     my $default=&Apache::lonnet::metadata($fn,$rwhat.'.default');
1.57      albertel 1319:     if (defined($default)) { return $default}
1.51      bowersj2 1320: 
                   1321: # --------------------------------------------------- fifth , cascade up parts
                   1322: 
                   1323:     my ($space,@qualifier)=split(/\./,$rwhat);
                   1324:     my $qualifier=join('.',@qualifier);
                   1325:     unless ($space eq '0') {
                   1326:         my ($part,$id)=split(/\_/,$space);
                   1327:         if ($id) {
                   1328:             my $partgeneral=$self->parmval($part.".$qualifier",$symb);
1.57      albertel 1329:             if (defined($partgeneral)) { return $partgeneral; }
1.51      bowersj2 1330:         } else {
                   1331:             my $resourcegeneral=$self->parmval("0.$qualifier",$symb);
1.57      albertel 1332:             if (defined($resourcegeneral)) { return $resourcegeneral; }
1.51      bowersj2 1333:         }
                   1334:     }
                   1335:     return '';
                   1336: }
                   1337: 
                   1338: 
                   1339: 1;
                   1340: 
                   1341: package Apache::lonnavmaps::iterator;
                   1342: 
                   1343: =pod
                   1344: 
                   1345: =back
                   1346: 
                   1347: =head1 navmap Iterator
                   1348: 
                   1349: An I<iterator> encapsulates the logic required to traverse a data structure. navmap uses an iterator to traverse the course map according to the criteria you wish to use.
                   1350: 
                   1351: To obtain an iterator, call the B<getIterator>() function of a B<navmap> object. (Do not instantiate Apache::lonnavmaps::iterator directly.) This will return a reference to the iterator:
                   1352: 
                   1353: C<my $resourceIterator = $navmap-E<gt>getIterator();>
                   1354: 
                   1355: To get the next thing from the iterator, call B<next>:
                   1356: 
                   1357: C<my $nextThing = $resourceIterator-E<gt>next()>
                   1358: 
                   1359: getIterator behaves as follows:
                   1360: 
                   1361: =over 4
                   1362: 
1.116     bowersj2 1363: =item * B<getIterator>(firstResource, finishResource, filterHash, condition, forceTop): All parameters are optional. firstResource is a resource reference corresponding to where the iterator should start. It defaults to navmap->firstResource() for the corresponding nav map. finishResource corresponds to where you want the iterator to end, defaulting to navmap->finishResource(). filterHash is a hash used as a set containing strings representing the resource IDs, defaulting to empty. Condition is a 1 or 0 that sets what to do with the filter hash: If a 0, then only resource that exist IN the filterHash will be recursed on. If it is a 1, only resources NOT in the filterHash will be recursed on. Defaults to 0. forceTop is a boolean value. If it is false (default), the iterator will only return the first level of map that is not just a single, 'redirecting' map. If true, the iterator will return all information, starting with the top-level map, regardless of content.
1.51      bowersj2 1364: 
1.101     bowersj2 1365: Thus, by default, only top-level resources will be shown. Change the condition to a 1 without changing the hash, and all resources will be shown. Changing the condition to 1 and including some values in the hash will allow you to selectively suppress parts of the navmap, while leaving it on 0 and adding things to the hash will allow you to selectively add parts of the nav map. See the handler code for examples.
1.51      bowersj2 1366: 
                   1367: The iterator will return either a reference to a resource object, or a token representing something in the map, such as the beginning of a new branch. The possible tokens are:
                   1368: 
                   1369: =over 4
                   1370: 
1.70      bowersj2 1371: =item * BEGIN_MAP: A new map is being recursed into. This is returned I<after> the map resource itself is returned.
                   1372: 
                   1373: =item * END_MAP: The map is now done.
                   1374: 
                   1375: =item * BEGIN_BRANCH: A branch is now starting. The next resource returned will be the first in that branch.
                   1376: 
                   1377: =item * END_BRANCH: The branch is now done.
1.51      bowersj2 1378: 
                   1379: =back
                   1380: 
1.70      bowersj2 1381: The tokens are retreivable via methods on the iterator object, i.e., $iterator->END_MAP.
                   1382: 
1.116     bowersj2 1383: Maps can contain empty resources. The iterator will automatically skip over such resources, but will still treat the structure correctly. Thus, a complicated map with several branches, but consisting entirely of empty resources except for one beginning or ending resource, will cause a lot of BRANCH_STARTs and BRANCH_ENDs, but only one resource will be returned.
                   1384: 
1.70      bowersj2 1385: =back
1.51      bowersj2 1386: 
                   1387: =cut
                   1388: 
                   1389: # Here are the tokens for the iterator:
                   1390: 
                   1391: sub BEGIN_MAP { return 1; }    # begining of a new map
                   1392: sub END_MAP { return 2; }      # end of the map
                   1393: sub BEGIN_BRANCH { return 3; } # beginning of a branch
                   1394: sub END_BRANCH { return 4; }   # end of a branch
1.89      bowersj2 1395: sub FORWARD { return 1; }      # go forward
                   1396: sub BACKWARD { return 2; }
1.51      bowersj2 1397: 
1.96      bowersj2 1398: sub min {
                   1399:     (my $a, my $b) = @_;
                   1400:     if ($a < $b) { return $a; } else { return $b; }
                   1401: }
                   1402: 
1.107     bowersj2 1403: # In the CVS repository, documentation of this algorithm is included 
                   1404: # in /doc/lonnavdocs, as a PDF and .tex source. Markers like **1**
                   1405: # will reference the same location in the text as the part of the
                   1406: # algorithm is running through.
                   1407: 
1.94      bowersj2 1408: sub new {
                   1409:     # magic invocation to create a class instance
                   1410:     my $proto = shift;
                   1411:     my $class = ref($proto) || $proto;
                   1412:     my $self = {};
                   1413: 
                   1414:     $self->{NAV_MAP} = shift;
                   1415:     return undef unless ($self->{NAV_MAP});
                   1416: 
                   1417:     # Handle the parameters
                   1418:     $self->{FIRST_RESOURCE} = shift || $self->{NAV_MAP}->firstResource();
                   1419:     $self->{FINISH_RESOURCE} = shift || $self->{NAV_MAP}->finishResource();
                   1420: 
                   1421:     # If the given resources are just the ID of the resource, get the
                   1422:     # objects
                   1423:     if (!ref($self->{FIRST_RESOURCE})) { $self->{FIRST_RESOURCE} = 
                   1424:              $self->{NAV_MAP}->getById($self->{FIRST_RESOURCE}); }
                   1425:     if (!ref($self->{FINISH_RESOURCE})) { $self->{FINISH_RESOURCE} = 
                   1426:              $self->{NAV_MAP}->getById($self->{FINISH_RESOURCE}); }
                   1427: 
                   1428:     $self->{FILTER} = shift;
                   1429: 
                   1430:     # A hash, used as a set, of resource already seen
                   1431:     $self->{ALREADY_SEEN} = shift;
                   1432:     if (!defined($self->{ALREADY_SEEN})) { $self->{ALREADY_SEEN} = {} };
                   1433:     $self->{CONDITION} = shift;
                   1434: 
1.116     bowersj2 1435:     # Do we want to automatically follow "redirection" maps?
                   1436:     $self->{FORCE_TOP} = shift;
                   1437: 
1.94      bowersj2 1438:     # Now, we need to pre-process the map, by walking forward and backward
                   1439:     # over the parts of the map we're going to look at.
1.96      bowersj2 1440: 
1.97      bowersj2 1441:     # The processing steps are exactly the same, except for a few small 
                   1442:     # changes, so I bundle those up in the following list of two elements:
                   1443:     # (direction_to_iterate, VAL_name, next_resource_method_to_call,
                   1444:     # first_resource).
                   1445:     # This prevents writing nearly-identical code twice.
                   1446:     my @iterations = ( [FORWARD(), 'TOP_DOWN_VAL', 'getNext', 
                   1447:                         'FIRST_RESOURCE'],
                   1448:                        [BACKWARD(), 'BOT_UP_VAL', 'getPrevious', 
                   1449:                         'FINISH_RESOURCE'] );
                   1450: 
1.98      bowersj2 1451:     my $maxDepth = 0; # tracks max depth
                   1452: 
1.116     bowersj2 1453:     # If there is only one resource in this map, and it's a map, we
                   1454:     # want to remember that, so the user can ask for the first map
                   1455:     # that isn't just a redirector.
                   1456:     my $resource; my $resourceCount = 0;
                   1457: 
1.107     bowersj2 1458:     # **1**
                   1459: 
1.97      bowersj2 1460:     foreach my $pass (@iterations) {
                   1461:         my $direction = $pass->[0];
                   1462:         my $valName = $pass->[1];
                   1463:         my $nextResourceMethod = $pass->[2];
                   1464:         my $firstResourceName = $pass->[3];
                   1465: 
                   1466:         my $iterator = Apache::lonnavmaps::DFSiterator->new($self->{NAV_MAP}, 
                   1467:                                                             $self->{FIRST_RESOURCE},
                   1468:                                                             $self->{FINISH_RESOURCE},
                   1469:                                                             {}, undef, 0, $direction);
1.96      bowersj2 1470:     
1.97      bowersj2 1471:         # prime the recursion
                   1472:         $self->{$firstResourceName}->{DATA}->{$valName} = 0;
1.98      bowersj2 1473:         my $depth = 0;
1.97      bowersj2 1474:         $iterator->next();
                   1475:         my $curRes = $iterator->next();
1.98      bowersj2 1476:         while ($depth > -1) {
1.97      bowersj2 1477:             if ($curRes == $iterator->BEGIN_MAP()) { $depth++; }
                   1478:             if ($curRes == $iterator->END_MAP()) { $depth--; }
1.96      bowersj2 1479:         
1.97      bowersj2 1480:             if (ref($curRes)) {
1.116     bowersj2 1481:                 # If there's only one resource, this will save it
1.117     bowersj2 1482:                 # we have to filter empty resources from consideration here,
                   1483:                 # or even "empty", redirecting maps have two (start & finish)
                   1484:                 # or three (start, finish, plus redirector)
                   1485:                 if($direction == FORWARD && $curRes->src()) { 
                   1486:                     $resource = $curRes; $resourceCount++; 
                   1487:                 }
1.97      bowersj2 1488:                 my $resultingVal = $curRes->{DATA}->{$valName};
                   1489:                 my $nextResources = $curRes->$nextResourceMethod();
1.116     bowersj2 1490:                 my $nextCount = scalar(@{$nextResources});
1.104     bowersj2 1491: 
1.116     bowersj2 1492:                 if ($nextCount == 1) { # **3**
1.97      bowersj2 1493:                     my $current = $nextResources->[0]->{DATA}->{$valName} || 999999999;
                   1494:                     $nextResources->[0]->{DATA}->{$valName} = min($resultingVal, $current);
                   1495:                 }
                   1496:                 
1.116     bowersj2 1497:                 if ($nextCount > 1) { # **4**
1.97      bowersj2 1498:                     foreach my $res (@{$nextResources}) {
                   1499:                         my $current = $res->{DATA}->{$valName} || 999999999;
                   1500:                         $res->{DATA}->{$valName} = min($current, $resultingVal + 1);
                   1501:                     }
                   1502:                 }
                   1503:             }
1.96      bowersj2 1504:             
1.107     bowersj2 1505:             # Assign the final val (**2**)
1.97      bowersj2 1506:             if (ref($curRes) && $direction == BACKWARD()) {
1.98      bowersj2 1507:                 my $finalDepth = min($curRes->{DATA}->{TOP_DOWN_VAL},
                   1508:                                      $curRes->{DATA}->{BOT_UP_VAL});
                   1509:                 
                   1510:                 $curRes->{DATA}->{DISPLAY_DEPTH} = $finalDepth;
                   1511:                 if ($finalDepth > $maxDepth) {$maxDepth = $finalDepth;}
                   1512:                 }
1.97      bowersj2 1513:             $curRes = $iterator->next();
1.96      bowersj2 1514:         }
                   1515:     }
1.94      bowersj2 1516: 
1.116     bowersj2 1517:     # Check: Was this only one resource, a map?
                   1518:     if ($resourceCount == 1 && $resource->is_map() && !$self->{FORCE_TOP}) { 
                   1519:         my $firstResource = $resource->map_start();
                   1520:         my $finishResource = $resource->map_finish();
                   1521:         return 
                   1522:             Apache::lonnavmaps::iterator->new($self->{NAV_MAP}, $firstResource,
                   1523:                                               $finishResource, $self->{FILTER},
                   1524:                                               $self->{ALREADY_SEEN}, 
                   1525:                                               $self->{CONDITION}, 0);
                   1526:         
                   1527:     }
                   1528: 
1.98      bowersj2 1529:     # Set up some bookkeeping information.
                   1530:     $self->{CURRENT_DEPTH} = 0;
                   1531:     $self->{MAX_DEPTH} = $maxDepth;
                   1532:     $self->{STACK} = [];
                   1533:     $self->{RECURSIVE_ITERATOR_FLAG} = 0;
                   1534: 
                   1535:     for (my $i = 0; $i <= $self->{MAX_DEPTH}; $i++) {
                   1536:         push @{$self->{STACK}}, [];
                   1537:     }
                   1538: 
1.107     bowersj2 1539:     # Prime the recursion w/ the first resource **5**
1.98      bowersj2 1540:     push @{$self->{STACK}->[0]}, $self->{FIRST_RESOURCE};
                   1541:     $self->{ALREADY_SEEN}->{$self->{FIRST_RESOURCE}->{ID}} = 1;
                   1542: 
                   1543:     bless ($self);
                   1544: 
                   1545:     return $self;
                   1546: }
                   1547: 
                   1548: sub next {
                   1549:     my $self = shift;
                   1550: 
                   1551:     if ($self->{RECURSIVE_ITERATOR_FLAG}) {
                   1552:         # grab the next from the recursive iterator 
                   1553:         my $next = $self->{RECURSIVE_ITERATOR}->next();
                   1554: 
                   1555:         # is it a begin or end map? If so, update the depth
                   1556:         if ($next == BEGIN_MAP() ) { $self->{RECURSIVE_DEPTH}++; }
                   1557:         if ($next == END_MAP() ) { $self->{RECURSIVE_DEPTH}--; }
                   1558: 
                   1559:         # Are we back at depth 0? If so, stop recursing
                   1560:         if ($self->{RECURSIVE_DEPTH} == 0) {
                   1561:             $self->{RECURSIVE_ITERATOR_FLAG} = 0;
                   1562:         }
                   1563: 
                   1564:         return $next;
                   1565:     }
                   1566: 
                   1567:     if (defined($self->{FORCE_NEXT})) {
                   1568:         my $tmp = $self->{FORCE_NEXT};
                   1569:         $self->{FORCE_NEXT} = undef;
                   1570:         return $tmp;
                   1571:     }
                   1572: 
                   1573:     # Have we not yet begun? If not, return BEGIN_MAP and
                   1574:     # remember we've started.
                   1575:     if ( !$self->{STARTED} ) { 
                   1576:         $self->{STARTED} = 1;
                   1577:         return $self->BEGIN_MAP();
                   1578:     }
                   1579: 
                   1580:     # Here's the guts of the iterator.
                   1581:     
                   1582:     # Find the next resource, if any.
                   1583:     my $found = 0;
                   1584:     my $i = $self->{MAX_DEPTH};
                   1585:     my $newDepth;
                   1586:     my $here;
                   1587:     while ( $i >= 0 && !$found ) {
1.107     bowersj2 1588:         if ( scalar(@{$self->{STACK}->[$i]}) > 0 ) { # **6**
                   1589:             $here = pop @{$self->{STACK}->[$i]}; # **7**
1.98      bowersj2 1590:             $found = 1;
                   1591:             $newDepth = $i;
                   1592:         }
                   1593:         $i--;
                   1594:     }
                   1595: 
                   1596:     # If we still didn't find anything, we're done.
                   1597:     if ( !$found ) {
                   1598:         # We need to get back down to the correct branch depth
                   1599:         if ( $self->{CURRENT_DEPTH} > 0 ) {
                   1600:             $self->{CURRENT_DEPTH}--;
                   1601:             return END_BRANCH();
                   1602:         } else {
                   1603:             return END_MAP();
                   1604:         }
                   1605:     }
                   1606: 
1.104     bowersj2 1607:     # If this is not a resource, it must be an END_BRANCH marker we want
                   1608:     # to return directly.
1.107     bowersj2 1609:     if (!ref($here)) { # **8**
1.104     bowersj2 1610:         if ($here == END_BRANCH()) { # paranoia, in case of later extension
                   1611:             $self->{CURRENT_DEPTH}--;
                   1612:             return $here;
                   1613:         }
                   1614:     }
                   1615: 
                   1616:     # Otherwise, it is a resource and it's safe to store in $self->{HERE}
                   1617:     $self->{HERE} = $here;
                   1618: 
1.98      bowersj2 1619:     # Get to the right level
                   1620:     if ( $self->{CURRENT_DEPTH} > $newDepth ) {
                   1621:         push @{$self->{STACK}->[$newDepth]}, $here;
                   1622:         $self->{CURRENT_DEPTH}--;
                   1623:         return END_BRANCH();
                   1624:     }
                   1625:     if ( $self->{CURRENT_DEPTH} < $newDepth) {
                   1626:         push @{$self->{STACK}->[$newDepth]}, $here;
                   1627:         $self->{CURRENT_DEPTH}++;
                   1628:         return BEGIN_BRANCH();
                   1629:     }
                   1630: 
                   1631:     # If we made it here, we have the next resource, and we're at the
                   1632:     # right branch level. So let's examine the resource for where
                   1633:     # we can get to from here.
                   1634: 
                   1635:     # So we need to look at all the resources we can get to from here,
                   1636:     # categorize them if we haven't seen them, remember if we have a new
                   1637:     my $nextUnfiltered = $here->getNext();
1.104     bowersj2 1638:     my $maxDepthAdded = -1;
                   1639:     
1.98      bowersj2 1640:     for (@$nextUnfiltered) {
                   1641:         if (!defined($self->{ALREADY_SEEN}->{$_->{ID}})) {
1.104     bowersj2 1642:             my $depth = $_->{DATA}->{DISPLAY_DEPTH};
                   1643:             push @{$self->{STACK}->[$depth]}, $_;
1.98      bowersj2 1644:             $self->{ALREADY_SEEN}->{$_->{ID}} = 1;
1.104     bowersj2 1645:             if ($maxDepthAdded < $depth) { $maxDepthAdded = $depth; }
1.98      bowersj2 1646:         }
                   1647:     }
1.104     bowersj2 1648: 
                   1649:     # Is this the end of a branch? If so, all of the resources examined above
                   1650:     # led to lower levels then the one we are currently at, so we push a END_BRANCH
                   1651:     # marker onto the stack so we don't forget.
                   1652:     # Example: For the usual A(BC)(DE)F case, when the iterator goes down the
                   1653:     # BC branch and gets to C, it will see F as the only next resource, but it's
                   1654:     # one level lower. Thus, this is the end of the branch, since there are no
                   1655:     # more resources added to this level or above.
1.111     bowersj2 1656:     # We don't do this if the examined resource is the finish resource,
                   1657:     # because the condition given above is true, but the "END_MAP" will
                   1658:     # take care of things and we should already be at depth 0.
1.104     bowersj2 1659:     my $isEndOfBranch = $maxDepthAdded < $self->{CURRENT_DEPTH};
1.111     bowersj2 1660:     if ($isEndOfBranch && $here != $self->{FINISH_RESOURCE}) { # **9**
1.104     bowersj2 1661:         push @{$self->{STACK}->[$self->{CURRENT_DEPTH}]}, END_BRANCH();
                   1662:     }
                   1663: 
1.98      bowersj2 1664:     # That ends the main iterator logic. Now, do we want to recurse
                   1665:     # down this map (if this resource is a map)?
                   1666:     if ($self->{HERE}->is_map() &&
                   1667:         (defined($self->{FILTER}->{$self->{HERE}->map_pc()}) xor $self->{CONDITION})) {
                   1668:         $self->{RECURSIVE_ITERATOR_FLAG} = 1;
                   1669:         my $firstResource = $self->{HERE}->map_start();
                   1670:         my $finishResource = $self->{HERE}->map_finish();
                   1671: 
                   1672:         $self->{RECURSIVE_ITERATOR} = 
                   1673:             Apache::lonnavmaps::iterator->new($self->{NAV_MAP}, $firstResource,
                   1674:                                               $finishResource, $self->{FILTER},
                   1675:                                               $self->{ALREADY_SEEN}, $self->{CONDITION});
                   1676:     }
                   1677: 
1.116     bowersj2 1678:     # If this is a blank resource, don't actually return it.
1.117     bowersj2 1679:     # Should you ever find you need it, make sure to add an option to the code
                   1680:     #  that you can use; other things depend on this behavior.
1.129.2.1  albertel 1681:     if (!$self->{HERE}->src() || !$self->{HERE}->browsePriv()) {
1.116     bowersj2 1682:         return $self->next();
                   1683:     }
                   1684: 
1.98      bowersj2 1685:     return $self->{HERE};
                   1686: 
                   1687: }
                   1688: 
                   1689: =pod
                   1690: 
                   1691: The other method available on the iterator is B<getStack>, which returns an array populated with the current 'stack' of maps, as references to the resource objects. Example: This is useful when making the navigation map, as we need to check whether we are under a page map to see if we need to link directly to the resource, or to the page. The first elements in the array will correspond to the top of the stack (most inclusive map).
                   1692: 
                   1693: =cut
                   1694: 
                   1695: sub getStack {
                   1696:     my $self=shift;
                   1697: 
                   1698:     my @stack;
                   1699: 
                   1700:     $self->populateStack(\@stack);
                   1701: 
                   1702:     return \@stack;
                   1703: }
                   1704: 
                   1705: # Private method: Calls the iterators recursively to populate the stack.
                   1706: sub populateStack {
                   1707:     my $self=shift;
                   1708:     my $stack = shift;
                   1709: 
                   1710:     push @$stack, $self->{HERE} if ($self->{HERE});
                   1711: 
                   1712:     if ($self->{RECURSIVE_ITERATOR_FLAG}) {
                   1713:         $self->{RECURSIVE_ITERATOR}->populateStack($stack);
                   1714:     }
1.94      bowersj2 1715: }
                   1716: 
                   1717: 1;
                   1718: 
                   1719: package Apache::lonnavmaps::DFSiterator;
                   1720: 
1.100     bowersj2 1721: # Not documented in the perldoc: This is a simple iterator that just walks
                   1722: #  through the nav map and presents the resources in a depth-first search
                   1723: #  fashion, ignorant of conditionals, randomized resources, etc. It presents
                   1724: #  BEGIN_MAP and END_MAP, but does not understand branches at all. It is
                   1725: #  useful for pre-processing of some kind, and is in fact used by the main
                   1726: #  iterator that way, but that's about it.
                   1727: # One could imagine merging this into the init routine of the main iterator,
                   1728: #  but this might as well be left seperate, since it is possible some other
                   1729: #  use might be found for it. - Jeremy
1.94      bowersj2 1730: 
1.117     bowersj2 1731: # Unlike the main iterator, this DOES return all resources, even blank ones.
                   1732: #  The main iterator needs them to correctly preprocess the map.
                   1733: 
1.94      bowersj2 1734: sub BEGIN_MAP { return 1; }    # begining of a new map
                   1735: sub END_MAP { return 2; }      # end of the map
                   1736: sub FORWARD { return 1; }      # go forward
                   1737: sub BACKWARD { return 2; }
                   1738: 
1.100     bowersj2 1739: # Params: Nav map ref, first resource id/ref, finish resource id/ref,
                   1740: #         filter hash ref (or undef), already seen hash or undef, condition
                   1741: #         (as in main iterator), direction FORWARD or BACKWARD (undef->forward).
1.51      bowersj2 1742: sub new {
                   1743:     # magic invocation to create a class instance
                   1744:     my $proto = shift;
                   1745:     my $class = ref($proto) || $proto;
                   1746:     my $self = {};
                   1747: 
                   1748:     $self->{NAV_MAP} = shift;
                   1749:     return undef unless ($self->{NAV_MAP});
                   1750: 
                   1751:     $self->{FIRST_RESOURCE} = shift || $self->{NAV_MAP}->firstResource();
                   1752:     $self->{FINISH_RESOURCE} = shift || $self->{NAV_MAP}->finishResource();
                   1753: 
                   1754:     # If the given resources are just the ID of the resource, get the
                   1755:     # objects
                   1756:     if (!ref($self->{FIRST_RESOURCE})) { $self->{FIRST_RESOURCE} = 
                   1757:              $self->{NAV_MAP}->getById($self->{FIRST_RESOURCE}); }
                   1758:     if (!ref($self->{FINISH_RESOURCE})) { $self->{FINISH_RESOURCE} = 
                   1759:              $self->{NAV_MAP}->getById($self->{FINISH_RESOURCE}); }
                   1760: 
                   1761:     $self->{FILTER} = shift;
                   1762: 
                   1763:     # A hash, used as a set, of resource already seen
                   1764:     $self->{ALREADY_SEEN} = shift;
                   1765:     if (!defined($self->{ALREADY_SEEN})) { $self->{ALREADY_SEEN} = {} };
1.63      bowersj2 1766:     $self->{CONDITION} = shift;
1.89      bowersj2 1767:     $self->{DIRECTION} = shift || FORWARD();
1.51      bowersj2 1768: 
1.100     bowersj2 1769:     # Flag: Have we started yet?
1.51      bowersj2 1770:     $self->{STARTED} = 0;
                   1771: 
                   1772:     # Should we continue calling the recursive iterator, if any?
                   1773:     $self->{RECURSIVE_ITERATOR_FLAG} = 0;
                   1774:     # The recursive iterator, if any
                   1775:     $self->{RECURSIVE_ITERATOR} = undef;
                   1776:     # Are we recursing on a map, or a branch?
                   1777:     $self->{RECURSIVE_MAP} = 1; # we'll manually unset this when recursing on branches
                   1778:     # And the count of how deep it is, so that this iterator can keep track of
                   1779:     # when to pick back up again.
                   1780:     $self->{RECURSIVE_DEPTH} = 0;
                   1781: 
                   1782:     # For keeping track of our branches, we maintain our own stack
1.100     bowersj2 1783:     $self->{STACK} = [];
1.51      bowersj2 1784: 
                   1785:     # Start with the first resource
1.89      bowersj2 1786:     if ($self->{DIRECTION} == FORWARD) {
1.100     bowersj2 1787:         push @{$self->{STACK}}, $self->{FIRST_RESOURCE};
1.89      bowersj2 1788:     } else {
1.100     bowersj2 1789:         push @{$self->{STACK}}, $self->{FINISH_RESOURCE};
1.89      bowersj2 1790:     }
1.51      bowersj2 1791: 
                   1792:     bless($self);
                   1793:     return $self;
                   1794: }
                   1795: 
                   1796: sub next {
                   1797:     my $self = shift;
                   1798:     
                   1799:     # Are we using a recursive iterator? If so, pull from that and
                   1800:     # watch the depth; we want to resume our level at the correct time.
1.98      bowersj2 1801:     if ($self->{RECURSIVE_ITERATOR_FLAG}) {
1.51      bowersj2 1802:         # grab the next from the recursive iterator
                   1803:         my $next = $self->{RECURSIVE_ITERATOR}->next();
                   1804:         
                   1805:         # is it a begin or end map? Update depth if so
                   1806:         if ($next == BEGIN_MAP() ) { $self->{RECURSIVE_DEPTH}++; }
                   1807:         if ($next == END_MAP() ) { $self->{RECURSIVE_DEPTH}--; }
                   1808: 
                   1809:         # Are we back at depth 0? If so, stop recursing.
                   1810:         if ($self->{RECURSIVE_DEPTH} == 0) {
                   1811:             $self->{RECURSIVE_ITERATOR_FLAG} = 0;
                   1812:         }
                   1813:         
                   1814:         return $next;
                   1815:     }
                   1816: 
                   1817:     # Is there a current resource to grab? If not, then return
1.100     bowersj2 1818:     # END_MAP, which will end the iterator.
                   1819:     if (scalar(@{$self->{STACK}}) == 0) {
                   1820:         return $self->END_MAP();
1.51      bowersj2 1821:     }
                   1822: 
                   1823:     # Have we not yet begun? If not, return BEGIN_MAP and 
                   1824:     # remember that we've started.
                   1825:     if ( !$self->{STARTED} ) {
                   1826:         $self->{STARTED} = 1;
                   1827:         return $self->BEGIN_MAP;
                   1828:     }
                   1829: 
                   1830:     # Get the next resource in the branch
1.100     bowersj2 1831:     $self->{HERE} = pop @{$self->{STACK}};
1.52      bowersj2 1832: 
1.100     bowersj2 1833:     # remember that we've seen this, so we don't return it again later
1.51      bowersj2 1834:     $self->{ALREADY_SEEN}->{$self->{HERE}->{ID}} = 1;
                   1835:     
                   1836:     # Get the next possible resources
1.90      bowersj2 1837:     my $nextUnfiltered;
1.89      bowersj2 1838:     if ($self->{DIRECTION} == FORWARD()) {
1.90      bowersj2 1839:         $nextUnfiltered = $self->{HERE}->getNext();
1.89      bowersj2 1840:     } else {
1.90      bowersj2 1841:         $nextUnfiltered = $self->{HERE}->getPrevious();
1.89      bowersj2 1842:     }
1.51      bowersj2 1843:     my $next = [];
                   1844: 
                   1845:     # filter the next possibilities to remove things we've 
1.100     bowersj2 1846:     # already seen.
1.51      bowersj2 1847:     foreach (@$nextUnfiltered) {
1.52      bowersj2 1848:         if (!defined($self->{ALREADY_SEEN}->{$_->{ID}})) {
                   1849:             push @$next, $_;
                   1850:         }
1.51      bowersj2 1851:     }
                   1852: 
                   1853:     while (@$next) {
1.100     bowersj2 1854:         # copy the next possibilities over to the stack
                   1855:         push @{$self->{STACK}}, shift @$next;
1.51      bowersj2 1856:     }
                   1857: 
                   1858:     # If this is a map and we want to recurse down it... (not filtered out)
1.70      bowersj2 1859:     if ($self->{HERE}->is_map() && 
1.63      bowersj2 1860:          (defined($self->{FILTER}->{$self->{HERE}->map_pc()}) xor $self->{CONDITION})) { 
1.51      bowersj2 1861:         $self->{RECURSIVE_ITERATOR_FLAG} = 1;
                   1862:         my $firstResource = $self->{HERE}->map_start();
                   1863:         my $finishResource = $self->{HERE}->map_finish();
                   1864: 
                   1865:         $self->{RECURSIVE_ITERATOR} =
1.94      bowersj2 1866:           Apache::lonnavmaps::DFSiterator->new ($self->{NAV_MAP}, $firstResource, 
1.63      bowersj2 1867:                      $finishResource, $self->{FILTER}, $self->{ALREADY_SEEN},
1.91      bowersj2 1868:                                              $self->{CONDITION}, $self->{DIRECTION});
1.51      bowersj2 1869:     }
                   1870: 
                   1871:     return $self->{HERE};
                   1872: }
                   1873: 
1.1       www      1874: 1;
1.2       www      1875: 
1.51      bowersj2 1876: package Apache::lonnavmaps::resource;
                   1877: 
                   1878: use Apache::lonnet;
                   1879: 
                   1880: =pod
                   1881: 
                   1882: =head1 Object: resource
                   1883: 
                   1884: A resource object encapsulates a resource in a resource map, allowing easy manipulation of the resource, querying the properties of the resource (including user properties), and represents a reference that can be used as the canonical representation of the resource by lonnavmap clients like renderers.
                   1885: 
                   1886: A resource only makes sense in the context of a navmap, as some of the data is stored in the navmap object.
                   1887: 
                   1888: You will probably never need to instantiate this object directly. Use Apache::lonnavmap::navmap, and use the "start" method to obtain the starting resource.
                   1889: 
                   1890: =head2 Public Members
                   1891: 
                   1892: resource objects have a hash called DATA ($resourceRef->{DATA}) that you can store whatever you want in. This allows you to easily do two-pass algorithms without worrying about managing your own resource->data hash.
                   1893: 
                   1894: =head2 Methods
                   1895: 
                   1896: =over 4
                   1897: 
1.70      bowersj2 1898: =item * B<new>($navmapRef, $idString): The first arg is a reference to the parent navmap object. The second is the idString of the resource itself. Very rarely, if ever, called directly. Use the nav map->getByID() method.
                   1899: 
                   1900: =back
1.51      bowersj2 1901: 
                   1902: =cut
                   1903: 
                   1904: sub new {
                   1905:     # magic invocation to create a class instance
                   1906:     my $proto = shift;
                   1907:     my $class = ref($proto) || $proto;
                   1908:     my $self = {};
                   1909: 
                   1910:     $self->{NAV_MAP} = shift;
                   1911:     $self->{ID} = shift;
                   1912: 
                   1913:     # Store this new resource in the parent nav map's cache.
                   1914:     $self->{NAV_MAP}->{RESOURCE_CACHE}->{$self->{ID}} = $self;
1.66      bowersj2 1915:     $self->{RESOURCE_ERROR} = 0;
1.51      bowersj2 1916: 
                   1917:     # A hash that can be used by two-pass algorithms to store data
                   1918:     # about this resource in. Not used by the resource object
                   1919:     # directly.
                   1920:     $self->{DATA} = {};
                   1921:    
                   1922:     bless($self);
                   1923:     
                   1924:     return $self;
                   1925: }
                   1926: 
1.70      bowersj2 1927: # private function: simplify the NAV_HASH lookups we keep doing
                   1928: # pass the name, and to automatically append my ID, pass a true val on the
                   1929: # second param
                   1930: sub navHash {
                   1931:     my $self = shift;
                   1932:     my $param = shift;
                   1933:     my $id = shift;
1.115     bowersj2 1934:     return $self->{NAV_MAP}->navhash($param . ($id?$self->{ID}:""));
1.70      bowersj2 1935: }
                   1936: 
1.51      bowersj2 1937: =pod
                   1938: 
1.70      bowersj2 1939: B<Metadata Retreival>
                   1940: 
1.101     bowersj2 1941: These are methods that help you retrieve metadata about the resource: Method names are based on the fields in the compiled course representation.
1.70      bowersj2 1942: 
                   1943: =over 4
                   1944: 
1.106     bowersj2 1945: =item * B<compTitle>: Returns a "composite title", that is equal to $res->title() if the resource has a title, and is otherwise the last part of the URL (e.g., "problem.problem").
                   1946: 
1.70      bowersj2 1947: =item * B<ext>: Returns true if the resource is external.
                   1948: 
                   1949: =item * B<goesto>: Returns the "goesto" value from the compiled nav map. (It is likely you want to use B<getNext> instead.)
                   1950: 
                   1951: =item * B<kind>: Returns the kind of the resource from the compiled nav map.
                   1952: 
1.101     bowersj2 1953: =item * B<randomout>: Returns true if this resource was chosen to NOT be shown to the user by the random map selection feature. In other words, this is usually false.
1.51      bowersj2 1954: 
1.70      bowersj2 1955: =item * B<randompick>: Returns true for a map if the randompick feature is being used on the map. (?)
                   1956: 
                   1957: =item * B<src>: Returns the source for the resource.
                   1958: 
                   1959: =item * B<symb>: Returns the symb for the resource.
                   1960: 
                   1961: =item * B<title>: Returns the title of the resource.
                   1962: 
                   1963: =item * B<to>: Returns the "to" value from the compiled nav map. (It is likely you want to use B<getNext> instead.)
1.51      bowersj2 1964: 
                   1965: =back
                   1966: 
                   1967: =cut
                   1968: 
                   1969: # These info functions can be used directly, as they don't return
                   1970: # resource information.
1.85      bowersj2 1971: sub comesfrom { my $self=shift; return $self->navHash("comesfrom_", 1); }
1.70      bowersj2 1972: sub ext { my $self=shift; return $self->navHash("ext_", 1) eq 'true:'; }
1.85      bowersj2 1973: sub from { my $self=shift; return $self->navHash("from_", 1); }
1.51      bowersj2 1974: sub goesto { my $self=shift; return $self->navHash("goesto_", 1); }
                   1975: sub kind { my $self=shift; return $self->navHash("kind_", 1); }
1.68      bowersj2 1976: sub randomout { my $self=shift; return $self->navHash("randomout_", 1); }
                   1977: sub randompick { 
                   1978:     my $self = shift;
                   1979:     return $self->{NAV_MAP}->{PARM_HASH}->{$self->symb .
                   1980:                                                '.0.parameter_randompick'};
                   1981: }
1.51      bowersj2 1982: sub src { 
                   1983:     my $self=shift;
                   1984:     return $self->navHash("src_", 1);
                   1985: }
                   1986: sub symb {
                   1987:     my $self=shift;
                   1988:     (my $first, my $second) = $self->{ID} =~ /(\d+).(\d+)/;
                   1989:     my $symbSrc = &Apache::lonnet::declutter($self->src());
                   1990:     return &Apache::lonnet::declutter(
                   1991:          $self->navHash('map_id_'.$first)) 
                   1992:         . '___' . $second . '___' . $symbSrc;
                   1993: }
1.70      bowersj2 1994: sub title { my $self=shift; return $self->navHash("title_", 1); }
                   1995: sub to { my $self=shift; return $self->navHash("to_", 1); }
1.106     bowersj2 1996: sub compTitle {
                   1997:     my $self = shift;
                   1998:     my $title = $self->title();
                   1999:     if (!$title) {
                   2000:         $title = $self->src();
                   2001:         $title = substr($title, rindex($title, '/') + 1);
                   2002:     }
                   2003:     return $title;
                   2004: }
1.70      bowersj2 2005: =pod
                   2006: 
                   2007: B<Predicate Testing the Resource>
                   2008: 
                   2009: These methods are shortcuts to deciding if a given resource has a given property.
                   2010: 
                   2011: =over 4
                   2012: 
                   2013: =item * B<is_map>: Returns true if the resource is a map type.
                   2014: 
                   2015: =item * B<is_problem>: Returns true if the resource is a problem type, false otherwise. (Looks at the extension on the src field; might need more to work correctly.)
                   2016: 
                   2017: =item * B<is_page>: Returns true if the resource is a page.
                   2018: 
                   2019: =item * B<is_problem>: Returns true if the resource is a problem.
                   2020: 
1.101     bowersj2 2021: =item * B<is_sequence>: Returns true if the resource is a sequence.
1.70      bowersj2 2022: 
                   2023: =back
                   2024: 
                   2025: =cut
                   2026: 
                   2027: 
                   2028: sub is_html {
1.51      bowersj2 2029:     my $self=shift;
                   2030:     my $src = $self->src();
1.70      bowersj2 2031:     return ($src =~ /html$/);
1.51      bowersj2 2032: }
1.70      bowersj2 2033: sub is_map { my $self=shift; return defined($self->navHash("is_map_", 1)); }
                   2034: sub is_page {
1.51      bowersj2 2035:     my $self=shift;
                   2036:     my $src = $self->src();
1.70      bowersj2 2037:     return ($src =~ /page$/);
1.51      bowersj2 2038: }
1.70      bowersj2 2039: sub is_problem {
1.51      bowersj2 2040:     my $self=shift;
                   2041:     my $src = $self->src();
1.70      bowersj2 2042:     return ($src =~ /problem$/);
1.51      bowersj2 2043: }
1.70      bowersj2 2044: sub is_sequence {
1.51      bowersj2 2045:     my $self=shift;
                   2046:     my $src = $self->src();
1.70      bowersj2 2047:     return ($src =~ /sequence$/);
1.51      bowersj2 2048: }
                   2049: 
1.101     bowersj2 2050: # Private method: Shells out to the parmval in the nav map, handler parts.
1.51      bowersj2 2051: sub parmval {
                   2052:     my $self = shift;
                   2053:     my $what = shift;
                   2054:     my $part = shift || "0";
                   2055:     return $self->{NAV_MAP}->parmval($part.'.'.$what, $self->symb());
                   2056: }
                   2057: 
1.70      bowersj2 2058: =pod
                   2059: 
                   2060: B<Map Methods>
                   2061: 
                   2062: These methods are useful for getting information about the map properties of the resource, if the resource is a map (B<is_map>).
                   2063: 
                   2064: =over 4
                   2065: 
                   2066: =item * B<map_finish>: Returns a reference to a resource object corresponding to the finish resource of the map.
                   2067: 
                   2068: =item * B<map_pc>: Returns the pc value of the map, which is the first number that appears in the resource ID of the resources in the map, and is the number that appears around the middle of the symbs of the resources in that map.
                   2069: 
                   2070: =item * B<map_start>: Returns a reference to a resource object corresponding to the start resource of the map.
                   2071: 
                   2072: =item * B<map_type>: Returns a string with the type of the map in it.
                   2073: 
                   2074: =back
1.51      bowersj2 2075: 
1.70      bowersj2 2076: =cut
1.51      bowersj2 2077: 
                   2078: sub map_finish {
                   2079:     my $self = shift;
                   2080:     my $src = $self->src();
                   2081:     my $res = $self->navHash("map_finish_$src", 0);
                   2082:     $res = $self->{NAV_MAP}->getById($res);
                   2083:     return $res;
                   2084: }
1.70      bowersj2 2085: sub map_pc {
                   2086:     my $self = shift;
                   2087:     my $src = $self->src();
                   2088:     return $self->navHash("map_pc_$src", 0);
                   2089: }
1.51      bowersj2 2090: sub map_start {
                   2091:     my $self = shift;
                   2092:     my $src = $self->src();
                   2093:     my $res = $self->navHash("map_start_$src", 0);
                   2094:     $res = $self->{NAV_MAP}->getById($res);
                   2095:     return $res;
                   2096: }
                   2097: sub map_type {
                   2098:     my $self = shift;
                   2099:     my $pc = $self->map_pc();
                   2100:     return $self->navHash("map_type_$pc", 0);
                   2101: }
                   2102: 
                   2103: 
                   2104: 
                   2105: #####
                   2106: # Property queries
                   2107: #####
                   2108: 
                   2109: # These functions will be responsible for returning the CORRECT
                   2110: # VALUE for the parameter, no matter what. So while they may look
                   2111: # like direct calls to parmval, they can be more then that.
                   2112: # So, for instance, the duedate function should use the "duedatetype"
                   2113: # information, rather then the resource object user.
                   2114: 
                   2115: =pod
                   2116: 
                   2117: =head2 Resource Parameters
                   2118: 
1.70      bowersj2 2119: In order to use the resource parameters correctly, the nav map must have been instantiated with genCourseAndUserOptions set to true, so the courseopt and useropt is read correctly. Then, you can call these functions to get the relevant parameters for the resource. Each function defaults to part "0", but can be directed to another part by passing the part as the parameter.
1.51      bowersj2 2120: 
                   2121: These methods are responsible for getting the parameter correct, not merely reflecting the contents of the GDBM hashes. As we move towards dates relative to other dates, these methods should be updated to reflect that. (Then, anybody using these methods won't have to update their code.)
                   2122: 
                   2123: =over 4
                   2124: 
                   2125: =item * B<acc>: Get the Client IP/Name Access Control information.
                   2126: 
                   2127: =item * B<answerdate>: Get the answer-reveal date for the problem.
                   2128: 
                   2129: =item * B<duedate>: Get the due date for the problem.
                   2130: 
                   2131: =item * B<tries>: Get the number of tries the student has used on the problem.
                   2132: 
                   2133: =item * B<maxtries>: Get the number of max tries allowed.
                   2134: 
                   2135: =item * B<opendate>: Get the open date for the problem.
                   2136: 
                   2137: =item * B<sig>: Get the significant figures setting.
                   2138: 
                   2139: =item * B<tol>: Get the tolerance for the problem.
                   2140: 
1.70      bowersj2 2141: =item * B<tries>: Get the number of tries the user has already used on the problem.
                   2142: 
1.51      bowersj2 2143: =item * B<type>: Get the question type for the problem.
                   2144: 
                   2145: =item * B<weight>: Get the weight for the problem.
                   2146: 
                   2147: =back
                   2148: 
                   2149: =cut
                   2150: 
                   2151: sub acc {
                   2152:     (my $self, my $part) = @_;
                   2153:     return $self->parmval("acc", $part);
                   2154: }
                   2155: sub answerdate {
                   2156:     (my $self, my $part) = @_;
                   2157:     # Handle intervals
                   2158:     if ($self->parmval("answerdate.type", $part) eq 'date_interval') {
                   2159:         return $self->duedate($part) + 
                   2160:             $self->parmval("answerdate", $part);
                   2161:     }
                   2162:     return $self->parmval("answerdate", $part);
1.106     bowersj2 2163: }
1.108     bowersj2 2164: sub awarded { my $self = shift; return $self->queryRestoreHash('awarded', shift); }
1.51      bowersj2 2165: sub duedate {
                   2166:     (my $self, my $part) = @_;
                   2167:     return $self->parmval("duedate", $part);
                   2168: }
                   2169: sub maxtries {
                   2170:     (my $self, my $part) = @_;
                   2171:     return $self->parmval("maxtries", $part);
                   2172: }
                   2173: sub opendate {
                   2174:     (my $self, my $part) = @_;
                   2175:     if ($self->parmval("opendate.type", $part) eq 'date_interval') {
                   2176:         return $self->duedate($part) -
                   2177:             $self->parmval("opendate", $part);
                   2178:     }
                   2179:     return $self->parmval("opendate");
                   2180: }
                   2181: sub sig {
                   2182:     (my $self, my $part) = @_;
                   2183:     return $self->parmval("sig", $part);
                   2184: }
                   2185: sub tol {
                   2186:     (my $self, my $part) = @_;
                   2187:     return $self->parmval("tol", $part);
                   2188: }
1.108     bowersj2 2189: sub tries { 
                   2190:     my $self = shift; 
                   2191:     my $tries = $self->queryRestoreHash('tries', shift);
                   2192:     if (!defined($tries)) { return '0';}
1.51      bowersj2 2193:     return $tries;
                   2194: }
1.70      bowersj2 2195: sub type {
                   2196:     (my $self, my $part) = @_;
                   2197:     return $self->parmval("type", $part);
                   2198: }
1.109     bowersj2 2199: sub weight { 
                   2200:     my $self = shift; my $part = shift;
1.70      bowersj2 2201:     return $self->parmval("weight", $part);
                   2202: }
1.51      bowersj2 2203: 
                   2204: # Multiple things need this
                   2205: sub getReturnHash {
                   2206:     my $self = shift;
                   2207:     
                   2208:     if (!defined($self->{RETURN_HASH})) {
1.84      bowersj2 2209:         my %tmpHash  = &Apache::lonnet::restore($self->symb());
1.51      bowersj2 2210:         $self->{RETURN_HASH} = \%tmpHash;
                   2211:     }
                   2212: }       
                   2213: 
                   2214: ######
                   2215: # Status queries
                   2216: ######
                   2217: 
                   2218: # These methods query the status of problems.
                   2219: 
                   2220: # If we need to count parts, this function determines the number of
                   2221: # parts from the metadata. When called, it returns a reference to a list
                   2222: # of strings corresponding to the parts. (Thus, using it in a scalar context
                   2223: # tells you how many parts you have in the problem:
                   2224: # $partcount = scalar($resource->countParts());
                   2225: # Don't use $self->{PARTS} directly because you don't know if it's been
                   2226: # computed yet.
                   2227: 
                   2228: =pod
                   2229: 
                   2230: =head2 Resource misc
                   2231: 
                   2232: Misc. functions for the resource.
                   2233: 
                   2234: =over 4
                   2235: 
1.59      bowersj2 2236: =item * B<hasDiscussion>: Returns a false value if there has been discussion since the user last logged in, true if there has. Always returns false if the discussion data was not extracted when the nav map was constructed.
                   2237: 
                   2238: =item * B<getFeedback>: Gets the feedback for the resource and returns the raw feedback string for the resource, or the null string if there is no feedback or the email data was not extracted when the nav map was constructed. Usually used like this:
                   2239: 
                   2240:  for (split(/\,/, $res->getFeedback())) {
                   2241:     my $link = &Apache::lonnet::escape($_);
                   2242:     ...
                   2243: 
                   2244: and use the link as appropriate.
                   2245: 
                   2246: =cut
                   2247: 
                   2248: sub hasDiscussion {
                   2249:     my $self = shift;
                   2250:     return $self->{NAV_MAP}->hasDiscussion($self->symb());
                   2251: }
                   2252: 
                   2253: sub getFeedback {
                   2254:     my $self = shift;
1.124     bowersj2 2255:     my $source = $self->src();
1.125     bowersj2 2256:     if ($source =~ /^\/res\//) { $source = substr $source, 5; }
1.124     bowersj2 2257:     return $self->{NAV_MAP}->getFeedback($source);
                   2258: }
                   2259: 
                   2260: sub getErrors {
                   2261:     my $self = shift;
                   2262:     my $source = $self->src();
                   2263:     if ($source =~ /^\/res\//) { $source = substr $source, 5; }
                   2264:     return $self->{NAV_MAP}->getErrors($source);
1.59      bowersj2 2265: }
                   2266: 
                   2267: =pod
                   2268: 
1.70      bowersj2 2269: =item * B<parts>(): Returns a list reference containing sorted strings corresponding to each part of the problem. To count the number of parts, use the list in a scalar context, and subtract one if greater then two. (One part problems have a part 0. Multi-parts have a part 0, plus a part for each part. Filtering part 0 if you want it is up to you.)
1.51      bowersj2 2270: 
1.70      bowersj2 2271: =item * B<countParts>(): Returns the number of parts of the problem a student can answer. Thus, for single part problems, returns 1. For multipart, it returns the number of parts in the problem, not including psuedo-part 0. Thus, B<parts> may return an array with fewer parts in it then countParts might lead you to believe.
1.51      bowersj2 2272: 
                   2273: =back
                   2274: 
                   2275: =cut
                   2276: 
                   2277: sub parts {
                   2278:     my $self = shift;
                   2279: 
1.67      bowersj2 2280:     if ($self->ext) { return ['0']; }
                   2281: 
1.51      bowersj2 2282:     $self->extractParts();
                   2283:     return $self->{PARTS};
                   2284: }
                   2285: 
                   2286: sub countParts {
                   2287:     my $self = shift;
                   2288:     
                   2289:     my $parts = $self->parts();
1.129.2.2  albertel 2290:     my $delta = 0;
                   2291:     for my $part (@$parts) {
                   2292:         if ($part eq '0') { $delta--; }
                   2293:     }
1.66      bowersj2 2294: 
                   2295:     if ($self->{RESOURCE_ERROR}) {
                   2296:         return 0;
                   2297:     }
                   2298: 
1.129.2.2  albertel 2299:     return scalar(@{$parts}) + $delta;
1.51      bowersj2 2300: }
                   2301: 
                   2302: # Private function: Extracts the parts information and saves it
                   2303: sub extractParts { 
                   2304:     my $self = shift;
                   2305:     
                   2306:     return if ($self->{PARTS});
1.67      bowersj2 2307:     return if ($self->ext);
1.51      bowersj2 2308: 
                   2309:     $self->{PARTS} = [];
                   2310: 
1.82      bowersj2 2311:     # Retrieve part count, if this is a problem
                   2312:     if ($self->is_problem()) {
1.129.2.2  albertel 2313:         my $metadata = &Apache::lonnet::metadata($self->src(), 'packages');
1.82      bowersj2 2314:         if (!$metadata) {
                   2315:             $self->{RESOURCE_ERROR} = 1;
                   2316:             $self->{PARTS} = [];
                   2317:             return;
                   2318:         }
                   2319:         
                   2320:         foreach (split(/\,/,$metadata)) {
1.129.2.2  albertel 2321:             if ($_ =~ /^part_(.*)$/) {
1.82      bowersj2 2322:                 push @{$self->{PARTS}}, $1;
                   2323:             }
1.51      bowersj2 2324:         }
1.82      bowersj2 2325:         
                   2326:         
                   2327:         # Is this possible to do in one line? - Jeremy
                   2328:         my @sortedParts = sort @{$self->{PARTS}};
                   2329:         $self->{PARTS} = \@sortedParts;
1.51      bowersj2 2330:     }
                   2331: 
                   2332:     return;
                   2333: }
                   2334: 
                   2335: =pod
                   2336: 
                   2337: =head2 Resource Status
                   2338: 
1.101     bowersj2 2339: Problem resources have status information, reflecting their various dates and completion statuses. 
1.51      bowersj2 2340: 
                   2341: There are two aspects to the status: the date-related information and the completion information.
                   2342: 
                   2343: Idiomatic usage of these two methods would probably look something like
                   2344: 
                   2345:  foreach ($resource->parts()) {
                   2346:     my $dateStatus = $resource->getDateStatus($_);
                   2347:     my $completionStatus = $resource->getCompletionStatus($_);
                   2348: 
1.70      bowersj2 2349:     or
                   2350: 
                   2351:     my $status = $resource->status($_);
                   2352: 
1.51      bowersj2 2353:     ... use it here ...
                   2354:  }
                   2355: 
1.101     bowersj2 2356: Which you use depends on exactly what you are looking for. The status() function has been optimized for the nav maps display and may not precisely match what you need elsewhere.
                   2357: 
                   2358: The symbolic constants shown below can be accessed through the resource object: $res->OPEN.
                   2359: 
1.51      bowersj2 2360: =over 4
                   2361: 
1.70      bowersj2 2362: =item * B<getDateStatus>($part): ($part defaults to 0). A convenience function that returns a symbolic constant telling you about the date status of the part. The possible return values are:
1.51      bowersj2 2363: 
                   2364: =back
                   2365: 
                   2366: B<Date Codes>
                   2367: 
                   2368: =over 4
                   2369: 
                   2370: =item * B<OPEN_LATER>: The problem will be opened later.
                   2371: 
                   2372: =item * B<OPEN>: Open and not yet due.
                   2373: 
1.59      bowersj2 2374: 
1.54      bowersj2 2375: =item * B<PAST_DUE_ANSWER_LATER>: The due date has passed, but the answer date has not yet arrived.
                   2376: 
                   2377: =item * B<PAST_DUE_NO_ANSWER>: The due date has passed and there is no answer opening date set.
1.51      bowersj2 2378: 
                   2379: =item * B<ANSWER_OPEN>: The answer date is here.
                   2380: 
                   2381: =item * B<NETWORK_FAILURE>: The information is unknown due to network failure.
                   2382: 
                   2383: =back
                   2384: 
                   2385: =cut
                   2386: 
                   2387: # Apparently the compiler optimizes these into constants automatically
1.54      bowersj2 2388: sub OPEN_LATER             { return 0; }
                   2389: sub OPEN                   { return 1; }
                   2390: sub PAST_DUE_NO_ANSWER     { return 2; }
                   2391: sub PAST_DUE_ANSWER_LATER  { return 3; }
                   2392: sub ANSWER_OPEN            { return 4; }
                   2393: sub NOTHING_SET            { return 5; } 
                   2394: sub NETWORK_FAILURE        { return 100; }
                   2395: 
                   2396: # getDateStatus gets the date status for a given problem part. 
                   2397: # Because answer date, due date, and open date are fully independent
                   2398: # (i.e., it is perfectly possible to *only* have an answer date), 
                   2399: # we have to completely cover the 3x3 maxtrix of (answer, due, open) x
                   2400: # (past, future, none given). This function handles this with a decision
                   2401: # tree. Read the comments to follow the decision tree.
1.51      bowersj2 2402: 
                   2403: sub getDateStatus {
                   2404:     my $self = shift;
                   2405:     my $part = shift;
                   2406:     $part = "0" if (!defined($part));
1.54      bowersj2 2407: 
                   2408:     # Always return network failure if there was one.
1.51      bowersj2 2409:     return $self->NETWORK_FAILURE if ($self->{NAV_MAP}->{NETWORK_FAILURE});
                   2410: 
                   2411:     my $now = time();
                   2412: 
1.53      bowersj2 2413:     my $open = $self->opendate($part);
                   2414:     my $due = $self->duedate($part);
                   2415:     my $answer = $self->answerdate($part);
                   2416: 
                   2417:     if (!$open && !$due && !$answer) {
                   2418:         # no data on the problem at all
                   2419:         # should this be the same as "open later"? think multipart.
                   2420:         return $self->NOTHING_SET;
                   2421:     }
1.59      bowersj2 2422:     if (!$open || $now < $open) {return $self->OPEN_LATER}
                   2423:     if (!$due || $now < $due) {return $self->OPEN}
                   2424:     if ($answer && $now < $answer) {return $self->PAST_DUE_ANSWER_LATER}
                   2425:     if ($answer) { return $self->ANSWER_OPEN; }
1.54      bowersj2 2426:     return PAST_DUE_NO_ANSWER;
1.51      bowersj2 2427: }
                   2428: 
                   2429: =pod
                   2430: 
                   2431: B<>
                   2432: 
                   2433: =over 4
                   2434: 
                   2435: =item * B<getCompletionStatus>($part): ($part defaults to 0.) A convenience function that returns a symbolic constant telling you about the completion status of the part, with the following possible results:
                   2436: 
                   2437: =back 
                   2438: 
                   2439: B<Completion Codes>
                   2440: 
                   2441: =over 4
                   2442: 
                   2443: =item * B<NOT_ATTEMPTED>: Has not been attempted at all.
                   2444: 
                   2445: =item * B<INCORRECT>: Attempted, but wrong by student.
                   2446: 
                   2447: =item * B<INCORRECT_BY_OVERRIDE>: Attempted, but wrong by instructor override.
                   2448: 
                   2449: =item * B<CORRECT>: Correct or correct by instructor.
                   2450: 
                   2451: =item * B<CORRECT_BY_OVERRIDE>: Correct by instructor override.
                   2452: 
                   2453: =item * B<EXCUSED>: Excused. Not yet implemented.
                   2454: 
                   2455: =item * B<NETWORK_FAILURE>: Information not available due to network failure.
                   2456: 
1.69      bowersj2 2457: =item * B<ATTEMPTED>: Attempted, and not yet graded.
                   2458: 
1.51      bowersj2 2459: =back
                   2460: 
                   2461: =cut
                   2462: 
1.53      bowersj2 2463: sub NOT_ATTEMPTED         { return 10; }
                   2464: sub INCORRECT             { return 11; }
                   2465: sub INCORRECT_BY_OVERRIDE { return 12; }
                   2466: sub CORRECT               { return 13; }
                   2467: sub CORRECT_BY_OVERRIDE   { return 14; }
                   2468: sub EXCUSED               { return 15; }
1.69      bowersj2 2469: sub ATTEMPTED             { return 16; }
1.51      bowersj2 2470: 
                   2471: sub getCompletionStatus {
                   2472:     my $self = shift;
                   2473:     return $self->NETWORK_FAILURE if ($self->{NAV_MAP}->{NETWORK_FAILURE});
                   2474: 
1.108     bowersj2 2475:     my $status = $self->queryRestoreHash('solved', shift);
1.51      bowersj2 2476: 
                   2477:     # Left as seperate if statements in case we ever do more with this
                   2478:     if ($status eq 'correct_by_student') {return $self->CORRECT;}
                   2479:     if ($status eq 'correct_by_override') {return $self->CORRECT_BY_OVERRIDE; }
                   2480:     if ($status eq 'incorrect_attempted') {return $self->INCORRECT; }
                   2481:     if ($status eq 'incorrect_by_override') {return $self->INCORRECT_BY_OVERRIDE; }
                   2482:     if ($status eq 'excused') {return $self->EXCUSED; }
1.69      bowersj2 2483:     if ($status eq 'ungraded_attempted') {return $self->ATTEMPTED; }
1.51      bowersj2 2484:     return $self->NOT_ATTEMPTED;
1.108     bowersj2 2485: }
                   2486: 
                   2487: sub queryRestoreHash {
                   2488:     my $self = shift;
                   2489:     my $hashentry = shift;
                   2490:     my $part = shift;
                   2491:     $part = "0" if (!defined($part));
                   2492:     return $self->NETWORK_FAILURE if ($self->{NAV_MAP}->{NETWORK_FAILURE});
                   2493: 
                   2494:     $self->getReturnHash();
                   2495: 
                   2496:     return $self->{RETURN_HASH}->{'resource.'.$part.'.'.$hashentry};
1.51      bowersj2 2497: }
                   2498: 
                   2499: =pod
                   2500: 
                   2501: B<Composite Status>
                   2502: 
1.101     bowersj2 2503: Along with directly returning the date or completion status, the resource object includes a convenience function B<status>() that will combine the two status tidbits into one composite status that can represent the status of the resource as a whole. The precise logic is documented in the comments of the status method. The following results may be returned, all available as methods on the resource object ($res->NETWORK_FAILURE):
1.51      bowersj2 2504: 
                   2505: =over 4
                   2506: 
1.70      bowersj2 2507: =item * B<NETWORK_FAILURE>: The network has failed and the information is not available.
1.51      bowersj2 2508: 
1.70      bowersj2 2509: =item * B<NOTHING_SET>: No dates have been set for this problem (part) at all. (Because only certain parts of a multi-part problem may be assigned, this can not be collapsed into "open later", as we don't know a given part will EVER be opened. For single part, this is the same as "OPEN_LATER".)
1.53      bowersj2 2510: 
1.70      bowersj2 2511: =item * B<CORRECT>: For any reason at all, the part is considered correct.
1.51      bowersj2 2512: 
1.70      bowersj2 2513: =item * B<EXCUSED>: For any reason at all, the problem is excused.
1.51      bowersj2 2514: 
1.70      bowersj2 2515: =item * B<PAST_DUE_NO_ANSWER>: The problem is past due, not considered correct, and no answer date is set.
1.54      bowersj2 2516: 
1.70      bowersj2 2517: =item * B<PAST_DUE_ANSWER_LATER>: The problem is past due, not considered correct, and an answer date in the future is set.
1.51      bowersj2 2518: 
1.70      bowersj2 2519: =item * B<ANSWER_OPEN>: The problem is past due, not correct, and the answer is now available.
1.51      bowersj2 2520: 
1.70      bowersj2 2521: =item * B<OPEN_LATER>: The problem is not yet open.
1.51      bowersj2 2522: 
1.70      bowersj2 2523: =item * B<TRIES_LEFT>: The problem is open, has been tried, is not correct, but there are tries left.
1.51      bowersj2 2524: 
1.70      bowersj2 2525: =item * B<INCORRECT>: The problem is open, and all tries have been used without getting the correct answer.
1.51      bowersj2 2526: 
1.70      bowersj2 2527: =item * B<OPEN>: The item is open and not yet tried.
1.51      bowersj2 2528: 
1.70      bowersj2 2529: =item * B<ATTEMPTED>: The problem has been attempted.
1.69      bowersj2 2530: 
1.51      bowersj2 2531: =back
                   2532: 
                   2533: =cut
                   2534: 
                   2535: sub TRIES_LEFT { return 10; }
                   2536: 
                   2537: sub status {
                   2538:     my $self = shift;
                   2539:     my $part = shift;
                   2540:     if (!defined($part)) { $part = "0"; }
                   2541:     my $completionStatus = $self->getCompletionStatus($part);
                   2542:     my $dateStatus = $self->getDateStatus($part);
                   2543: 
                   2544:     # What we have is a two-dimensional matrix with 4 entries on one
                   2545:     # dimension and 5 entries on the other, which we want to colorize,
1.54      bowersj2 2546:     # plus network failure and "no date data at all".
1.51      bowersj2 2547: 
1.53      bowersj2 2548:     if ($completionStatus == NETWORK_FAILURE) { return NETWORK_FAILURE; }
1.51      bowersj2 2549: 
                   2550:     # There are a few whole rows we can dispose of:
1.53      bowersj2 2551:     if ($completionStatus == CORRECT ||
                   2552:         $completionStatus == CORRECT_BY_OVERRIDE ) {
1.69      bowersj2 2553:         return CORRECT; 
                   2554:     }
                   2555: 
                   2556:     if ($completionStatus == ATTEMPTED) {
                   2557:         return ATTEMPTED;
1.53      bowersj2 2558:     }
                   2559: 
                   2560:     # If it's EXCUSED, then return that no matter what
                   2561:     if ($completionStatus == EXCUSED) {
                   2562:         return EXCUSED; 
1.51      bowersj2 2563:     }
                   2564: 
1.53      bowersj2 2565:     if ($dateStatus == NOTHING_SET) {
                   2566:         return NOTHING_SET;
1.51      bowersj2 2567:     }
                   2568: 
1.69      bowersj2 2569:     # Now we're down to a 4 (incorrect, incorrect_override, not_attempted)
                   2570:     # by 4 matrix (date statuses).
1.51      bowersj2 2571: 
1.54      bowersj2 2572:     if ($dateStatus == PAST_DUE_ANSWER_LATER ||
1.59      bowersj2 2573:         $dateStatus == PAST_DUE_NO_ANSWER ) {
1.54      bowersj2 2574:         return $dateStatus; 
1.51      bowersj2 2575:     }
                   2576: 
1.53      bowersj2 2577:     if ($dateStatus == ANSWER_OPEN) {
                   2578:         return ANSWER_OPEN;
1.51      bowersj2 2579:     }
                   2580: 
                   2581:     # Now: (incorrect, incorrect_override, not_attempted) x 
                   2582:     # (open_later), (open)
                   2583:     
1.53      bowersj2 2584:     if ($dateStatus == OPEN_LATER) {
                   2585:         return OPEN_LATER;
1.51      bowersj2 2586:     }
                   2587: 
                   2588:     # If it's WRONG...
1.53      bowersj2 2589:     if ($completionStatus == INCORRECT || $completionStatus == INCORRECT_BY_OVERRIDE) {
1.51      bowersj2 2590:         # and there are TRIES LEFT:
1.79      bowersj2 2591:         if ($self->tries($part) < $self->maxtries($part) || !$self->maxtries($part)) {
1.53      bowersj2 2592:             return TRIES_LEFT;
1.51      bowersj2 2593:         }
1.53      bowersj2 2594:         return INCORRECT; # otherwise, return orange; student can't fix this
1.51      bowersj2 2595:     }
                   2596: 
                   2597:     # Otherwise, it's untried and open
1.53      bowersj2 2598:     return OPEN; 
1.51      bowersj2 2599: }
                   2600: 
                   2601: =pod
                   2602: 
                   2603: =head2 Resource/Nav Map Navigation
                   2604: 
                   2605: =over 4
                   2606: 
1.101     bowersj2 2607: =item * B<getNext>(): Retreive an array of the possible next resources after this one. Always returns an array, even in the one- or zero-element case. 
1.85      bowersj2 2608: 
1.101     bowersj2 2609: =item * B<getPrevious>(): Retreive an array of the possible previous resources from this one. Always returns an array, even in the one- or zero-element case. 
1.51      bowersj2 2610: 
                   2611: =cut
                   2612: 
                   2613: sub getNext {
                   2614:     my $self = shift;
                   2615:     my @branches;
                   2616:     my $to = $self->to();
1.85      bowersj2 2617:     foreach my $branch ( split(/,/, $to) ) {
1.51      bowersj2 2618:         my $choice = $self->{NAV_MAP}->getById($branch);
                   2619:         my $next = $choice->goesto();
                   2620:         $next = $self->{NAV_MAP}->getById($next);
                   2621: 
1.129.2.1  albertel 2622:         push @branches, $next;
1.85      bowersj2 2623:     }
                   2624:     return \@branches;
                   2625: }
                   2626: 
                   2627: sub getPrevious {
                   2628:     my $self = shift;
                   2629:     my @branches;
                   2630:     my $from = $self->from();
                   2631:     foreach my $branch ( split /,/, $from) {
                   2632:         my $choice = $self->{NAV_MAP}->getById($branch);
                   2633:         my $prev = $choice->comesfrom();
                   2634:         $prev = $self->{NAV_MAP}->getById($prev);
                   2635: 
1.129.2.1  albertel 2636:         push @branches, $prev;
1.51      bowersj2 2637:     }
                   2638:     return \@branches;
1.129.2.1  albertel 2639: }
                   2640: 
                   2641: sub browsePriv {
                   2642:     my $self = shift;
                   2643:     if (defined($self->{BROWSE_PRIV})) {
                   2644:         return $self->{BROWSE_PRIV};
                   2645:     }
                   2646: 
                   2647:     $self->{BROWSE_PRIV} = &Apache::lonnet::allowed('bre', $self->src());
1.51      bowersj2 2648: }
                   2649: 
                   2650: =pod
1.2       www      2651: 
1.51      bowersj2 2652: =back
1.2       www      2653: 
1.51      bowersj2 2654: =cut
1.2       www      2655: 
1.51      bowersj2 2656: 1;
1.2       www      2657: 
1.51      bowersj2 2658: __END__
1.2       www      2659: 
                   2660: 

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>