:
+
+Useful for renderers: If this resource is currently the first resource
+of a new branch, this will be true. The Resource column (leftmost in the
+navmaps screen) uses this to display the "new branch" icon
+
+=back
+
+=cut
+
+sub resource { return 0; }
+sub communication_status { return 1; }
+sub quick_status { return 2; }
+sub long_status { return 3; }
+sub part_status_summary { return 4; }
+
+sub render_resource {
+ my ($resource, $part, $params) = @_;
+
+ my $nonLinkedText = ''; # stuff after resource title not in link
+
+ my $link = $params->{"resourceLink"};
+
+ # The URL part is not escaped at this point, but the symb is...
+ # The stuff to the left of the ? must have ' replaced by \' since
+ # it will be quoted with ' in the href.
+
+ my ($left,$right) = split(/\?/, $link);
+ $link = $left.'?'.$right;
+
+ my $src = $resource->src();
+ my $it = $params->{"iterator"};
+ my $filter = $it->{FILTER};
+
+ my $title = $resource->compTitle();
+
+ my $partLabel = "";
+ my $newBranchText = "";
+ my $location=&Apache::loncommon::lonhttpdurl("/adm/lonIcons");
+ # If this is a new branch, label it so
+ if ($params->{'isNewBranch'}) {
+ $newBranchText = "";
+
+
+ my $linkclose = " ";
+
+ # Default icon: unknown page
+ my $icon = "{'url'} . '?' .
+ $params->{'queryString'} . '&filter=';
+ $linkopen .= ($nowOpen xor $it->{CONDITION}) ?
+ addToFilter($filter, $mapId) :
+ removeFromFilter($filter, $mapId);
+ $linkopen .= "&condition=" . $it->{CONDITION} . '&hereType='
+ . $params->{'hereType'} . '&here=' .
+ &escape($params->{'here'}) .
+ '&jump=' .
+ &escape($resource->symb()) .
+ "&folderManip=1\">";
+
+ } else {
+ # Don't allow users to manipulate folder
+ $icon = "navmap.$folderType." . ($nowOpen ? 'closed' : 'open') .
+ '.nomanip.gif';
+ $icon = "('.&mt('hidden').') ';
+ }
+ if (!$resource->condval()) {
+ $nonLinkedText .= ' ('.&mt('conditionally hidden').') ';
+ }
+
+ # We're done preparing and finally ready to start the rendering
+ my $result = " ";
+
+ my $indentLevel = $params->{'indentLevel'};
+ if ($newBranchText) { $indentLevel--; }
+
+ # print indentation
+ for (my $i = 0; $i < $indentLevel; $i++) {
+ $result .= $params->{'indentString'};
+ }
+
+ # Decide what to display
+
+ $result .= "$newBranchText$linkopen$icon$linkclose";
+
+ my $curMarkerBegin = '';
+ my $curMarkerEnd = '';
+
+ # Is this the current resource?
+ if (!$params->{'displayedHereMarker'} &&
+ $resource->symb() eq $params->{'here'} ) {
+ $curMarkerBegin = '> ';
+ $curMarkerEnd = '< ';
+ $params->{'displayedHereMarker'} = 1;
+ }
+
+ if ($resource->is_problem() && $part ne '0' &&
+ !$params->{'condensed'}) {
+ my $displaypart=$resource->part_display($part);
+ $partLabel = " (".&mt('Part: [_1]', $displaypart).")";
+ if ($link!~/\#/) { $link.='#'.&escape($part); }
+ $title = "";
+ }
+
+ if ($params->{'condensed'} && $resource->countParts() > 1) {
+ $nonLinkedText .= ' ('.&mt('[_1] parts', $resource->countParts()).')';
+ }
+
+ my $target;
+ if ($env{'environment.remotenavmap'} eq 'on') {
+ $target=' target="loncapaclient" ';
+ }
+ if (!$params->{'resource_nolink'} && !$resource->is_sequence() && !$resource->is_empty_sequence) {
+ $result .= " $curMarkerBegin$title$partLabel $curMarkerEnd $nonLinkedText ";
+ } else {
+ $result .= " $curMarkerBegin$title$partLabel$curMarkerEnd $nonLinkedText";
+ }
+
+ return $result;
+}
+
+sub render_communication_status {
+ my ($resource, $part, $params) = @_;
+ my $discussionHTML = ""; my $feedbackHTML = ""; my $errorHTML = "";
+
+ my $link = $params->{"resourceLink"};
+ my $target;
+ if ($env{'environment.remotenavmap'} eq 'on') {
+ $target=' target="loncapaclient" ';
+ }
+ my $linkopen = "";
+ my $linkclose = " ";
+ my $location=&Apache::loncommon::lonhttpdurl("/adm/lonMisc");
+ if ($resource->hasDiscussion()) {
+ $discussionHTML = $linkopen .
+ ''
+ . ' ';
+ }
+ }
+ }
+
+ if ($resource->getErrors()) {
+ my $errors = $resource->getErrors();
+ my $errorcount = 0;
+ foreach (split(/,/, $errors)) {
+ last if ($errorcount>=10); # Only output 10 bombs maximum
+ if ($_) {
+ $errorcount++;
+ $errorHTML .= ' '
+ . ' ';
+ }
+ }
+ }
+
+ if ($params->{'multipart'} && $part != '0') {
+ $discussionHTML = $feedbackHTML = $errorHTML = '';
+ }
+
+ return "$discussionHTML$feedbackHTML$errorHTML ";
+
+}
+sub render_quick_status {
+ my ($resource, $part, $params) = @_;
+ my $result = "";
+ my $firstDisplayed = !$params->{'condensed'} &&
+ $params->{'multipart'} && $part eq "0";
+
+ my $link = $params->{"resourceLink"};
+ my $target;
+ if ($env{'environment.remotenavmap'} eq 'on') {
+ $target=' target="loncapaclient" ';
+ }
+ my $linkopen = "";
+ my $linkclose = " ";
+
+ if ($resource->is_problem() &&
+ !$firstDisplayed) {
+
+ my $icon = $statusIconMap{$resource->simpleStatus($part)};
+ my $alt = $iconAltTags{$icon};
+ if ($icon) {
+ my $location=
+ &Apache::loncommon::lonhttpdurl("/adm/lonIcons/$icon");
+ $result .= "$linkopen \n";
+ } else {
+ $result .= " \n";
+ }
+ } else { # not problem, no icon
+ $result .= " \n";
+ }
+
+ return $result;
+}
+sub render_long_status {
+ my ($resource, $part, $params) = @_;
+ my $result = "\n";
+ my $firstDisplayed = !$params->{'condensed'} &&
+ $params->{'multipart'} && $part eq "0";
+
+ my $color;
+ if ($resource->is_problem()) {
+ $color = $colormap{$resource->status};
+
+ if (dueInLessThan24Hours($resource, $part) ||
+ lastTry($resource, $part)) {
+ $color = $hurryUpColor;
+ }
+ }
+
+ if ($resource->kind() eq "res" &&
+ $resource->is_problem() &&
+ !$firstDisplayed) {
+ if ($color) {$result .= ""; }
+ $result .= getDescription($resource, $part);
+ if ($color) {$result .= " \n";
+
+ return $result;
+}
+
+# Colors obtained by taking the icons, matching the colors, and
+# possibly reducing the Value (HSV) of the color, if it's too bright
+# for text, generally by one third or so.
+my %statusColors =
+ (
+ $resObj->CLOSED => '#000000',
+ $resObj->OPEN => '#998b13',
+ $resObj->CORRECT => '#26933f',
+ $resObj->INCORRECT => '#c48207',
+ $resObj->ATTEMPTED => '#a87510',
+ $resObj->ERROR => '#000000'
+ );
+my %statusStrings =
+ (
+ $resObj->CLOSED => 'Not yet open',
+ $resObj->OPEN => 'Open',
+ $resObj->CORRECT => 'Correct',
+ $resObj->INCORRECT => 'Incorrect',
+ $resObj->ATTEMPTED => 'Attempted',
+ $resObj->ERROR => 'Network Error'
+ );
+my @statuses = ($resObj->CORRECT, $resObj->ATTEMPTED, $resObj->INCORRECT, $resObj->OPEN, $resObj->CLOSED, $resObj->ERROR);
+
+use Data::Dumper;
+sub render_parts_summary_status {
+ my ($resource, $part, $params) = @_;
+ if (!$resource->is_problem() && !$resource->contains_problem) { return '\n";
+ my $endtd = " \n";
+ my @probs;
+
+ if ($resource->contains_problem) {
+ @probs=$resource->retrieveResources($resource,sub { $_[0]->is_problem() },1,0);
+ } else {
+ @probs=($resource);
+ }
+ my $return;
+ my %overallstatus;
+ my $totalParts;
+ foreach my $resource (@probs) {
+ # If there is a single part, just show the simple status
+ if ($resource->singlepart()) {
+ my $status = $resource->simpleStatus(${$resource->parts}[0]);
+ $overallstatus{$status}++;
+ $totalParts++;
+ next;
+ }
+ # Now we can be sure the $part doesn't really matter.
+ my $statusCount = $resource->simpleStatusCount();
+ my @counts;
+ foreach my $status (@statuses) {
+ # decouple display order from the simpleStatusCount order
+ my $slot = Apache::lonnavmaps::resource::statusToSlot($status);
+ if ($statusCount->[$slot]) {
+ $overallstatus{$status}+=$statusCount->[$slot];
+ $totalParts+=$statusCount->[$slot];
+ }
+ }
+ }
+ $return.= $td . $totalParts . ' parts: ';
+ foreach my $status (@statuses) {
+ if ($overallstatus{$status}) {
+ $return.="" . $overallstatus{$status} . ' '
+ . $statusStrings{$status} . " ";
+ }
+ }
+ $return.= $endtd;
+ return $return;
+}
+
+my @preparedColumns = (\&render_resource, \&render_communication_status,
+ \&render_quick_status, \&render_long_status,
+ \&render_parts_summary_status);
+
+sub setDefault {
+ my ($val, $default) = @_;
+ if (!defined($val)) { return $default; }
+ return $val;
+}
+
+sub cmp_title {
+ my ($atitle,$btitle) = (lc($_[0]->compTitle),lc($_[1]->compTitle));
+ $atitle=~s/^\s*//;
+ $btitle=~s/^\s*//;
+ return $atitle cmp $btitle;
+}
+
+sub render {
+ my $args = shift;
+ &Apache::loncommon::get_unprocessed_cgi($ENV{QUERY_STRING});
+ my $result = '';
+ # Configure the renderer.
+ my $cols = $args->{'cols'};
+ if (!defined($cols)) {
+ # no columns, no nav maps.
+ return '';
+ }
+ my $navmap;
+ if (defined($args->{'navmap'})) {
+ $navmap = $args->{'navmap'};
+ }
+
+ my $r = $args->{'r'};
+ my $queryString = $args->{'queryString'};
+ my $jump = $args->{'jump'};
+ my $here = $args->{'here'};
+ my $suppressNavmap = setDefault($args->{'suppressNavmap'}, 0);
+ my $closeAllPages = setDefault($args->{'closeAllPages'}, 0);
+ my $currentJumpDelta = 2; # change this to change how many resources are displayed
+ # before the current resource when using #current
+
+ # If we were passed 'here' information, we are not rendering
+ # after a folder manipulation, and we were not passed an
+ # iterator, make sure we open the folders to show the "here"
+ # marker
+ my $filterHash = {};
+ # Figure out what we're not displaying
+ foreach (split(/\,/, $env{"form.filter"})) {
+ if ($_) {
+ $filterHash->{$_} = "1";
+ }
+ }
+
+ # Filter: Remember filter function and add our own filter: Refuse
+ # to show hidden resources unless the user can see them.
+ my $userCanSeeHidden = advancedUser();
+ my $filterFunc = setDefault($args->{'filterFunc'},
+ sub {return 1;});
+ if (!$userCanSeeHidden) {
+ # Without renaming the filterfunc, the server seems to go into
+ # an infinite loop
+ my $oldFilterFunc = $filterFunc;
+ $filterFunc = sub { my $res = shift; return !$res->randomout() &&
+ &$oldFilterFunc($res);};
+ }
+
+ my $condition = 0;
+ if ($env{'form.condition'}) {
+ $condition = 1;
+ }
+
+ if (!$env{'form.folderManip'} && !defined($args->{'iterator'})) {
+ # Step 1: Check to see if we have a navmap
+ if (!defined($navmap)) {
+ $navmap = Apache::lonnavmaps::navmap->new();
+ if (!defined($navmap)) {
+ # no londer in course
+ return ''.&mt('No course selected').' '.&mt('Select a course').' '.&mt($text).' ';
+ }
+ $result .= "\n";
+ }
+
+ # Check for any unread discussions in all resources.
+ if ($args->{'caller'} eq 'navmapsdisplay') {
+ &add_linkitem($args->{'linkitems'},'clearbubbles',
+ 'document.clearbubbles.submit()',
+ 'Mark all posts read');
+ my $time=time;
+ $result .= (<
+ '.
+ &Apache::loncommon::help_open_menu('Navigation Screen','Navigation_Screen',undef,'RAT').' ';
+ if ($env{'environment.remotenavmap'} ne 'on') {
+ $result .= ' ';
+ } else {
+ $result .= '';
+ }
+ $result.=&show_linkitems($args->{'linkitems'});
+ if ($args->{'sort_html'}) {
+ if ($env{'environment.remotenavmap'} ne 'on') {
+ $result.=' '.
+ ''.$args->{'sort_html'}.' ';
+ } else {
+ $result.='
';
+ } elsif ($args->{'sort_html'}) {
+ $result.=$args->{'sort_html'};
+ }
+
+ $result .= "' ."\n";
+ my $res = "Apache::lonnavmaps::resource";
+ my %condenseStatuses =
+ ( $res->NETWORK_FAILURE => 1,
+ $res->NOTHING_SET => 1,
+ $res->CORRECT => 1 );
+ my @backgroundColors = ("#FFFFFF", "#F6F6F6");
+
+ # Shared variables
+ $args->{'counter'} = 0; # counts the rows
+ $args->{'indentLevel'} = 0;
+ $args->{'isNewBranch'} = 0;
+ $args->{'condensed'} = 0;
+ my $location=
+ &Apache::loncommon::lonhttpdurl("/adm/lonIcons/whitespace1.gif");
+ $args->{'indentString'} = setDefault($args->{'indentString'}, "\n";
+
+ # Set up some data about the parts that the cols might want
+ my $filter = $it->{FILTER};
+
+ # Now, display each column.
+ foreach my $col (@$cols) {
+ my $colHTML = '';
+ if (ref($col)) {
+ $colHTML .= &$col($curRes, $part, $args);
+ } else {
+ $colHTML .= &{$preparedColumns[$col]}($curRes, $part, $args);
+ }
+
+ # If this is the first column and it's time to print
+ # the anchor, do so
+ if ($col == $cols->[0] &&
+ $args->{'counter'} == $args->{'currentJumpIndex'} -
+ $currentJumpDelta) {
+ # Jam the anchor after the tag;
+ # necessary for valid HTML (which Mozilla requires)
+ $colHTML =~ s/\>/\>\/;
+ $displayedJumpMarker = 1;
+ }
+ $result .= $colHTML . "\n";
+ }
+ $result .= " \n";
+ $args->{'isNewBranch'} = 0;
+ }
+
+ if ($r && $rownum % 20 == 0) {
+ $r->print($result);
+ $result = "";
+ $r->rflush();
+ }
+ } continue {
+ if ($r) {
+ # If we have the connection, make sure the user is still connected
+ my $c = $r->connection;
+ if ($c->aborted()) {
+ # Who cares what we do, nobody will see it anyhow.
+ return '';
+ }
+ }
+ }
+
+ # Print out the part that jumps to #curloc if it exists
+ # delay needed because the browser is processing the jump before
+ # it finishes rendering, so it goes to the wrong place!
+ # onload might be better, but this routine has no access to that.
+ # On mozilla, the 0-millisecond timeout seems to prevent this;
+ # it's quite likely this might fix other browsers, too, and
+ # certainly won't hurt anything.
+ if ($displayedJumpMarker) {
+ $result .= "
+";
+ }
+
+ $result .= "
";
+
+ if ($r) {
+ $r->print($result);
+ $result = "";
+ $r->rflush();
+ }
+
+ return $result;
+}
+
+sub add_linkitem {
+ my ($linkitems,$name,$cmd,$text)=@_;
+ $$linkitems{$name}{'cmd'}=$cmd;
+ $$linkitems{$name}{'text'}=&mt($text);
+}
+
+sub show_linkitems {
+ my ($linkitems)=@_;
+ my @linkorder = ("blank","launchnav","closenav","firsthomework",
+ "everything","uncompleted","changefolder","clearbubbles");
+
+ my $result .= (<
+
+ '."\n";
+
+ return $result;
+}
+
+1;
+
+package Apache::lonnavmaps::navmap;
+
+=pod
+
+=head1 Object: Apache::lonnavmaps::navmap
+
+=head2 Overview
+
+The navmap object's job is to provide access to the resources
+in the course as Apache::lonnavmaps::resource objects, and to
+query and manage the relationship between those resource objects.
+
+Generally, you'll use the navmap object in one of three basic ways.
+In order of increasing complexity and power:
+
+=over 4
+
+=item * C<$navmap-EgetByX>, where X is B, B or B and getResourceByUrl. This provides
+ various ways to obtain resource objects, based on various identifiers.
+ Use this when you want to request information about one object or
+ a handful of resources you already know the identities of, from some
+ other source. For more about Ids, Symbs, and MapPcs, see the
+ Resource documentation. Note that Url should be a B,
+ not your first choice; it only really works when there is only one
+ instance of the resource in the course, which only applies to
+ maps, and even that may change in the future (see the B
+ documentation for more details.)
+
+=item * CretrieveResources(args)>. This
+ retrieves resources matching some criterion and returns them
+ in a flat array, with no structure information. Use this when
+ you are manipulating a series of resources, based on what map
+ the are in, but do not care about branching, or exactly how
+ the maps and resources are related. This is the most common case.
+
+=item * C<$it = $navmap-EgetIterator(args)>. This allows you traverse
+ the course's navmap in various ways without writing the traversal
+ code yourself. See iterator documentation below. Use this when
+ you need to know absolutely everything about the course, including
+ branches and the precise relationship between maps and resources.
+
+=back
+
+=head2 Creation And Destruction
+
+To create a navmap object, use the following function:
+
+=over 4
+
+=item * Bnew>():
+
+Creates a new navmap object. Returns the navmap object if this is
+successful, or B if not.
+
+=back
+
+=head2 Methods
+
+=over 4
+
+=item * B(first, finish, filter, condition):
+
+See iterator documentation below.
+
+=cut
+
+use strict;
use GDBM_File;
+use Apache::lonnet;
-# -------------------------------------------------------------- Module Globals
-my %hash;
-my @rows;
+sub new {
+ # magic invocation to create a class instance
+ my $proto = shift;
+ my $class = ref($proto) || $proto;
+ my $self = {};
+
+ # Resource cache stores navmap resources as we reference them. We generate
+ # them on-demand so we don't pay for creating resources unless we use them.
+ $self->{RESOURCE_CACHE} = {};
+
+ # Network failure flag, if we accessed the course or user opt and
+ # failed
+ $self->{NETWORK_FAILURE} = 0;
+
+ # tie the nav hash
+
+ my %navmaphash;
+ my %parmhash;
+ my $courseFn = $env{"request.course.fn"};
+ if (!(tie(%navmaphash, 'GDBM_File', "${courseFn}.db",
+ &GDBM_READER(), 0640))) {
+ return undef;
+ }
+
+ if (!(tie(%parmhash, 'GDBM_File', "${courseFn}_parms.db",
+ &GDBM_READER(), 0640)))
+ {
+ untie %{$self->{PARM_HASH}};
+ return undef;
+ }
-#
-# These cache hashes need to be independent of user, resource and course
-# (user and course can/should be in the keys)
-#
+ $self->{NAV_HASH} = \%navmaphash;
+ $self->{PARM_HASH} = \%parmhash;
+ $self->{PARM_CACHE} = {};
+
+ bless($self);
+
+ return $self;
+}
-my %courserdatas;
-my %userrdatas;
+sub generate_course_user_opt {
+ my $self = shift;
+ if ($self->{COURSE_USER_OPT_GENERATED}) { return; }
+
+ my $uname=$env{'user.name'};
+ my $udom=$env{'user.domain'};
+ my $cid=$env{'request.course.id'};
+ my $cdom=$env{'course.'.$cid.'.domain'};
+ my $cnum=$env{'course.'.$cid.'.num'};
+
+# ------------------------------------------------- Get coursedata (if present)
+ my $courseopt=&Apache::lonnet::get_courseresdata($cnum,$cdom);
+ # Check for network failure
+ if (!ref($courseopt)) {
+ if ( $courseopt =~ /no.such.host/i || $courseopt =~ /con_lost/i) {
+ $self->{NETWORK_FAILURE} = 1;
+ }
+ undef($courseopt);
+ }
-#
-# These global hashes are dependent on user, course and resource,
-# and need to be initialized every time when a sheet is calculated
-#
-my %courseopt;
-my %useropt;
-my %parmhash;
+# --------------------------------------------------- Get userdata (if present)
+
+ my $useropt=&Apache::lonnet::get_userresdata($uname,$udom);
+ # Check for network failure
+ if (!ref($useropt)) {
+ if ( $useropt =~ /no.such.host/i || $useropt =~ /con_lost/i) {
+ $self->{NETWORK_FAILURE} = 1;
+ }
+ undef($useropt);
+ }
-# ------------------------------------------------------------------ Euclid gcd
+ $self->{COURSE_OPT} = $courseopt;
+ $self->{USER_OPT} = $useropt;
-sub euclid {
- my ($e,$f)=@_;
- my $a; my $b; my $r;
- if ($e>$f) { $b=$e; $r=$f; } else { $r=$e; $b=$f; }
- while ($r!=0) {
- $a=$b; $b=$r;
- $r=$a%$b;
+ $self->{COURSE_USER_OPT_GENERATED} = 1;
+
+ return;
+}
+
+sub generate_email_discuss_status {
+ my $self = shift;
+ my $symb = shift;
+ if ($self->{EMAIL_DISCUSS_GENERATED}) { return; }
+
+ my $cid=$env{'request.course.id'};
+ my $cdom=$env{'course.'.$cid.'.domain'};
+ my $cnum=$env{'course.'.$cid.'.num'};
+
+ my %emailstatus = &Apache::lonnet::dump('email_status');
+ my $logoutTime = $emailstatus{'logout'};
+ my $courseLeaveTime = $emailstatus{'logout_'.$env{'request.course.id'}};
+ $self->{LAST_CHECK} = (($courseLeaveTime > $logoutTime) ?
+ $courseLeaveTime : $logoutTime);
+ my %discussiontime = &Apache::lonnet::dump('discussiontimes',
+ $cdom, $cnum);
+ my %lastread = &Apache::lonnet::dump('nohist_'.$cid.'_discuss',
+ $env{'user.domain'},$env{'user.name'},'lastread');
+ my %lastreadtime = ();
+ foreach (keys %lastread) {
+ my $key = $_;
+ $key =~ s/_lastread$//;
+ $lastreadtime{$key} = $lastread{$_};
}
- return $b;
+
+ my %feedback=();
+ my %error=();
+ my @keys = &Apache::lonnet::getkeys('nohist_email',$env{'user.domain'},
+ $env{'user.name'});
+
+ foreach my $msgid (@keys) {
+ if ((!$emailstatus{$msgid}) || ($emailstatus{$msgid} eq 'new')) {
+ my $plain=
+ &LONCAPA::unescape(&LONCAPA::unescape($msgid));
+ if ($plain=~/ \[([^\]]+)\]\:/) {
+ my $url=$1;
+ if ($plain=~/\:Error \[/) {
+ $error{$url}.=','.$msgid;
+ } else {
+ $feedback{$url}.=','.$msgid;
+ }
+ }
+ }
+ }
+
+ #url's of resources that have feedbacks
+ $self->{FEEDBACK} = \%feedback;
+ #or errors
+ $self->{ERROR_MSG} = \%error;
+ $self->{DISCUSSION_TIME} = \%discussiontime;
+ $self->{EMAIL_STATUS} = \%emailstatus;
+ $self->{LAST_READ} = \%lastreadtime;
+
+ $self->{EMAIL_DISCUSS_GENERATED} = 1;
}
-# --------------------------------------------------------------------- Parmval
+sub get_user_data {
+ my $self = shift;
+ if ($self->{RETRIEVED_USER_DATA}) { return; }
+
+ # Retrieve performance data on problems
+ my %student_data = Apache::lonnet::currentdump($env{'request.course.id'},
+ $env{'user.domain'},
+ $env{'user.name'});
+ $self->{STUDENT_DATA} = \%student_data;
-# -------------------------------------------- Figure out a cascading parameter
-#
-# For this function to work
-#
-# * parmhash needs to be tied
-# * courseopt and useropt need to be initialized for this user and course
-#
+ $self->{RETRIEVED_USER_DATA} = 1;
+}
+
+sub get_discussion_data {
+ my $self = shift;
+ if ($self->{RETRIEVED_DISCUSSION_DATA}) {
+ return $self->{DISCUSSION_DATA};
+ }
+
+ $self->generate_email_discuss_status();
+
+ my $cid=$env{'request.course.id'};
+ my $cdom=$env{'course.'.$cid.'.domain'};
+ my $cnum=$env{'course.'.$cid.'.num'};
+ # Retrieve discussion data for resources in course
+ my %discussion_data = &Apache::lonnet::dumpstore($cid,$cdom,$cnum);
+
+
+ $self->{DISCUSSION_DATA} = \%discussion_data;
+ $self->{RETRIEVED_DISCUSSION_DATA} = 1;
+ return $self->{DISCUSSION_DATA};
+}
+
+
+# Internal function: Takes a key to look up in the nav hash and implements internal
+# memory caching of that key.
+sub navhash {
+ my $self = shift; my $key = shift;
+ return $self->{NAV_HASH}->{$key};
+}
+
+=pod
+
+=item * B(): Returns true if the course map is defined,
+ false otherwise. Undefined course maps indicate an error somewhere in
+ LON-CAPA, and you will not be able to proceed with using the navmap.
+ See the B screen for an example of using this.
+
+=cut
+
+# Checks to see if coursemap is defined, matching test in old lonnavmaps
+sub courseMapDefined {
+ my $self = shift;
+ my $uri = &Apache::lonnet::clutter($env{'request.course.uri'});
+
+ my $firstres = $self->navhash("map_start_$uri");
+ my $lastres = $self->navhash("map_finish_$uri");
+ return $firstres && $lastres;
+}
+
+sub getIterator {
+ my $self = shift;
+ my $iterator = Apache::lonnavmaps::iterator->new($self, shift, shift,
+ shift, undef, shift,
+ shift, shift);
+ return $iterator;
+}
+
+# Private method: Does the given resource (as a symb string) have
+# current discussion? Returns 0 if chat/mail data not extracted.
+sub hasDiscussion {
+ my $self = shift;
+ my $symb = shift;
+ $self->generate_email_discuss_status();
+
+ if (!defined($self->{DISCUSSION_TIME})) { return 0; }
+
+ #return defined($self->{DISCUSSION_TIME}->{$symb});
+
+ # backward compatibility (bulletin boards used to be 'wrapped')
+ my $ressymb = $self->wrap_symb($symb);
+ if ( defined ( $self->{LAST_READ}->{$ressymb} ) ) {
+ return $self->{DISCUSSION_TIME}->{$ressymb} > $self->{LAST_READ}->{$ressymb};
+ } else {
+# return $self->{DISCUSSION_TIME}->{$ressymb} > $self->{LAST_CHECK}; # v.1.1 behavior
+ return $self->{DISCUSSION_TIME}->{$ressymb} > 0; # in 1.2 will display speech bubble icons for all items with posts until marked as read (even if read in v 1.1).
+ }
+}
+
+sub last_post_time {
+ my $self = shift;
+ my $symb = shift;
+ my $ressymb = $self->wrap_symb($symb);
+ return $self->{DISCUSSION_TIME}->{$ressymb};
+}
+
+sub unread_discussion {
+ my $self = shift;
+ my $symb = shift;
+
+ $self->get_discussion_data();
+
+ my $ressymb = $self->wrap_symb($symb);
+ # keys used to store bulletinboard postings use 'unwrapped' symb.
+ my $discsymb = $self->unwrap_symb($ressymb);
+ my $version = $self->{DISCUSSION_DATA}{'version:'.$discsymb};
+ if (!$version) { return; }
+
+ my $prevread = $self->{LAST_READ}{$ressymb};
+
+ my $unreadcount = 0;
+ my $hiddenflag = 0;
+ my $deletedflag = 0;
+ my ($hidden,$deleted);
+
+ my %subjects;
+
+ for (my $id=$version; $id>0; $id--) {
+ my $vkeys=$self->{DISCUSSION_DATA}{$id.':keys:'.$discsymb};
+ my @keys=split(/:/,$vkeys);
+ if (grep(/^hidden$/ ,@keys)) {
+ if (!$hiddenflag) {
+ $hidden = $self->{DISCUSSION_DATA}{$id.':'.$discsymb.':hidden'};
+ $hiddenflag = 1;
+ }
+ } elsif (grep(/^deleted$/,@keys)) {
+ if (!$deletedflag) {
+ $deleted = $self->{DISCUSSION_DATA}{$id.':'.$discsymb.':deleted'};
+ $deletedflag = 1;
+ }
+ } else {
+ if (($hidden !~/\.$id\./) && ($deleted !~/\.$id\./)
+ && $prevread < $self->{DISCUSSION_DATA}{$id.':'.$discsymb.':timestamp'}) {
+ $unreadcount++;
+ $subjects{$unreadcount}=
+ $id.': '.$self->{DISCUSSION_DATA}{$id.':'.$discsymb.':subject'};
+ }
+ }
+ }
+ if (wantarray) {
+ return ($unreadcount,\%subjects);
+ }
+ return $unreadcount
+}
+
+sub wrap_symb {
+ my $self = shift;
+ my $symb = shift;
+ if ($symb =~ m-___(adm/[^/]+/[^/]+/)(\d+)(/bulletinboard)$-) {
+ unless ($symb =~ m|adm/wrapper/adm|) {
+ $symb = 'bulletin___'.$2.'___adm/wrapper/'.$1.$2.$3;
+ }
+ }
+ return $symb;
+}
+
+sub unwrap_symb {
+ my $self = shift;
+ my $ressymb = shift;
+ my $discsymb = $ressymb;
+ if ($ressymb =~ m-^(bulletin___\d+___)adm/wrapper/(adm/[^/]+/[^/]+/\d+/bulletinboard)$-) {
+ $discsymb = $1.$2;
+ }
+ return $discsymb;
+}
+
+# Private method: Does the given resource (as a symb string) have
+# current feedback? Returns the string in the feedback hash, which
+# will be false if it does not exist.
+
+sub getFeedback {
+ my $self = shift;
+ my $symb = shift;
+
+ $self->generate_email_discuss_status();
+
+ if (!defined($self->{FEEDBACK})) { return ""; }
+
+ return $self->{FEEDBACK}->{$symb};
+}
+
+# Private method: Get the errors for that resource (by source).
+sub getErrors {
+ my $self = shift;
+ my $src = shift;
+
+ $self->generate_email_discuss_status();
+
+ if (!defined($self->{ERROR_MSG})) { return ""; }
+ return $self->{ERROR_MSG}->{$src};
+}
+
+=pod
+
+=item * B(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.
+
+=item * B(symb):
+Based on the symb of the resource, get a resource object for that
+resource. This is one of the proper ways to get a resource object.
+
+=item * B(map_pc):
+
+Based on the map_pc of the resource, get a resource object for
+the given map. This is one of the proper ways to get a resource object.
+
+=cut
+
+# The strategy here is to cache the resource objects, and only construct them
+# as we use them. The real point is to prevent reading any more from the tied
+# hash then we have to, which should hopefully alleviate speed problems.
+
+sub getById {
+ my $self = shift;
+ my $id = shift;
+
+ if (defined ($self->{RESOURCE_CACHE}->{$id}))
+ {
+ return $self->{RESOURCE_CACHE}->{$id};
+ }
+
+ # resource handles inserting itself into cache.
+ # Not clear why the quotes are necessary, but as of this
+ # writing it doesn't work without them.
+ return "Apache::lonnavmaps::resource"->new($self, $id);
+}
+
+sub getBySymb {
+ my $self = shift;
+ my $symb = shift;
+
+ my ($mapUrl, $id, $filename) = &Apache::lonnet::decode_symb($symb);
+ my $map = $self->getResourceByUrl($mapUrl);
+ my $returnvalue = undef;
+ if (ref($map)) {
+ $returnvalue = $self->getById($map->map_pc() .'.'.$id);
+ }
+ return $returnvalue;
+}
+
+sub getByMapPc {
+ my $self = shift;
+ my $map_pc = shift;
+ my $map_id = $self->{NAV_HASH}->{'map_id_' . $map_pc};
+ $map_id = $self->{NAV_HASH}->{'ids_' . $map_id};
+ return $self->getById($map_id);
+}
+
+=pod
+
+=item * B():
+
+Returns a resource object reference corresponding to the first
+resource in the navmap.
+
+=cut
+
+sub firstResource {
+ my $self = shift;
+ my $firstResource = $self->navhash('map_start_' .
+ &Apache::lonnet::clutter($env{'request.course.uri'}));
+ return $self->getById($firstResource);
+}
+
+=pod
+
+=item * B():
+
+Returns a resource object reference corresponding to the last resource
+in the navmap.
+
+=cut
+
+sub finishResource {
+ my $self = shift;
+ my $firstResource = $self->navhash('map_finish_' .
+ &Apache::lonnet::clutter($env{'request.course.uri'}));
+ return $self->getById($firstResource);
+}
+
+# Parmval reads the parm hash and cascades the lookups. parmval_real does
+# the actual lookup; parmval caches the results.
sub parmval {
+ my $self = shift;
my ($what,$symb)=@_;
- my $cid=$ENV{'request.course.id'};
- my $csec=$ENV{'request.course.sec'};
- my $uname=$ENV{'user.name'};
- my $udom=$ENV{'user.domain'};
+ my $hashkey = $what."|||".$symb;
+
+ if (defined($self->{PARM_CACHE}->{$hashkey})) {
+ return $self->{PARM_CACHE}->{$hashkey};
+ }
+
+ my $result = $self->parmval_real($what, $symb);
+ $self->{PARM_CACHE}->{$hashkey} = $result;
+ return $result;
+}
+
+sub parmval_real {
+ my $self = shift;
+ my ($what,$symb,$recurse) = @_;
+
+ # Make sure the {USER_OPT} and {COURSE_OPT} hashes are populated
+ $self->generate_course_user_opt();
+
+ my $cid=$env{'request.course.id'};
+ my $csec=$env{'request.course.sec'};
+ my $cgroup='';
+ my @cgrps=split(/:/,$env{'request.course.groups'});
+ if (@cgrps > 0) {
+ @cgrps = sort(@cgrps);
+ $cgroup = $cgrps[0];
+ }
+ my $uname=$env{'user.name'};
+ my $udom=$env{'user.domain'};
unless ($symb) { return ''; }
my $result='';
- my ($mapname,$id,$fn)=split(/\_\_\_/,$symb);
-
+ my ($mapname,$id,$fn)=&Apache::lonnet::decode_symb($symb);
+ $mapname = &Apache::lonnet::deversion($mapname);
# ----------------------------------------------------- Cascading lookup scheme
my $rwhat=$what;
$what=~s/^parameter\_//;
@@ -109,7 +2593,11 @@ sub parmval {
my $symbparm=$symb.'.'.$what;
my $mapparm=$mapname.'___(all).'.$what;
- my $usercourseprefix=$uname.'_'.$udom.'_'.$cid;
+ my $usercourseprefix=$cid;
+
+ my $grplevel=$usercourseprefix.'.['.$cgroup.'].'.$what;
+ my $grplevelr=$usercourseprefix.'.['.$cgroup.'].'.$symbparm;
+ my $grplevelm=$usercourseprefix.'.['.$cgroup.'].'.$mapparm;
my $seclevel= $usercourseprefix.'.['.$csec.'].'.$what;
my $seclevelr=$usercourseprefix.'.['.$csec.'].'.$symbparm;
@@ -119,634 +2607,2446 @@ sub parmval {
my $courselevelr=$usercourseprefix.'.'.$symbparm;
my $courselevelm=$usercourseprefix.'.'.$mapparm;
+ my $useropt = $self->{USER_OPT};
+ my $courseopt = $self->{COURSE_OPT};
+ my $parmhash = $self->{PARM_HASH};
+
# ---------------------------------------------------------- first, check user
- if ($uname) {
- if ($useropt{$courselevelr}) { return $useropt{$courselevelr}; }
- if ($useropt{$courselevelm}) { return $useropt{$courselevelm}; }
- if ($useropt{$courselevel}) { return $useropt{$courselevel}; }
+ if ($uname and defined($useropt)) {
+ if (defined($$useropt{$courselevelr})) { return $$useropt{$courselevelr}; }
+ if (defined($$useropt{$courselevelm})) { return $$useropt{$courselevelm}; }
+ if (defined($$useropt{$courselevel})) { return $$useropt{$courselevel}; }
}
# ------------------------------------------------------- second, check course
- if ($csec) {
- if ($courseopt{$seclevelr}) { return $courseopt{$seclevelr}; }
- if ($courseopt{$seclevelm}) { return $courseopt{$seclevelm}; }
- if ($courseopt{$seclevel}) { return $courseopt{$seclevel}; }
+ if ($cgroup ne '' and defined($courseopt)) {
+ if (defined($$courseopt{$grplevelr})) { return $$courseopt{$grplevelr}; }
+ if (defined($$courseopt{$grplevelm})) { return $$courseopt{$grplevelm}; }
+ if (defined($$courseopt{$grplevel})) { return $$courseopt{$grplevel}; }
+ }
+
+ if ($csec and defined($courseopt)) {
+ if (defined($$courseopt{$seclevelr})) { return $$courseopt{$seclevelr}; }
+ if (defined($$courseopt{$seclevelm})) { return $$courseopt{$seclevelm}; }
+ if (defined($$courseopt{$seclevel})) { return $$courseopt{$seclevel}; }
}
- if ($courseopt{$courselevelr}) { return $courseopt{$courselevelr}; }
- if ($courseopt{$courselevelm}) { return $courseopt{$courselevelm}; }
- if ($courseopt{$courselevel}) { return $courseopt{$courselevel}; }
+ if (defined($courseopt)) {
+ if (defined($$courseopt{$courselevelr})) { return $$courseopt{$courselevelr}; }
+ }
# ----------------------------------------------------- third, check map parms
- my $thisparm=$parmhash{$symbparm};
- if ($thisparm) { return $thisparm; }
+ my $thisparm=$$parmhash{$symbparm};
+ if (defined($thisparm)) { return $thisparm; }
# ----------------------------------------------------- fourth , check default
- my $default=&Apache::lonnet::metadata($fn,$rwhat.'.default');
- if ($default) { return $default}
+ my $meta_rwhat=$rwhat;
+ $meta_rwhat=~s/\./_/g;
+ my $default=&Apache::lonnet::metadata($fn,$meta_rwhat);
+ if (defined($default)) { return $default}
+ $default=&Apache::lonnet::metadata($fn,'parameter_'.$meta_rwhat);
+ if (defined($default)) { return $default}
+
+# --------------------------------------------------- fifth, check more course
+ if (defined($courseopt)) {
+ if (defined($$courseopt{$courselevelm})) { return $$courseopt{$courselevelm}; }
+ if (defined($$courseopt{$courselevel})) { return $$courseopt{$courselevel}; }
+ }
-# --------------------------------------------------- fifth , cascade up parts
+# --------------------------------------------------- sixth , cascade up parts
my ($space,@qualifier)=split(/\./,$rwhat);
my $qualifier=join('.',@qualifier);
unless ($space eq '0') {
- my ($part,$id)=split(/\_/,$space);
- if ($id) {
- my $partgeneral=&parmval($part.".$qualifier",$symb);
- if ($partgeneral) { return $partgeneral; }
- } else {
- my $resourcegeneral=&parmval("0.$qualifier",$symb);
- if ($resourcegeneral) { return $resourcegeneral; }
- }
+ my @parts=split(/_/,$space);
+ my $id=pop(@parts);
+ my $part=join('_',@parts);
+ if ($part eq '') { $part='0'; }
+ my $partgeneral=$self->parmval($part.".$qualifier",$symb,1);
+ if (defined($partgeneral)) { return $partgeneral; }
}
+ if ($recurse) { return undef; }
+ my $pack_def=&Apache::lonnet::packages_tab_default($fn,'resource.'.$what);
+ if (defined($pack_def)) { return $pack_def; }
return '';
}
+=pod
+=item * B(url,multiple):
-# ------------------------------------------------------------- Find out status
-# return codes
-# tcode (timecode)
-# 1: will open later
-# 2: is open and not past due yet
-# 3: is past due date
-# 4: due in the next 24 hours
-#
-# code (curent solved status)
-# 1: not attempted
-# 2: attempted but wrong, or incorrect by instructor
-# 3: solved or correct by instructor
-# 4: partially correct (one or more parts correct)
-# "excused" needs to be supported, but is not yet.
-sub astatus {
- my $rid=shift;
- my $code=0;
- my $ctext='';
- $rid=~/(\d+)\.(\d+)/;
- my $symb=&Apache::lonnet::declutter($hash{'map_id_'.$1}).'___'.$2.'___'.
- &Apache::lonnet::declutter($hash{'src_'.$rid});
- my %duedate=();
- my %opendate=();
- my %answerdate=();
- # need to always check part 0's open/due/answer status
- foreach (sort(split(/\,/,&Apache::lonnet::metadata($hash{'src_'.$rid},'keys')))) {
- if ($_=~/^parameter\_(.*)\_opendate$/) {
- my $part=$1;
- $duedate{$part}=&parmval($part.'.duedate',$symb);
- $opendate{$part}=&parmval($part.'.opendate',$symb);
- $answerdate{$part}=&parmval($part.'.answerdate',$symb);
- }
- }
- my $now=time;
- my $tcode=0;
-
- my %returnhash=&Apache::lonnet::restore($symb);
-
- foreach (sort(keys(%opendate))) {
- my $duedate=$duedate{$_};
- my $opendate=$opendate{$_};
- my $answerdate=$answerdate{$_};
- my $preface='';
- unless ($_ eq '0') { $preface=' Part: '.$_.' '; }
- if ($opendate) {
- if ($now<$duedate || (!$duedate)) {
- unless ($tcode==4) { $tcode=2; }
- if ($duedate) {
- $ctext.=$preface.'Due: '.localtime($duedate);
- } else {
- $ctext.=$preface.'No Due Date';
- }
- if ($now<$opendate) {
- unless ($tcode) { $tcode=1; }
- $ctext.=$preface.'Open: '.localtime($opendate);
- }
- if ($duedate && $duedate-$now<86400) {
- $tcode=4;
- $ctext.=$preface.'Due: '.localtime($duedate);
- }
- } else {
- unless (($tcode==4) || ($tcode eq 2)) { $tcode=3; }
- if ($now<$answerdate) {
- $ctext.='Answer: '.localtime($duedate);
- }
- }
- } else {
- unless (($tcode==2) || ($tcode==4)) { $tcode=1; }
- }
-
- my $status=$returnhash{'resource.'.$_.'.solved'};
-
- if ($status eq 'correct_by_student') {
- if ($code==0||$code==3) { $code=3; } else { $code=4; }
- $ctext.=' solved';
- } elsif ($status eq 'correct_by_override') {
- if ($code==0||$code==3) { $code=3; } else { $code=4; }
- $ctext.=' override';
- } elsif ($status eq 'incorrect_attempted') {
- if ($code!=4 && $code!=3) { $code=2; }
- if ($code==3) { $code=4; }
- $ctext.=' ('.
- ($returnhash{'resource.'.$_.'.tries'}?
- $returnhash{'resource.'.$_.'.tries'}:'0');
- my $numtries = &parmval($_.'.maxtries',$symb);
- if ($numtries) { $ctext.='/'.$numtries.' tries'; }
- $ctext.=')';
- } elsif ($status eq 'incorrect_by_override') {
- if ($code!=4 && $code!=3) { $code=2; }
- if ($code==3) { $code=4; }
- $ctext.=' override';
- } elsif ($status eq 'excused') {
- if ($code==0||$code==3) { $code=3; } else { $code=4; }
- $ctext.=' excused';
- } else {
- if ($code==0) { $code=1; }
- }
+Retrieves a resource object by URL of the resource, unless the optional
+multiple parameter is included in wahich caes an array of resource
+objects is returned. If passed a resource object, it will simply return
+it, so it is safe to use this method in code like
+"$res = $navmap->getResourceByUrl($res)"
+if you're not sure if $res is already an object, or just a URL. If the
+resource appears multiple times in the course, only the first instance
+will be returned (useful for maps), unless the multiple parameter has
+been included, in which case all instances are returned in an array.
+
+=item * B(map, filterFunc, recursive, bailout, showall):
+
+The map is a specification of a map to retreive the resources from,
+either as a url or as an object. The filterFunc is a reference to a
+function that takes a resource object as its one argument and returns
+true if the resource should be included, or false if it should not
+be. If recursive is true, the map will be recursively examined,
+otherwise it will not be. If bailout is true, the function will return
+as soon as it finds a resource, if false it will finish. If showall is
+true it will not hide maps that contain nothing but one other map. By
+default, the map is the top-level map of the course, filterFunc is a
+function that always returns 1, recursive is true, bailout is false,
+showall is false. The resources will be returned in a list containing
+the resource objects for the corresponding resources, with B in the list; regardless of branching,
+recursion, etc., it will be a flat list.
+
+Thus, this is suitable for cases where you don't want the structure,
+just a list of all resources. It is also suitable for finding out how
+many resources match a given description; for this use, if all you
+want to know is if I resources match the description, the bailout
+parameter will allow you to avoid potentially expensive enumeration of
+all matching resources.
+
+=item * B(map, filterFunc, recursive, showall):
+
+Convience method for
+
+ scalar(retrieveResources($map, $filterFunc, $recursive, 1, $showall)) > 0
+
+which will tell whether the map has resources matching the description
+in the filter function.
+
+=item * B(url):
+
+Retrieves version infomation for a url. Returns the version (a number, or
+the string "mostrecent") for resources which have version information in
+the big hash.
+
+=cut
+
+
+sub getResourceByUrl {
+ my $self = shift;
+ my $resUrl = shift;
+ my $multiple = shift;
+
+ if (ref($resUrl)) { return $resUrl; }
+
+ $resUrl = &Apache::lonnet::clutter($resUrl);
+ my $resId = $self->{NAV_HASH}->{'ids_' . $resUrl};
+ if (!$resId) { return ''; }
+ if ($multiple) {
+ my @resources = ();
+ my @resIds = split (/,/, $resId);
+ foreach my $id (@resIds) {
+ my $resourceId = $self->getById($id);
+ if ($resourceId) {
+ push(@resources,$resourceId);
+ }
+ }
+ return @resources;
+ } else {
+ if ($resId =~ /,/) {
+ $resId = (split (/,/, $resId))[0];
+ }
+ return $self->getById($resId);
+ }
+}
+
+sub retrieveResources {
+ my $self = shift;
+ my $map = shift;
+ my $filterFunc = shift;
+ if (!defined ($filterFunc)) {
+ $filterFunc = sub {return 1;};
+ }
+ my $recursive = shift;
+ if (!defined($recursive)) { $recursive = 1; }
+ my $bailout = shift;
+ if (!defined($bailout)) { $bailout = 0; }
+ my $showall = shift;
+ # Create the necessary iterator.
+ if (!ref($map)) { # assume it's a url of a map.
+ $map = $self->getResourceByUrl($map);
+ }
+
+ # If nothing was passed, assume top-level map
+ if (!$map) {
+ $map = $self->getById('0.0');
+ }
+
+ # Check the map's validity.
+ if (!$map->is_map()) {
+ # Oh, to throw an exception.... how I'd love that!
+ return ();
}
- return 'p'.$code.$tcode.'"'.$ctext.'"';
+ # Get an iterator.
+ my $it = $self->getIterator($map->map_start(), $map->map_finish(),
+ undef, $recursive, $showall);
+
+ my @resources = ();
+
+ # Run down the iterator and collect the resources.
+ my $curRes;
+
+ while ($curRes = $it->next()) {
+ if (ref($curRes)) {
+ if (!&$filterFunc($curRes)) {
+ next;
+ }
+
+ push @resources, $curRes;
+
+ if ($bailout) {
+ return @resources;
+ }
+ }
+
+ }
+
+ return @resources;
}
+sub hasResource {
+ my $self = shift;
+ my $map = shift;
+ my $filterFunc = shift;
+ my $recursive = shift;
+ my $showall = shift;
+
+ return scalar($self->retrieveResources($map, $filterFunc, $recursive, 1, $showall)) > 0;
+}
-sub addresource {
- my ($resource,$sofar,$rid,$showtypes,$indent,$linkid)=@_;
- if ($showtypes eq 'problems') {
- if ($resource!~/\.(problem|exam|quiz|assess|survey|form)$/) {
- return;
- }
+sub usedVersion {
+ my $self = shift;
+ my $linkurl = shift;
+ return $self->navhash("version_$linkurl");
+}
+
+1;
+
+package Apache::lonnavmaps::iterator;
+use Scalar::Util qw(weaken);
+use Apache::lonnet;
+
+=pod
+
+=back
+
+=head1 Object: navmap Iterator
+
+An I 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.
+
+To obtain an iterator, call the B() function of a
+B object. (Do not instantiate Apache::lonnavmaps::iterator
+directly.) This will return a reference to the iterator:
+
+CgetIterator();>
+
+To get the next thing from the iterator, call B:
+
+Cnext()>
+
+getIterator behaves as follows:
+
+=over 4
+
+=item * B(firstResource, finishResource, filterHash, condition, forceTop, returnTopMap):
+
+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 resources 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. returnTopMap, if true (default false), will
+cause the iterator to return the top-level map object (resource 0.0)
+before anything else.
+
+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.
+
+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:
+
+=over 4
+
+=item * B:
+
+The iterator has returned all that it's going to. Further calls to the
+iterator will just produce more of these. This is a "false" value, and
+is the only false value the iterator which will be returned, so it can
+be used as a loop sentinel.
+
+=item * B:
+
+A new map is being recursed into. This is returned I the map
+resource itself is returned.
+
+=item * B:
+
+The map is now done.
+
+=item * B:
+
+A branch is now starting. The next resource returned will be the first
+in that branch.
+
+=item * B:
+
+The branch is now done.
+
+=back
+
+The tokens are retreivable via methods on the iterator object, i.e.,
+$iterator->END_MAP.
+
+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.
+
+=back
+
+=head2 Normal Usage
+
+Normal usage of the iterator object is to do the following:
+
+ my $it = $navmap->getIterator([your params here]);
+ my $curRes;
+ while ($curRes = $it->next()) {
+ [your logic here]
+ }
+
+Note that inside of the loop, it's frequently useful to check if
+"$curRes" is a reference or not with the reference function; only
+resource objects will be references, and any non-references will
+be the tokens described above.
+
+Also note there is some old code floating around that trys to track
+the depth of the iterator to see when it's done; do not copy that
+code. It is difficult to get right and harder to understand then
+this. They should be migrated to this new style.
+
+=cut
+
+# Here are the tokens for the iterator:
+
+sub END_ITERATOR { return 0; }
+sub BEGIN_MAP { return 1; } # begining of a new map
+sub END_MAP { return 2; } # end of the map
+sub BEGIN_BRANCH { return 3; } # beginning of a branch
+sub END_BRANCH { return 4; } # end of a branch
+sub FORWARD { return 1; } # go forward
+sub BACKWARD { return 2; }
+
+sub min {
+ (my $a, my $b) = @_;
+ if ($a < $b) { return $a; } else { return $b; }
+}
+
+sub new {
+ # magic invocation to create a class instance
+ my $proto = shift;
+ my $class = ref($proto) || $proto;
+ my $self = {};
+
+ weaken($self->{NAV_MAP} = shift);
+ return undef unless ($self->{NAV_MAP});
+
+ # Handle the parameters
+ $self->{FIRST_RESOURCE} = shift || $self->{NAV_MAP}->firstResource();
+ $self->{FINISH_RESOURCE} = shift || $self->{NAV_MAP}->finishResource();
+
+ # If the given resources are just the ID of the resource, get the
+ # objects
+ if (!ref($self->{FIRST_RESOURCE})) { $self->{FIRST_RESOURCE} =
+ $self->{NAV_MAP}->getById($self->{FIRST_RESOURCE}); }
+ if (!ref($self->{FINISH_RESOURCE})) { $self->{FINISH_RESOURCE} =
+ $self->{NAV_MAP}->getById($self->{FINISH_RESOURCE}); }
+
+ $self->{FILTER} = shift;
+
+ # A hash, used as a set, of resource already seen
+ $self->{ALREADY_SEEN} = shift;
+ if (!defined($self->{ALREADY_SEEN})) { $self->{ALREADY_SEEN} = {} };
+ $self->{CONDITION} = shift;
+
+ # Do we want to automatically follow "redirection" maps?
+ $self->{FORCE_TOP} = shift;
+
+ # Do we want to return the top-level map object (resource 0.0)?
+ $self->{RETURN_0} = shift;
+ # have we done that yet?
+ $self->{HAVE_RETURNED_0} = 0;
+
+ # Now, we need to pre-process the map, by walking forward and backward
+ # over the parts of the map we're going to look at.
+
+ # The processing steps are exactly the same, except for a few small
+ # changes, so I bundle those up in the following list of two elements:
+ # (direction_to_iterate, VAL_name, next_resource_method_to_call,
+ # first_resource).
+ # This prevents writing nearly-identical code twice.
+ my @iterations = ( [FORWARD(), 'TOP_DOWN_VAL', 'getNext',
+ 'FIRST_RESOURCE'],
+ [BACKWARD(), 'BOT_UP_VAL', 'getPrevious',
+ 'FINISH_RESOURCE'] );
+
+ my $maxDepth = 0; # tracks max depth
+
+ # If there is only one resource in this map, and it's a map, we
+ # want to remember that, so the user can ask for the first map
+ # that isn't just a redirector.
+ my $resource; my $resourceCount = 0;
+
+ # Documentation on this algorithm can be found in the CVS repository at
+ # /docs/lonnavdocs; these "**#**" markers correspond to documentation
+ # in that file.
+ # **1**
+
+ foreach my $pass (@iterations) {
+ my $direction = $pass->[0];
+ my $valName = $pass->[1];
+ my $nextResourceMethod = $pass->[2];
+ my $firstResourceName = $pass->[3];
+
+ my $iterator = Apache::lonnavmaps::DFSiterator->new($self->{NAV_MAP},
+ $self->{FIRST_RESOURCE},
+ $self->{FINISH_RESOURCE},
+ {}, undef, 0, $direction);
+
+ # prime the recursion
+ $self->{$firstResourceName}->{DATA}->{$valName} = 0;
+ $iterator->next();
+ my $curRes = $iterator->next();
+ my $depth = 1;
+ while ($depth > 0) {
+ if ($curRes == $iterator->BEGIN_MAP()) { $depth++; }
+ if ($curRes == $iterator->END_MAP()) { $depth--; }
+
+ if (ref($curRes)) {
+ # If there's only one resource, this will save it
+ # we have to filter empty resources from consideration here,
+ # or even "empty", redirecting maps have two (start & finish)
+ # or three (start, finish, plus redirector)
+ if($direction == FORWARD && $curRes->src()) {
+ $resource = $curRes; $resourceCount++;
+ }
+ my $resultingVal = $curRes->{DATA}->{$valName};
+ my $nextResources = $curRes->$nextResourceMethod();
+ my $nextCount = scalar(@{$nextResources});
+
+ if ($nextCount == 1) { # **3**
+ my $current = $nextResources->[0]->{DATA}->{$valName} || 999999999;
+ $nextResources->[0]->{DATA}->{$valName} = min($resultingVal, $current);
+ }
+
+ if ($nextCount > 1) { # **4**
+ foreach my $res (@{$nextResources}) {
+ my $current = $res->{DATA}->{$valName} || 999999999;
+ $res->{DATA}->{$valName} = min($current, $resultingVal + 1);
+ }
+ }
+ }
+
+ # Assign the final val (**2**)
+ if (ref($curRes) && $direction == BACKWARD()) {
+ my $finalDepth = min($curRes->{DATA}->{TOP_DOWN_VAL},
+ $curRes->{DATA}->{BOT_UP_VAL});
+
+ $curRes->{DATA}->{DISPLAY_DEPTH} = $finalDepth;
+ if ($finalDepth > $maxDepth) {$maxDepth = $finalDepth;}
+ }
+
+ $curRes = $iterator->next();
+ }
}
- my $brepriv=&Apache::lonnet::allowed('bre',$resource);
- if ($hash{'src_'.$rid}) {
- if ((($brepriv eq '2') && (!$hash{'randomout_'.$rid}))
- || ($brepriv eq 'F')) {
- my $pprefix='';
- if ($resource=~/\.(problem|exam|quiz|assess|survey|form)$/) {
- $pprefix=&astatus($rid);
- }
- $$sofar++;
- if ($indent) { $pprefix='i'.$indent.','.$pprefix; }
- if ($linkid) { $pprefix='l'.$linkid.','.$pprefix; }
- if (defined($rows[$$sofar])) {
- $rows[$$sofar].='&'.$pprefix.$rid;
- } else {
- $rows[$$sofar]=$pprefix.$rid;
- }
- }
+
+ # Check: Was this only one resource, a map?
+ if ($resourceCount == 1 && $resource->is_sequence() && !$self->{FORCE_TOP}) {
+ my $firstResource = $resource->map_start();
+ my $finishResource = $resource->map_finish();
+ return
+ Apache::lonnavmaps::iterator->new($self->{NAV_MAP}, $firstResource,
+ $finishResource, $self->{FILTER},
+ $self->{ALREADY_SEEN},
+ $self->{CONDITION},
+ $self->{FORCE_TOP});
+
}
+
+ # Set up some bookkeeping information.
+ $self->{CURRENT_DEPTH} = 0;
+ $self->{MAX_DEPTH} = $maxDepth;
+ $self->{STACK} = [];
+ $self->{RECURSIVE_ITERATOR_FLAG} = 0;
+ $self->{FINISHED} = 0; # When true, the iterator has finished
+
+ for (my $i = 0; $i <= $self->{MAX_DEPTH}; $i++) {
+ push @{$self->{STACK}}, [];
+ }
+
+ # Prime the recursion w/ the first resource **5**
+ push @{$self->{STACK}->[0]}, $self->{FIRST_RESOURCE};
+ $self->{ALREADY_SEEN}->{$self->{FIRST_RESOURCE}->{ID}} = 1;
+
+ bless ($self);
+
+ return $self;
}
-sub followlinks () {
- my ($rid,$sofar,$beenhere,$further,$showtypes,$indent,$linkid)=@_;
- my $mincond=1;
- my $next='';
- foreach (split(/\,/,$hash{'to_'.$rid})) {
- my $thiscond=
- &Apache::lonnet::directcondval($hash{'condid_'.$hash{'undercond_'.$_}});
- if ($thiscond>=$mincond) {
- if ($next) {
- $next.=','.$_.':'.$thiscond;
- } else {
- $next=$_.':'.$thiscond;
- }
- if ($thiscond>$mincond) { $mincond=$thiscond; }
- }
+sub next {
+ my $self = shift;
+ my $closeAllPages=shift;
+ if ($self->{FINISHED}) {
+ return END_ITERATOR();
}
- my $col=0;
- &Apache::lonxml::debug("following links -$next-");
- foreach (split(/\,/,$next)) {
- my ($nextlinkid,$condval)=split(/\:/,$_);
- if ($condval>=$mincond) {
- my $now=&tracetable($sofar,$hash{'goesto_'.$nextlinkid},
- $beenhere,$showtypes,$indent,$linkid);
- if ($now>$further) {
- if ($col>0) {
- my $string;
- for(my $i=0;$i<$col;$i++) { $string.='&'; }
- for(my $i=$further+1;$now-1>$i;$i++) {
- $rows[$i]=$string.$rows[$i];
- }
- }
- $further=$now;
- }
- }
- $col++;
+
+ # If we want to return the top-level map object, and haven't yet,
+ # do so.
+ if ($self->{RETURN_0} && !$self->{HAVE_RETURNED_0}) {
+ $self->{HAVE_RETURNED_0} = 1;
+ return $self->{NAV_MAP}->getById('0.0');
+ }
+
+ if ($self->{RECURSIVE_ITERATOR_FLAG}) {
+ # grab the next from the recursive iterator
+ my $next = $self->{RECURSIVE_ITERATOR}->next($closeAllPages);
+
+ # is it a begin or end map? If so, update the depth
+ if ($next == BEGIN_MAP() ) { $self->{RECURSIVE_DEPTH}++; }
+ if ($next == END_MAP() ) { $self->{RECURSIVE_DEPTH}--; }
+
+ # Are we back at depth 0? If so, stop recursing
+ if ($self->{RECURSIVE_DEPTH} == 0) {
+ $self->{RECURSIVE_ITERATOR_FLAG} = 0;
+ }
+
+ return $next;
+ }
+
+ if (defined($self->{FORCE_NEXT})) {
+ my $tmp = $self->{FORCE_NEXT};
+ $self->{FORCE_NEXT} = undef;
+ return $tmp;
+ }
+
+ # Have we not yet begun? If not, return BEGIN_MAP and
+ # remember we've started.
+ if ( !$self->{STARTED} ) {
+ $self->{STARTED} = 1;
+ return $self->BEGIN_MAP();
}
- return $further;
+
+ # Here's the guts of the iterator.
+
+ # Find the next resource, if any.
+ my $found = 0;
+ my $i = $self->{MAX_DEPTH};
+ my $newDepth;
+ my $here;
+ while ( $i >= 0 && !$found ) {
+ if ( scalar(@{$self->{STACK}->[$i]}) > 0 ) { # **6**
+ $here = pop @{$self->{STACK}->[$i]}; # **7**
+ $found = 1;
+ $newDepth = $i;
+ }
+ $i--;
+ }
+
+ # If we still didn't find anything, we're done.
+ if ( !$found ) {
+ # We need to get back down to the correct branch depth
+ if ( $self->{CURRENT_DEPTH} > 0 ) {
+ $self->{CURRENT_DEPTH}--;
+ return END_BRANCH();
+ } else {
+ $self->{FINISHED} = 1;
+ return END_MAP();
+ }
+ }
+
+ # If this is not a resource, it must be an END_BRANCH marker we want
+ # to return directly.
+ if (!ref($here)) { # **8**
+ if ($here == END_BRANCH()) { # paranoia, in case of later extension
+ $self->{CURRENT_DEPTH}--;
+ return $here;
+ }
+ }
+
+ # Otherwise, it is a resource and it's safe to store in $self->{HERE}
+ $self->{HERE} = $here;
+
+ # Get to the right level
+ if ( $self->{CURRENT_DEPTH} > $newDepth ) {
+ push @{$self->{STACK}->[$newDepth]}, $here;
+ $self->{CURRENT_DEPTH}--;
+ return END_BRANCH();
+ }
+ if ( $self->{CURRENT_DEPTH} < $newDepth) {
+ push @{$self->{STACK}->[$newDepth]}, $here;
+ $self->{CURRENT_DEPTH}++;
+ return BEGIN_BRANCH();
+ }
+
+ # If we made it here, we have the next resource, and we're at the
+ # right branch level. So let's examine the resource for where
+ # we can get to from here.
+
+ # So we need to look at all the resources we can get to from here,
+ # categorize them if we haven't seen them, remember if we have a new
+ my $nextUnfiltered = $here->getNext();
+ my $maxDepthAdded = -1;
+
+ for (@$nextUnfiltered) {
+ if (!defined($self->{ALREADY_SEEN}->{$_->{ID}})) {
+ my $depth = $_->{DATA}->{DISPLAY_DEPTH};
+ push @{$self->{STACK}->[$depth]}, $_;
+ $self->{ALREADY_SEEN}->{$_->{ID}} = 1;
+ if ($maxDepthAdded < $depth) { $maxDepthAdded = $depth; }
+ }
+ }
+
+ # Is this the end of a branch? If so, all of the resources examined above
+ # led to lower levels then the one we are currently at, so we push a END_BRANCH
+ # marker onto the stack so we don't forget.
+ # Example: For the usual A(BC)(DE)F case, when the iterator goes down the
+ # BC branch and gets to C, it will see F as the only next resource, but it's
+ # one level lower. Thus, this is the end of the branch, since there are no
+ # more resources added to this level or above.
+ # We don't do this if the examined resource is the finish resource,
+ # because the condition given above is true, but the "END_MAP" will
+ # take care of things and we should already be at depth 0.
+ my $isEndOfBranch = $maxDepthAdded < $self->{CURRENT_DEPTH};
+ if ($isEndOfBranch && $here != $self->{FINISH_RESOURCE}) { # **9**
+ push @{$self->{STACK}->[$self->{CURRENT_DEPTH}]}, END_BRANCH();
+ }
+
+ # That ends the main iterator logic. Now, do we want to recurse
+ # down this map (if this resource is a map)?
+ if ( ($self->{HERE}->is_sequence() || (!$closeAllPages && $self->{HERE}->is_page())) &&
+ (defined($self->{FILTER}->{$self->{HERE}->map_pc()}) xor $self->{CONDITION})) {
+ $self->{RECURSIVE_ITERATOR_FLAG} = 1;
+ my $firstResource = $self->{HERE}->map_start();
+ my $finishResource = $self->{HERE}->map_finish();
+
+ $self->{RECURSIVE_ITERATOR} =
+ Apache::lonnavmaps::iterator->new($self->{NAV_MAP}, $firstResource,
+ $finishResource, $self->{FILTER},
+ $self->{ALREADY_SEEN},
+ $self->{CONDITION},
+ $self->{FORCE_TOP});
+ }
+
+ # If this is a blank resource, don't actually return it.
+ # Should you ever find you need it, make sure to add an option to the code
+ # that you can use; other things depend on this behavior.
+ my $browsePriv = $self->{HERE}->browsePriv();
+ if (!$self->{HERE}->src() ||
+ (!($browsePriv eq 'F') && !($browsePriv eq '2')) ) {
+ return $self->next($closeAllPages);
+ }
+
+ return $self->{HERE};
+
}
-# ------------------------------------------------------------ Build page table
-sub tracetable {
- my ($sofar,$rid,$beenhere,$showtypes,$indent,$linkid)=@_;
- my $newshowtypes=$showtypes;
- my $further=$sofar;
- #$Apache::lonxml::debug=1;
- &Apache::lonxml::debug("$rid ; $linkid ; $sofar ; $beenhere ; ".$hash{'src_'.$rid});
- if ($beenhere=~/\&$rid\&/) { return $further; }
- $beenhere.=$rid.'&';
-
- if (defined($hash{'is_map_'.$rid})) {
- $sofar++;
- my $tprefix='';
- if ($hash{'map_type_'.$hash{'map_pc_'.$hash{'src_'.$rid}}}
- eq 'sequence') {
- $tprefix='h';
- } elsif ($hash{'map_type_'.$hash{'map_pc_'.$hash{'src_'.$rid}}}
- eq 'page') {
- $tprefix='j';
- if ($indent) { $tprefix='i'.$indent.','.$tprefix; }
- if ($linkid) { $tprefix='l'.$linkid.','.$tprefix; }
- $newshowtypes='problems';
- $indent++;
- #if in a .page continue to link the encompising .page
- if (!$linkid) { $linkid=$rid; }
- }
- if (defined($rows[$sofar])) {
- $rows[$sofar].='&'.$tprefix.$rid;
- } else {
- $rows[$sofar]=$tprefix.$rid;
- }
- if ((defined($hash{'map_start_'.$hash{'src_'.$rid}})) &&
- (defined($hash{'map_finish_'.$hash{'src_'.$rid}}))) {
- my $frid=$hash{'map_finish_'.$hash{'src_'.$rid}};
- $sofar=&tracetable($sofar,$hash{'map_start_'.$hash{'src_'.$rid}},
- '&'.$frid.'&',$newshowtypes,$indent,$linkid);
- &addresource($hash{'src_'.$frid},\$sofar,$frid,$newshowtypes,
- $indent,$linkid);
- if ($tprefix =~ /j$/) { $indent--; $linkid=''; }
- }
+=pod
+
+The other method available on the iterator is B, 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).
+
+=cut
+
+sub getStack {
+ my $self=shift;
+
+ my @stack;
+
+ $self->populateStack(\@stack);
+
+ return \@stack;
+}
+
+# Private method: Calls the iterators recursively to populate the stack.
+sub populateStack {
+ my $self=shift;
+ my $stack = shift;
+
+ push @$stack, $self->{HERE} if ($self->{HERE});
+
+ if ($self->{RECURSIVE_ITERATOR_FLAG}) {
+ $self->{RECURSIVE_ITERATOR}->populateStack($stack);
+ }
+}
+
+1;
+
+package Apache::lonnavmaps::DFSiterator;
+use Scalar::Util qw(weaken);
+use Apache::lonnet;
+
+# Not documented in the perldoc: This is a simple iterator that just walks
+# through the nav map and presents the resources in a depth-first search
+# fashion, ignorant of conditionals, randomized resources, etc. It presents
+# BEGIN_MAP and END_MAP, but does not understand branches at all. It is
+# useful for pre-processing of some kind, and is in fact used by the main
+# iterator that way, but that's about it.
+# One could imagine merging this into the init routine of the main iterator,
+# but this might as well be left separate, since it is possible some other
+# use might be found for it. - Jeremy
+
+# Unlike the main iterator, this DOES return all resources, even blank ones.
+# The main iterator needs them to correctly preprocess the map.
+
+sub BEGIN_MAP { return 1; } # begining of a new map
+sub END_MAP { return 2; } # end of the map
+sub FORWARD { return 1; } # go forward
+sub BACKWARD { return 2; }
+
+# Params: Nav map ref, first resource id/ref, finish resource id/ref,
+# filter hash ref (or undef), already seen hash or undef, condition
+# (as in main iterator), direction FORWARD or BACKWARD (undef->forward).
+sub new {
+ # magic invocation to create a class instance
+ my $proto = shift;
+ my $class = ref($proto) || $proto;
+ my $self = {};
+
+ weaken($self->{NAV_MAP} = shift);
+ return undef unless ($self->{NAV_MAP});
+
+ $self->{FIRST_RESOURCE} = shift || $self->{NAV_MAP}->firstResource();
+ $self->{FINISH_RESOURCE} = shift || $self->{NAV_MAP}->finishResource();
+
+ # If the given resources are just the ID of the resource, get the
+ # objects
+ if (!ref($self->{FIRST_RESOURCE})) { $self->{FIRST_RESOURCE} =
+ $self->{NAV_MAP}->getById($self->{FIRST_RESOURCE}); }
+ if (!ref($self->{FINISH_RESOURCE})) { $self->{FINISH_RESOURCE} =
+ $self->{NAV_MAP}->getById($self->{FINISH_RESOURCE}); }
+
+ $self->{FILTER} = shift;
+
+ # A hash, used as a set, of resource already seen
+ $self->{ALREADY_SEEN} = shift;
+ if (!defined($self->{ALREADY_SEEN})) { $self->{ALREADY_SEEN} = {} };
+ $self->{CONDITION} = shift;
+ $self->{DIRECTION} = shift || FORWARD();
+
+ # Flag: Have we started yet?
+ $self->{STARTED} = 0;
+
+ # Should we continue calling the recursive iterator, if any?
+ $self->{RECURSIVE_ITERATOR_FLAG} = 0;
+ # The recursive iterator, if any
+ $self->{RECURSIVE_ITERATOR} = undef;
+ # Are we recursing on a map, or a branch?
+ $self->{RECURSIVE_MAP} = 1; # we'll manually unset this when recursing on branches
+ # And the count of how deep it is, so that this iterator can keep track of
+ # when to pick back up again.
+ $self->{RECURSIVE_DEPTH} = 0;
+
+ # For keeping track of our branches, we maintain our own stack
+ $self->{STACK} = [];
+
+ # Start with the first resource
+ if ($self->{DIRECTION} == FORWARD) {
+ push @{$self->{STACK}}, $self->{FIRST_RESOURCE};
+ } else {
+ push @{$self->{STACK}}, $self->{FINISH_RESOURCE};
+ }
+
+ bless($self);
+ return $self;
+}
+
+sub next {
+ my $self = shift;
+
+ # Are we using a recursive iterator? If so, pull from that and
+ # watch the depth; we want to resume our level at the correct time.
+ if ($self->{RECURSIVE_ITERATOR_FLAG}) {
+ # grab the next from the recursive iterator
+ my $next = $self->{RECURSIVE_ITERATOR}->next();
+
+ # is it a begin or end map? Update depth if so
+ if ($next == BEGIN_MAP() ) { $self->{RECURSIVE_DEPTH}++; }
+ if ($next == END_MAP() ) { $self->{RECURSIVE_DEPTH}--; }
+
+ # Are we back at depth 0? If so, stop recursing.
+ if ($self->{RECURSIVE_DEPTH} == 0) {
+ $self->{RECURSIVE_ITERATOR_FLAG} = 0;
+ }
+
+ return $next;
+ }
+
+ # Is there a current resource to grab? If not, then return
+ # END_MAP, which will end the iterator.
+ if (scalar(@{$self->{STACK}}) == 0) {
+ return $self->END_MAP();
+ }
+
+ # Have we not yet begun? If not, return BEGIN_MAP and
+ # remember that we've started.
+ if ( !$self->{STARTED} ) {
+ $self->{STARTED} = 1;
+ return $self->BEGIN_MAP;
+ }
+
+ # Get the next resource in the branch
+ $self->{HERE} = pop @{$self->{STACK}};
+
+ # remember that we've seen this, so we don't return it again later
+ $self->{ALREADY_SEEN}->{$self->{HERE}->{ID}} = 1;
+
+ # Get the next possible resources
+ my $nextUnfiltered;
+ if ($self->{DIRECTION} == FORWARD()) {
+ $nextUnfiltered = $self->{HERE}->getNext();
} else {
- &addresource($hash{'src_'.$rid},\$sofar,$rid,$showtypes,
- $indent,$linkid);
+ $nextUnfiltered = $self->{HERE}->getPrevious();
}
+ my $next = [];
- if (defined($hash{'to_'.$rid})) {
- $further=&followlinks($rid,$sofar,$beenhere,$further,$showtypes,
- $indent,$linkid);
+ # filter the next possibilities to remove things we've
+ # already seen.
+ foreach (@$nextUnfiltered) {
+ if (!defined($self->{ALREADY_SEEN}->{$_->{ID}})) {
+ push @$next, $_;
+ }
}
- return $further;
+ while (@$next) {
+ # copy the next possibilities over to the stack
+ push @{$self->{STACK}}, shift @$next;
+ }
+
+ # If this is a map and we want to recurse down it... (not filtered out)
+ if ($self->{HERE}->is_map() &&
+ (defined($self->{FILTER}->{$self->{HERE}->map_pc()}) xor $self->{CONDITION})) {
+ $self->{RECURSIVE_ITERATOR_FLAG} = 1;
+ my $firstResource = $self->{HERE}->map_start();
+ my $finishResource = $self->{HERE}->map_finish();
+
+ $self->{RECURSIVE_ITERATOR} =
+ Apache::lonnavmaps::DFSiterator->new ($self->{NAV_MAP}, $firstResource,
+ $finishResource, $self->{FILTER}, $self->{ALREADY_SEEN},
+ $self->{CONDITION}, $self->{DIRECTION});
+ }
+
+ return $self->{HERE};
}
-# ================================================================ Main Handler
+# Identical to the full iterator methods of the same name. Hate to copy/paste
+# but I also hate to "inherit" either iterator from the other.
-sub handler {
- my $r=shift;
+sub getStack {
+ my $self=shift;
+ my @stack;
-# ------------------------------------------- Set document type for header only
+ $self->populateStack(\@stack);
- if ($r->header_only) {
- if ($ENV{'browser.mathml'}) {
- $r->content_type('text/xml');
+ return \@stack;
+}
+
+# Private method: Calls the iterators recursively to populate the stack.
+sub populateStack {
+ my $self=shift;
+ my $stack = shift;
+
+ push @$stack, $self->{HERE} if ($self->{HERE});
+
+ if ($self->{RECURSIVE_ITERATOR_FLAG}) {
+ $self->{RECURSIVE_ITERATOR}->populateStack($stack);
+ }
+}
+
+1;
+
+package Apache::lonnavmaps::resource;
+use Scalar::Util qw(weaken);
+use Apache::lonnet;
+
+=pod
+
+=head1 Object: resource
+
+X
+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.
+
+A resource only makes sense in the context of a navmap, as some of the
+data is stored in the navmap object.
+
+You will probably never need to instantiate this object directly. Use
+Apache::lonnavmaps::navmap, and use the "start" method to obtain the
+starting resource.
+
+Resource objects respect the parameter_hiddenparts, which suppresses
+various parts according to the wishes of the map author. As of this
+writing, there is no way to override this parameter, and suppressed
+parts will never be returned, nor will their response types or ids be
+stored.
+
+=head2 Overview
+
+A B is the most granular type of object in LON-CAPA that can
+be included in a course. It can either be a particular resource, like
+an HTML page, external resource, problem, etc., or it can be a
+container sequence, such as a "page" or a "map".
+
+To see a sequence from the user's point of view, please see the
+B chapter of the Author's
+Manual.
+
+A Resource Object, once obtained from a navmap object via a B
+method of the navmap, or from an iterator, allows you to query
+information about that resource.
+
+Generally, you do not ever want to create a resource object yourself,
+so creation has been left undocumented. Always retrieve resources
+from navmap objects.
+
+=head3 Identifying Resources
+
+XEvery resource is identified by a Resource ID in the big hash that is
+unique to that resource for a given course. X
+The Resource ID has the form #.#, where the first number is the same
+for every resource in a map, and the second is unique. For instance,
+for a course laid out like this:
+
+ * Problem 1
+ * Map
+ * Resource 2
+ * Resource 3
+
+C and C will share a first number, and C
+C will share a first number. The second number may end up
+re-used between the two groups.
+
+The resource ID is only used in the big hash, but can be used in the
+context of a course to identify a resource easily. (For instance, the
+printing system uses it to record which resources from a sequence you
+wish to print.)
+
+X X
+All resources also have Bs, which uniquely identify a resource
+in a course. Many internal LON-CAPA functions expect a symb. A symb
+carries along with it the URL of the resource, and the map it appears
+in. Symbs are much larger then resource IDs.
+
+=cut
+
+sub new {
+ # magic invocation to create a class instance
+ my $proto = shift;
+ my $class = ref($proto) || $proto;
+ my $self = {};
+
+ weaken($self->{NAV_MAP} = shift);
+ $self->{ID} = shift;
+
+ # Store this new resource in the parent nav map's cache.
+ $self->{NAV_MAP}->{RESOURCE_CACHE}->{$self->{ID}} = $self;
+ $self->{RESOURCE_ERROR} = 0;
+
+ # A hash that can be used by two-pass algorithms to store data
+ # about this resource in. Not used by the resource object
+ # directly.
+ $self->{DATA} = {};
+
+ bless($self);
+
+ return $self;
+}
+
+# private function: simplify the NAV_HASH lookups we keep doing
+# pass the name, and to automatically append my ID, pass a true val on the
+# second param
+sub navHash {
+ my $self = shift;
+ my $param = shift;
+ my $id = shift;
+ return $self->{NAV_MAP}->navhash($param . ($id?$self->{ID}:""));
+}
+
+=pod
+
+=head2 Methods
+
+Once you have a resource object, here's what you can do with it:
+
+=head3 Attribute Retrieval
+
+Every resource has certain attributes that can be retrieved and used:
+
+=over 4
+
+=item * B: Every resource has an ID that is unique for that
+ resource in the course it is in. The ID is actually in the hash
+ representing the resource, so for a resource object $res, obtain
+ it via C<$res->{ID}).
+
+=item * B:
+
+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").
+
+=item * B:
+
+Returns true if the resource is external.
+
+=item * B:
+
+Returns the kind of the resource from the compiled nav map.
+
+=item * B:
+
+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.
+
+=item * B:
+
+Returns true for a map if the randompick feature is being used on the
+map. (?)
+
+=item * B:
+
+Returns the source for the resource.
+
+=item * B:
+
+Returns the symb for the resource.
+
+=item * B:
+
+Returns the title of the resource.
+
+=back
+
+=cut
+
+# These info functions can be used directly, as they don't return
+# resource information.
+sub comesfrom { my $self=shift; return $self->navHash("comesfrom_", 1); }
+sub encrypted { my $self=shift; return $self->navHash("encrypted_", 1); }
+sub ext { my $self=shift; return $self->navHash("ext_", 1) eq 'true:'; }
+sub from { my $self=shift; return $self->navHash("from_", 1); }
+# considered private and undocumented
+sub goesto { my $self=shift; return $self->navHash("goesto_", 1); }
+sub kind { my $self=shift; return $self->navHash("kind_", 1); }
+sub randomout { my $self=shift; return $self->navHash("randomout_", 1); }
+sub randompick {
+ my $self = shift;
+ return $self->parmval('randompick');
+}
+sub link {
+ my $self=shift;
+ if ($self->encrypted()) { return &Apache::lonenc::encrypted($self->src); }
+ return $self->src;
+}
+sub src {
+ my $self=shift;
+ return $self->navHash("src_", 1);
+}
+sub shown_symb {
+ my $self=shift;
+ if ($self->encrypted()) {return &Apache::lonenc::encrypted($self->symb());}
+ return $self->symb();
+}
+sub id {
+ my $self=shift;
+ return $self->{ID};
+}
+sub enclosing_map_src {
+ my $self=shift;
+ (my $first, my $second) = $self->{ID} =~ /(\d+).(\d+)/;
+ return $self->navHash('map_id_'.$first);
+}
+sub symb {
+ my $self=shift;
+ (my $first, my $second) = $self->{ID} =~ /(\d+).(\d+)/;
+ my $symbSrc = &Apache::lonnet::declutter($self->src());
+ my $symb = &Apache::lonnet::declutter($self->navHash('map_id_'.$first))
+ . '___' . $second . '___' . $symbSrc;
+ return &Apache::lonnet::symbclean($symb);
+}
+sub wrap_symb {
+ my $self = shift;
+ return $self->{NAV_MAP}->wrap_symb($self->symb());
+}
+sub title {
+ my $self=shift;
+ if ($self->{ID} eq '0.0') {
+ # If this is the top-level map, return the title of the course
+ # since this map can not be titled otherwise.
+ return $env{'course.'.$env{'request.course.id'}.'.description'};
+ }
+ return $self->navHash("title_", 1); }
+# considered private and undocumented
+sub to { my $self=shift; return $self->navHash("to_", 1); }
+sub condition {
+ my $self=shift;
+ my $undercond=$self->navHash("undercond_", 1);
+ if (!defined($undercond)) { return 1; };
+ my $condid=$self->navHash("condid_$undercond");
+ if (!defined($condid)) { return 1; };
+ my $condition=&Apache::lonnet::directcondval($condid);
+ return $condition;
+}
+sub condval {
+ my $self=shift;
+ my ($pathname,$filename) =
+ &Apache::lonnet::split_uri_for_cond($self->src());
+
+ my $match=($env{'acc.res.'.$env{'request.course.id'}.'.'.$pathname}=~
+ /\&\Q$filename\E\:([\d\|]+)\&/);
+ if ($match) {
+ return &Apache::lonnet::condval($1);
+ }
+ return 0;
+}
+sub compTitle {
+ my $self = shift;
+ my $title = $self->title();
+ $title=~s/\&colon\;/\:/gs;
+ if (!$title) {
+ $title = $self->src();
+ $title = substr($title, rindex($title, '/') + 1);
+ }
+ return $title;
+}
+=pod
+
+B<Predicate Testing the Resource>
+
+These methods are shortcuts to deciding if a given resource has a given property.
+
+=over 4
+
+=item * B<is_map>:
+
+Returns true if the resource is a map type.
+
+=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.)
+
+=item * B<is_page>:
+
+Returns true if the resource is a page.
+
+=item * B<is_sequence>:
+
+Returns true if the resource is a sequence.
+
+=back
+
+=cut
+
+sub hasResource {
+ my $self = shift;
+ return $self->{NAV_MAP}->hasResource(@_);
+}
+
+sub retrieveResources {
+ my $self = shift;
+ return $self->{NAV_MAP}->retrieveResources(@_);
+}
+
+sub is_exam {
+ my ($self,$part) = @_;
+ if ($self->parmval('type',$part) eq 'exam') {
+ return 1;
+ }
+ if ($self->src() =~ /\.(exam)$/) {
+ return 1;
+ }
+ return 0;
+}
+sub is_html {
+ my $self=shift;
+ my $src = $self->src();
+ return ($src =~ /html$/);
+}
+sub is_map { my $self=shift; return defined($self->navHash("is_map_", 1)); }
+sub is_page {
+ my $self=shift;
+ my $src = $self->src();
+ return $self->navHash("is_map_", 1) &&
+ $self->navHash("map_type_" . $self->map_pc()) eq 'page';
+}
+sub is_practice {
+ my $self=shift;
+ my ($part) = @_;
+ if ($self->parmval('type',$part) eq 'practice') {
+ return 1;
+ }
+ return 0;
+}
+sub is_problem {
+ my $self=shift;
+ my $src = $self->src();
+ if ($src =~ /\.(problem|exam|quiz|assess|survey|form|library|task)$/) {
+ return !($self->is_practice());
+ }
+ return 0;
+}
+sub contains_problem {
+ my $self=shift;
+ if ($self->is_page()) {
+ my $hasProblem=$self->hasResource($self,sub { $_[0]->is_problem() },1);
+ return $hasProblem;
+ }
+ return 0;
+}
+sub is_sequence {
+ my $self=shift;
+ return $self->navHash("is_map_", 1) &&
+ $self->navHash("map_type_" . $self->map_pc()) eq 'sequence';
+}
+sub is_survey {
+ my $self = shift();
+ my $part = shift();
+ if ($self->parmval('type',$part) eq 'survey') {
+ return 1;
+ }
+ if ($self->src() =~ /\.(survey)$/) {
+ return 1;
+ }
+ return 0;
+}
+sub is_task {
+ my $self=shift;
+ my $src = $self->src();
+ return ($src =~ /\.(task)$/)
+}
+
+sub is_empty_sequence {
+ my $self=shift;
+ my $src = $self->src();
+ return !$self->is_page() && $self->navHash("is_map_", 1) && !$self->navHash("map_type_" . $self->map_pc());
+}
+
+# Private method: Shells out to the parmval in the nav map, handler parts.
+sub parmval {
+ my $self = shift;
+ my $what = shift;
+ my $part = shift;
+ if (!defined($part)) {
+ $part = '0';
+ }
+ return $self->{NAV_MAP}->parmval($part.'.'.$what, $self->symb());
+}
+
+=pod
+
+B<Map Methods>
+
+These methods are useful for getting information about the map
+properties of the resource, if the resource is a map (B<is_map>).
+
+=over 4
+
+=item * B<map_finish>:
+
+Returns a reference to a resource object corresponding to the finish
+resource of the map.
+
+=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.
+
+=item * B<map_start>:
+
+Returns a reference to a resource object corresponding to the start
+resource of the map.
+
+=item * B<map_type>:
+
+Returns a string with the type of the map in it.
+
+=back
+
+=cut
+
+sub map_finish {
+ my $self = shift;
+ my $src = $self->src();
+ $src = &Apache::lonnet::clutter($src);
+ my $res = $self->navHash("map_finish_$src", 0);
+ $res = $self->{NAV_MAP}->getById($res);
+ return $res;
+}
+sub map_pc {
+ my $self = shift;
+ my $src = $self->src();
+ return $self->navHash("map_pc_$src", 0);
+}
+sub map_start {
+ my $self = shift;
+ my $src = $self->src();
+ $src = &Apache::lonnet::clutter($src);
+ my $res = $self->navHash("map_start_$src", 0);
+ $res = $self->{NAV_MAP}->getById($res);
+ return $res;
+}
+sub map_type {
+ my $self = shift;
+ my $pc = $self->map_pc();
+ return $self->navHash("map_type_$pc", 0);
+}
+
+#####
+# Property queries
+#####
+
+# These functions will be responsible for returning the CORRECT
+# VALUE for the parameter, no matter what. So while they may look
+# like direct calls to parmval, they can be more then that.
+# So, for instance, the duedate function should use the "duedatetype"
+# information, rather then the resource object user.
+
+=pod
+
+=head2 Resource Parameters
+
+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.
+
+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 will not have to update
+their code.)
+
+=over 4
+
+=item * B<acc>:
+
+Get the Client IP/Name Access Control information.
+
+=item * B<answerdate>:
+
+Get the answer-reveal date for the problem.
+
+=item * B<awarded>:
+
+Gets the awarded value for the problem part. Requires genUserData set to
+true when the navmap object was created.
+
+=item * B<duedate>:
+
+Get the due date for the problem.
+
+=item * B<tries>:
+
+Get the number of tries the student has used on the problem.
+
+=item * B<maxtries>:
+
+Get the number of max tries allowed.
+
+=item * B<opendate>:
+
+Get the open date for the problem.
+
+=item * B<sig>:
+
+Get the significant figures setting.
+
+=item * B<tol>:
+
+Get the tolerance for the problem.
+
+=item * B<tries>:
+
+Get the number of tries the user has already used on the problem.
+
+=item * B<type>:
+
+Get the question type for the problem.
+
+=item * B<weight>:
+
+Get the weight for the problem.
+
+=back
+
+=cut
+
+sub acc {
+ (my $self, my $part) = @_;
+ return $self->parmval("acc", $part);
+}
+sub answerdate {
+ (my $self, my $part) = @_;
+ # Handle intervals
+ if ($self->parmval("answerdate.type", $part) eq 'date_interval') {
+ return $self->duedate($part) +
+ $self->parmval("answerdate", $part);
+ }
+ return $self->parmval("answerdate", $part);
+}
+sub awarded {
+ my $self = shift; my $part = shift;
+ $self->{NAV_MAP}->get_user_data();
+ if (!defined($part)) { $part = '0'; }
+ return $self->{NAV_MAP}->{STUDENT_DATA}->{$self->symb()}->{'resource.'.$part.'.awarded'};
+}
+# this should work exactly like the copy in lonhomework.pm
+sub duedate {
+ (my $self, my $part) = @_;
+ my $date;
+ my $interval=$self->parmval("interval", $part);
+ my $due_date=$self->parmval("duedate", $part);
+ if ($interval =~ /\d+/) {
+ my $first_access=&Apache::lonnet::get_first_access('map',$self->symb);
+ if (defined($first_access)) {
+ $interval = $first_access+$interval;
+ $date = ($interval < $due_date)? $interval : $due_date;
} else {
- $r->content_type('text/html');
+ $date = $due_date;
}
- $r->send_http_header;
- return OK;
+ } else {
+ $date = $due_date;
}
- my $requrl=$r->uri;
- my $hashtied;
-# ----------------------------------------------------------------- Tie db file
- my $fn;
- if ($ENV{'request.course.fn'}) {
- $fn=$ENV{'request.course.fn'};
- if (-e "$fn.db") {
- if ((tie(%hash,'GDBM_File',"$fn.db",&GDBM_READER,0640)) &&
- (tie(%parmhash,'GDBM_File',
- $ENV{'request.course.fn'}.'_parms.db',
- &GDBM_READER,0640))) {
- $hashtied=1;
- }
- }
+ return $date;
+}
+sub handgrade {
+ (my $self, my $part) = @_;
+ return $self->parmval("handgrade", $part);
+}
+sub maxtries {
+ (my $self, my $part) = @_;
+ return $self->parmval("maxtries", $part);
+}
+sub opendate {
+ (my $self, my $part) = @_;
+ if ($self->parmval("opendate.type", $part) eq 'date_interval') {
+ return $self->duedate($part) -
+ $self->parmval("opendate", $part);
}
- if (!$hashtied) {
- $ENV{'user.error.msg'}="$requrl:bre:0:0:Course not initialized";
- return HTTP_NOT_ACCEPTABLE;
+ return $self->parmval("opendate");
+}
+sub problemstatus {
+ (my $self, my $part) = @_;
+ return lc $self->parmval("problemstatus", $part);
+}
+sub sig {
+ (my $self, my $part) = @_;
+ return $self->parmval("sig", $part);
+}
+sub tol {
+ (my $self, my $part) = @_;
+ return $self->parmval("tol", $part);
+}
+sub tries {
+ my $self = shift;
+ my $tries = $self->queryRestoreHash('tries', shift);
+ if (!defined($tries)) { return '0';}
+ return $tries;
+}
+sub type {
+ (my $self, my $part) = @_;
+ return $self->parmval("type", $part);
+}
+sub weight {
+ my $self = shift; my $part = shift;
+ if (!defined($part)) { $part = '0'; }
+ return &Apache::lonnet::EXT('resource.'.$part.'.weight',
+ $self->symb(), $env{'user.domain'},
+ $env{'user.name'},
+ $env{'request.course.sec'});
+}
+sub part_display {
+ my $self= shift(); my $partID = shift();
+ if (! defined($partID)) { $partID = '0'; }
+ my $display=&Apache::lonnet::EXT('resource.'.$partID.'.display',
+ $self->symb);
+ if (! defined($display) || $display eq '') {
+ $display = $partID;
+ }
+ return $display;
+}
+
+# Multiple things need this
+sub getReturnHash {
+ my $self = shift;
+
+ if (!defined($self->{RETURN_HASH})) {
+ my %tmpHash = &Apache::lonnet::restore($self->symb());
+ $self->{RETURN_HASH} = \%tmpHash;
}
+}
+
+######
+# Status queries
+######
+
+# These methods query the status of problems.
+
+# If we need to count parts, this function determines the number of
+# parts from the metadata. When called, it returns a reference to a list
+# of strings corresponding to the parts. (Thus, using it in a scalar context
+# tells you how many parts you have in the problem:
+# $partcount = scalar($resource->countParts());
+# Don't use $self->{PARTS} directly because you don't know if it's been
+# computed yet.
+
+=pod
+
+=head2 Resource misc
+
+Misc. functions for the resource.
+
+=over 4
+
+=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.
+
+=item * B<last_post_time>:
+
+Returns a false value if there hasn't been discussion otherwise returns
+unix timestamp of last time a discussion posting (or edit) was made.
+
+=item * B<unread_discussion>:
+
+returns in scalar context the count of the number of unread discussion
+postings
+
+returns in list context both the count of postings and a hash ref
+containing the subjects of all unread postings
+
+=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:
+
+ for (split(/\,/, $res->getFeedback())) {
+ my $link = &escape($_);
+ ...
+
+and use the link as appropriate.
+
+=cut
+
+sub hasDiscussion {
+ my $self = shift;
+ return $self->{NAV_MAP}->hasDiscussion($self->symb());
+}
+
+sub last_post_time {
+ my $self = shift;
+ return $self->{NAV_MAP}->last_post_time($self->symb());
+}
+
+sub unread_discussion {
+ my $self = shift;
+ return $self->{NAV_MAP}->unread_discussion($self->symb());
+}
+
+sub getFeedback {
+ my $self = shift;
+ my $source = $self->src();
+ if ($source =~ /^\/res\//) { $source = substr $source, 5; }
+ return $self->{NAV_MAP}->getFeedback($source);
+}
-# ------------------------------------------------------------------- Hash tied
+sub getErrors {
+ my $self = shift;
+ my $source = $self->src();
+ if ($source =~ /^\/res\//) { $source = substr $source, 5; }
+ return $self->{NAV_MAP}->getErrors($source);
+}
+
+=pod
+
+=item * B<parts>():
+
+Returns a list reference containing sorted strings corresponding to
+each part of the problem. Single part problems have only a part '0'.
+Multipart problems do not return their part '0', since they typically
+do not really matter.
+
+=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.
+
+=item * B<countResponses>():
+
+Returns the total number of responses in the problem a student can answer.
+
+=item * B<responseTypes>():
+
+Returns a hash whose keys are the response types. The values are the number
+of times each response type is used. This is for the I<entire> problem, not
+just a single part.
+
+=item * B<multipart>():
+
+Returns true if the problem is multipart, false otherwise. Use this instead
+of countParts if all you want is multipart/not multipart.
+
+=item * B<responseType>($part):
+
+Returns the response type of the part, without the word "response" on the
+end. Example return values: 'string', 'essay', 'numeric', etc.
+
+=item * B<responseIds>($part):
+
+Retreives the response IDs for the given part as an array reference containing
+strings naming the response IDs. This may be empty.
+
+=back
+
+=cut
+
+sub parts {
+ my $self = shift;
+
+ if ($self->ext) { return []; }
+
+ $self->extractParts();
+ return $self->{PARTS};
+}
+
+sub countParts {
+ my $self = shift;
+
+ my $parts = $self->parts();
+
+ # If I left this here, then it's not necessary.
+ #my $delta = 0;
+ #for my $part (@$parts) {
+ # if ($part eq '0') { $delta--; }
+ #}
+
+ if ($self->{RESOURCE_ERROR}) {
+ return 0;
+ }
+
+ return scalar(@{$parts}); # + $delta;
+}
+
+sub countResponses {
+ my $self = shift;
+ my $count;
+ foreach my $part (@{$self->parts()}) {
+ $count+= scalar($self->responseIds($part));
+ }
+ return $count;
+}
+
+sub responseTypes {
+ my $self = shift;
+ my %responses;
+ foreach my $part (@{$self->parts()}) {
+ foreach my $responsetype ($self->responseType($part)) {
+ $responses{$responsetype}++ if (defined($responsetype));
+ }
+ }
+ return %responses;
+}
+
+sub multipart {
+ my $self = shift;
+ return $self->countParts() > 1;
+}
- if ($ENV{'browser.mathml'}) {
- $r->content_type('text/xml');
+sub singlepart {
+ my $self = shift;
+ return $self->countParts() == 1;
+}
+
+sub responseType {
+ my $self = shift;
+ my $part = shift;
+
+ $self->extractParts();
+ if (defined($self->{RESPONSE_TYPES}->{$part})) {
+ return @{$self->{RESPONSE_TYPES}->{$part}};
} else {
- $r->content_type('text/html');
+ return undef;
}
- &Apache::loncommon::no_cache($r);
- $r->send_http_header;
+}
+
+sub responseIds {
+ my $self = shift;
+ my $part = shift;
+
+ $self->extractParts();
+ if (defined($self->{RESPONSE_IDS}->{$part})) {
+ return @{$self->{RESPONSE_IDS}->{$part}};
+ } else {
+ return undef;
+ }
+}
- my $firstres=$hash{'map_start_/res/'.$ENV{'request.course.uri'}};
- my $lastres=$hash{'map_finish_/res/'.$ENV{'request.course.uri'}};
- if (!(($firstres) && ($lastres))) {
- $r->print('<html><body>Coursemap undefined.</body></html>');
- } else {
-
-# ----------------------------------------------------------------- Render page
-# -------------------------------------------------------------- Set parameters
-
-
-# ---------------------------- initialize coursedata and userdata for this user
- undef %courseopt;
- undef %useropt;
-
- my $uname=$ENV{'user.name'};
- my $udom=$ENV{'user.domain'};
- my $uhome=$ENV{'user.home'};
- my $cid=$ENV{'request.course.id'};
- my $chome=$ENV{'course.'.$cid.'.home'};
- my ($cdom,$cnum)=split(/\_/,$cid);
-
- my $userprefix=$uname.'_'.$udom.'_';
-
- unless ($uhome eq 'no_host') {
-# -------------------------------------------------------------- Get coursedata
- unless ((time-$courserdatas{$cid.'.last_cache'})<240) {
- my $reply=&Apache::lonnet::reply('dump:'.$cdom.':'.$cnum.
- ':resourcedata',$chome);
- if ($reply!~/^error\:/) {
- $courserdatas{$cid}=$reply;
- $courserdatas{$cid.'.last_cache'}=time;
+# Private function: Extracts the parts information, both part names and
+# part types, and saves it.
+sub extractParts {
+ my $self = shift;
+
+ return if (defined($self->{PARTS}));
+ return if ($self->ext);
+
+ $self->{PARTS} = [];
+
+ my %parts;
+
+ # Retrieve part count, if this is a problem
+ if ($self->is_problem()) {
+ my $partorder = &Apache::lonnet::metadata($self->src(), 'partorder');
+ my $metadata = &Apache::lonnet::metadata($self->src(), 'packages');
+
+ if ($partorder) {
+ my @parts;
+ for my $part (split (/,/,$partorder)) {
+ if (!Apache::loncommon::check_if_partid_hidden($part, $self->symb())) {
+ push @parts, $part;
+ $parts{$part} = 1;
}
}
- foreach (split(/\&/,$courserdatas{$cid})) {
- my ($name,$value)=split(/\=/,$_);
- $courseopt{$userprefix.&Apache::lonnet::unescape($name)}=
- &Apache::lonnet::unescape($value);
+ $self->{PARTS} = \@parts;
+ } else {
+ if (!$metadata) {
+ $self->{RESOURCE_ERROR} = 1;
+ $self->{PARTS} = [];
+ $self->{PART_TYPE} = {};
+ return;
}
-# --------------------------------------------------- Get userdata (if present)
- unless ((time-$userrdatas{$uname.'___'.$udom.'.last_cache'})<240) {
- my $reply=&Apache::lonnet::reply('dump:'.$udom.':'.$uname.':resourcedata',$uhome);
- if ($reply!~/^error\:/) {
- $userrdatas{$uname.'___'.$udom}=$reply;
- $userrdatas{$uname.'___'.$udom.'.last_cache'}=time;
+ foreach (split(/\,/,$metadata)) {
+ if ($_ =~ /^(?:part|Task)_(.*)$/) {
+ my $part = $1;
+ # This floods the logs if it blows up
+ if (defined($parts{$part})) {
+ &Apache::lonnet::logthis("$part multiply defined in metadata for " . $self->symb());
+ }
+
+ # check to see if part is turned off.
+
+ if (!Apache::loncommon::check_if_partid_hidden($part, $self->symb())) {
+ $parts{$part} = 1;
+ }
}
}
- foreach (split(/\&/,$userrdatas{$uname.'___'.$udom})) {
- my ($name,$value)=split(/\=/,$_);
- $useropt{$userprefix.&Apache::lonnet::unescape($name)}=
- &Apache::lonnet::unescape($value);
+ my @sortedParts = sort keys %parts;
+ $self->{PARTS} = \@sortedParts;
+ }
+
+
+ # These hashes probably do not need names that end with "Hash"....
+ my %responseIdHash;
+ my %responseTypeHash;
+
+
+ # Init the responseIdHash
+ foreach (@{$self->{PARTS}}) {
+ $responseIdHash{$_} = [];
+ }
+
+ # Now, the unfortunate thing about this is that parts, part name, and
+ # response id are delimited by underscores, but both the part
+ # name and response id can themselves have underscores in them.
+ # So we have to use our knowlege of part names to figure out
+ # where the part names begin and end, and even then, it is possible
+ # to construct ambiguous situations.
+ foreach my $data (split /,/, $metadata) {
+ if ($data =~ /^([a-zA-Z]+)response_(.*)/
+ || $data =~ /^(Task)_(.*)/) {
+ my $responseType = $1;
+ my $partStuff = $2;
+ my $partIdSoFar = '';
+ my @partChunks = split /_/, $partStuff;
+ my $i = 0;
+ for ($i = 0; $i < scalar(@partChunks); $i++) {
+ if ($partIdSoFar) { $partIdSoFar .= '_'; }
+ $partIdSoFar .= $partChunks[$i];
+ if ($parts{$partIdSoFar}) {
+ my @otherChunks = @partChunks[$i+1..$#partChunks];
+ my $responseId = join('_', @otherChunks);
+ if ($self->is_task()) {
+ push(@{$responseIdHash{$partIdSoFar}},
+ $partIdSoFar);
+ } else {
+ push(@{$responseIdHash{$partIdSoFar}},
+ $responseId);
+ }
+ push(@{$responseTypeHash{$partIdSoFar}},
+ $responseType);
+ }
+ }
+ }
+ }
+ my $resorder = &Apache::lonnet::metadata($self->src(),'responseorder');
+ #
+ # Reorder the arrays in the %responseIdHash and %responseTypeHash
+ if ($resorder) {
+ my @resorder=split(/,/,$resorder);
+ foreach my $part (keys(%responseIdHash)) {
+ my $i=0;
+ my %resids = map { ($_,$i++) } @{ $responseIdHash{$part} };
+ my @neworder;
+ foreach my $possibleid (@resorder) {
+ if (exists($resids{$possibleid})) {
+ push(@neworder,$resids{$possibleid});
+ }
+ }
+ my @ids;
+ my @type;
+ foreach my $element (@neworder) {
+ push (@ids,$responseIdHash{$part}->[$element]);
+ push (@type,$responseTypeHash{$part}->[$element]);
+ }
+ $responseIdHash{$part}=\@ids;
+ $responseTypeHash{$part}=\@type;
}
}
+ $self->{RESPONSE_IDS} = \%responseIdHash;
+ $self->{RESPONSE_TYPES} = \%responseTypeHash;
+ }
+
+ return;
+}
- @rows=();
+=pod
- &tracetable(0,$firstres,'&'.$lastres.'&','',0);
- if ($hash{'src_'.$lastres}) {
- my $brepriv=&Apache::lonnet::allowed('bre',$hash{'src_'.$lastres});
- if (($brepriv eq '2') || ($brepriv eq 'F')) {
- $rows[$#rows+1]=''.$lastres;
- }
+=head2 Resource Status
+
+Problem resources have status information, reflecting their various
+dates and completion statuses.
+
+There are two aspects to the status: the date-related information and
+the completion information.
+
+Idiomatic usage of these two methods would probably look something
+like
+
+ foreach ($resource->parts()) {
+ my $dateStatus = $resource->getDateStatus($_);
+ my $completionStatus = $resource->getCompletionStatus($_);
+
+ or
+
+ my $status = $resource->status($_);
+
+ ... use it here ...
+ }
+
+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.
+
+The symbolic constants shown below can be accessed through the
+resource object: C<$res->OPEN>.
+
+=over 4
+
+=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:
+
+=back
+
+B<Date Codes>
+
+=over 4
+
+=item * B<OPEN_LATER>:
+
+The problem will be opened later.
+
+=item * B<OPEN>:
+
+Open and not yet due.
+
+
+=item * B<PAST_DUE_ANSWER_LATER>:
+
+The due date has passed, but the answer date has not yet arrived.
+
+=item * B<PAST_DUE_NO_ANSWER>:
+
+The due date has passed and there is no answer opening date set.
+
+=item * B<ANSWER_OPEN>:
+
+The answer date is here.
+
+=item * B<NETWORK_FAILURE>:
+
+The information is unknown due to network failure.
+
+=back
+
+=cut
+
+# Apparently the compiler optimizes these into constants automatically
+sub OPEN_LATER { return 0; }
+sub OPEN { return 1; }
+sub PAST_DUE_NO_ANSWER { return 2; }
+sub PAST_DUE_ANSWER_LATER { return 3; }
+sub ANSWER_OPEN { return 4; }
+sub NOTHING_SET { return 5; }
+sub NETWORK_FAILURE { return 100; }
+
+# getDateStatus gets the date status for a given problem part.
+# Because answer date, due date, and open date are fully independent
+# (i.e., it is perfectly possible to *only* have an answer date),
+# we have to completely cover the 3x3 maxtrix of (answer, due, open) x
+# (past, future, none given). This function handles this with a decision
+# tree. Read the comments to follow the decision tree.
+
+sub getDateStatus {
+ my $self = shift;
+ my $part = shift;
+ $part = "0" if (!defined($part));
+
+ # Always return network failure if there was one.
+ return $self->NETWORK_FAILURE if ($self->{NAV_MAP}->{NETWORK_FAILURE});
+
+ my $now = time();
+
+ my $open = $self->opendate($part);
+ my $due = $self->duedate($part);
+ my $answer = $self->answerdate($part);
+
+ if (!$open && !$due && !$answer) {
+ # no data on the problem at all
+ # should this be the same as "open later"? think multipart.
+ return $self->NOTHING_SET;
+ }
+ if (!$open || $now < $open) {return $self->OPEN_LATER}
+ if (!$due || $now < $due) {return $self->OPEN}
+ if ($answer && $now < $answer) {return $self->PAST_DUE_ANSWER_LATER}
+ if ($answer) { return $self->ANSWER_OPEN; }
+ return PAST_DUE_NO_ANSWER;
+}
+
+=pod
+
+B<>
+
+=over 4
+
+=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:
+
+=back
+
+B<Completion Codes>
+
+=over 4
+
+=item * B<NOT_ATTEMPTED>:
+
+Has not been attempted at all.
+
+=item * B<INCORRECT>:
+
+Attempted, but wrong by student.
+
+=item * B<INCORRECT_BY_OVERRIDE>:
+
+Attempted, but wrong by instructor override.
+
+=item * B<CORRECT>:
+
+Correct or correct by instructor.
+
+=item * B<CORRECT_BY_OVERRIDE>:
+
+Correct by instructor override.
+
+=item * B<EXCUSED>:
+
+Excused. Not yet implemented.
+
+=item * B<NETWORK_FAILURE>:
+
+Information not available due to network failure.
+
+=item * B<ATTEMPTED>:
+
+Attempted, and not yet graded.
+
+=back
+
+=cut
+
+sub NOT_ATTEMPTED { return 10; }
+sub INCORRECT { return 11; }
+sub INCORRECT_BY_OVERRIDE { return 12; }
+sub CORRECT { return 13; }
+sub CORRECT_BY_OVERRIDE { return 14; }
+sub EXCUSED { return 15; }
+sub ATTEMPTED { return 16; }
+
+sub getCompletionStatus {
+ my $self = shift;
+ my $part = shift;
+ return $self->NETWORK_FAILURE if ($self->{NAV_MAP}->{NETWORK_FAILURE});
+
+ my $status = $self->queryRestoreHash('solved', $part);
+
+ # Left as separate if statements in case we ever do more with this
+ if ($status eq 'correct_by_student') {return $self->CORRECT;}
+ if ($status eq 'correct_by_scantron') {return $self->CORRECT;}
+ if ($status eq 'correct_by_override') {
+ return $self->CORRECT_BY_OVERRIDE;
+ }
+ if ($status eq 'incorrect_attempted') {return $self->INCORRECT; }
+ if ($status eq 'incorrect_by_override') {return $self->INCORRECT_BY_OVERRIDE; }
+ if ($status eq 'excused') {return $self->EXCUSED; }
+ if ($status eq 'ungraded_attempted') {return $self->ATTEMPTED; }
+ return $self->NOT_ATTEMPTED;
+}
+
+sub queryRestoreHash {
+ my $self = shift;
+ my $hashentry = shift;
+ my $part = shift;
+ $part = "0" if (!defined($part) || $part eq '');
+ return $self->NETWORK_FAILURE if ($self->{NAV_MAP}->{NETWORK_FAILURE});
+
+ $self->getReturnHash();
+
+ return $self->{RETURN_HASH}->{'resource.'.$part.'.'.$hashentry};
+}
+
+=pod
+
+B<Composite Status>
+
+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. This method represents
+the concept of the thing we want to display to the user on the nav maps
+screen, which is a combination of completion and open status. 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): In addition to the return values that match
+the date or completion status, this function can return "ANSWER_SUBMITTED"
+if that problemstatus parameter value is set to No, suppressing the
+incorrect/correct feedback.
+
+=over 4
+
+=item * B<NETWORK_FAILURE>:
+
+The network has failed and the information is not available.
+
+=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 do not know a given part will EVER
+be opened. For single part, this is the same as "OPEN_LATER".)
+
+=item * B<CORRECT>:
+
+For any reason at all, the part is considered correct.
+
+=item * B<EXCUSED>:
+
+For any reason at all, the problem is excused.
+
+=item * B<PAST_DUE_NO_ANSWER>:
+
+The problem is past due, not considered correct, and no answer date is
+set.
+
+=item * B<PAST_DUE_ANSWER_LATER>:
+
+The problem is past due, not considered correct, and an answer date in
+the future is set.
+
+=item * B<ANSWER_OPEN>:
+
+The problem is past due, not correct, and the answer is now available.
+
+=item * B<OPEN_LATER>:
+
+The problem is not yet open.
+
+=item * B<TRIES_LEFT>:
+
+The problem is open, has been tried, is not correct, but there are
+tries left.
+
+=item * B<INCORRECT>:
+
+The problem is open, and all tries have been used without getting the
+correct answer.
+
+=item * B<OPEN>:
+
+The item is open and not yet tried.
+
+=item * B<ATTEMPTED>:
+
+The problem has been attempted.
+
+=item * B<ANSWER_SUBMITTED>:
+
+An answer has been submitted, but the student should not see it.
+
+=back
+
+=cut
+
+sub TRIES_LEFT { return 20; }
+sub ANSWER_SUBMITTED { return 21; }
+sub PARTIALLY_CORRECT{ return 22; }
+
+sub status {
+ my $self = shift;
+ my $part = shift;
+ if (!defined($part)) { $part = "0"; }
+ my $completionStatus = $self->getCompletionStatus($part);
+ my $dateStatus = $self->getDateStatus($part);
+
+ # What we have is a two-dimensional matrix with 4 entries on one
+ # dimension and 5 entries on the other, which we want to colorize,
+ # plus network failure and "no date data at all".
+
+ #if ($self->{RESOURCE_ERROR}) { return NETWORK_FAILURE; }
+ if ($completionStatus == NETWORK_FAILURE) { return NETWORK_FAILURE; }
+
+ my $suppressFeedback = $self->problemstatus($part) eq 'no';
+ # If there's an answer date and we're past it, don't
+ # suppress the feedback; student should know
+ if ($self->duedate($part) && $self->duedate($part) < time() &&
+ $self->answerdate($part) && $self->answerdate($part) < time()) {
+ $suppressFeedback = 0;
+ }
+
+ # There are a few whole rows we can dispose of:
+ if ($completionStatus == CORRECT ||
+ $completionStatus == CORRECT_BY_OVERRIDE ) {
+ if ( $suppressFeedback ) { return ANSWER_SUBMITTED }
+ my $awarded=$self->awarded($part);
+ if ($awarded < 1 && $awarded > 0) {
+ return PARTIALLY_CORRECT;
+ } elsif ($awarded<1) {
+ return INCORRECT;
}
+ return CORRECT;
+ }
-# ------------------------------------------------------------------ Page parms
+ # If it's WRONG... and not open
+ if ( ($completionStatus == INCORRECT ||
+ $completionStatus == INCORRECT_BY_OVERRIDE)
+ && (!$self->opendate($part) || $self->opendate($part) > time()) ) {
+ return INCORRECT;
+ }
- my $j;
- my $i;
- my $lcm=1;
- my $contents=0;
+ if ($completionStatus == ATTEMPTED) {
+ return ATTEMPTED;
+ }
+
+ # If it's EXCUSED, then return that no matter what
+ if ($completionStatus == EXCUSED) {
+ return EXCUSED;
+ }
+
+ if ($dateStatus == NOTHING_SET) {
+ return NOTHING_SET;
+ }
+
+ # Now we're down to a 4 (incorrect, incorrect_override, not_attempted)
+ # by 4 matrix (date statuses).
+
+ if ($dateStatus == PAST_DUE_ANSWER_LATER ||
+ $dateStatus == PAST_DUE_NO_ANSWER ) {
+ return $suppressFeedback ? ANSWER_SUBMITTED : $dateStatus;
+ }
+
+ if ($dateStatus == ANSWER_OPEN) {
+ return ANSWER_OPEN;
+ }
+
+ # Now: (incorrect, incorrect_override, not_attempted) x
+ # (open_later), (open)
+
+ if ($dateStatus == OPEN_LATER) {
+ return OPEN_LATER;
+ }
+
+ # If it's WRONG...
+ if ($completionStatus == INCORRECT || $completionStatus == INCORRECT_BY_OVERRIDE) {
+ # and there are TRIES LEFT:
+ if ($self->tries($part) < $self->maxtries($part) || !$self->maxtries($part)) {
+ return $suppressFeedback ? ANSWER_SUBMITTED : TRIES_LEFT;
+ }
+ return $suppressFeedback ? ANSWER_SUBMITTED : INCORRECT; # otherwise, return orange; student can't fix this
+ }
+
+ # Otherwise, it's untried and open
+ return OPEN;
+}
+
+sub CLOSED { return 23; }
+sub ERROR { return 24; }
-# ---------------------------------------------- Go through table to get layout
+=pod
- for ($i=0;$i<=$#rows;$i++) {
- if ($rows[$i]) {
- &Apache::lonxml::debug("Row $i is:".$rows[$i]);
- $contents++;
- my @colcont=split(/\&/,$rows[$i]);
- $lcm*=($#colcont+1)/euclid($lcm,($#colcont+1));
- }
+B<Simple Status>
+
+Convenience method B<simpleStatus> provides a "simple status" for the resource.
+"Simple status" corresponds to "which icon is shown on the
+Navmaps". There are six "simple" statuses:
+
+=over 4
+
+=item * B<CLOSED>: The problem is currently closed. (No icon shown.)
+
+=item * B<OPEN>: The problem is open and unattempted.
+
+=item * B<CORRECT>: The problem is correct for any reason.
+
+=item * B<INCORRECT>: The problem is incorrect and can still be
+completed successfully.
+
+=item * B<ATTEMPTED>: The problem has been attempted, but the student
+does not know if they are correct. (The ellipsis icon.)
+
+=item * B<ERROR>: There is an error retrieving information about this
+problem.
+
+=back
+
+=cut
+
+# This hash maps the composite status to this simple status, and
+# can be used directly, if you like
+my %compositeToSimple =
+ (
+ NETWORK_FAILURE() => ERROR,
+ NOTHING_SET() => CLOSED,
+ CORRECT() => CORRECT,
+ PARTIALLY_CORRECT() => PARTIALLY_CORRECT,
+ EXCUSED() => CORRECT,
+ PAST_DUE_NO_ANSWER() => INCORRECT,
+ PAST_DUE_ANSWER_LATER() => INCORRECT,
+ ANSWER_OPEN() => INCORRECT,
+ OPEN_LATER() => CLOSED,
+ TRIES_LEFT() => OPEN,
+ INCORRECT() => INCORRECT,
+ OPEN() => OPEN,
+ ATTEMPTED() => ATTEMPTED,
+ ANSWER_SUBMITTED() => ATTEMPTED
+ );
+
+sub simpleStatus {
+ my $self = shift;
+ my $part = shift;
+ my $status = $self->status($part);
+ return $compositeToSimple{$status};
+}
+
+=pod
+
+B<simpleStatusCount> will return an array reference containing, in
+this order, the number of OPEN, CLOSED, CORRECT, INCORRECT, ATTEMPTED,
+and ERROR parts the given problem has.
+
+=cut
+
+# This maps the status to the slot we want to increment
+my %statusToSlotMap =
+ (
+ OPEN() => 0,
+ CLOSED() => 1,
+ CORRECT() => 2,
+ INCORRECT() => 3,
+ ATTEMPTED() => 4,
+ ERROR() => 5
+ );
+
+sub statusToSlot { return $statusToSlotMap{shift()}; }
+
+sub simpleStatusCount {
+ my $self = shift;
+
+ my @counts = (0, 0, 0, 0, 0, 0, 0);
+ foreach my $part (@{$self->parts()}) {
+ $counts[$statusToSlotMap{$self->simpleStatus($part)}]++;
+ }
+
+ return \@counts;
+}
+
+=pod
+
+B<Completable>
+
+The completable method represents the concept of I<whether the student can
+currently do the problem>. If the student can do the problem, which means
+that it is open, there are tries left, and if the problem is manually graded
+or the grade is suppressed via problemstatus, the student has not tried it
+yet, then the method returns 1. Otherwise, it returns 0, to indicate that
+either the student has tried it and there is no feedback, or that for
+some reason it is no longer completable (not open yet, successfully completed,
+out of tries, etc.). As an example, this is used as the filter for the
+"Uncompleted Homework" option for the nav maps.
+
+If this does not quite meet your needs, do not fiddle with it (unless you are
+fixing it to better match the student's conception of "completable" because
+it's broken somehow)... make a new method.
+
+=cut
+
+sub completable {
+ my $self = shift;
+ if (!$self->is_problem()) { return 0; }
+ my $partCount = $self->countParts();
+
+ foreach my $part (@{$self->parts()}) {
+ if ($part eq '0' && $partCount != 1) { next; }
+ my $status = $self->status($part);
+ # "If any of the parts are open, or have tries left (implies open),
+ # and it is not "attempted" (manually graded problem), it is
+ # not "complete"
+ if ($self->getCompletionStatus($part) == ATTEMPTED() ||
+ $status == ANSWER_SUBMITTED() ) {
+ # did this part already, as well as we can
+ next;
+ }
+ if ($status == OPEN() || $status == TRIES_LEFT()) {
+ return 1;
}
+ }
+
+ # If all the parts were complete, so was this problem.
+ return 0;
+}
+=pod
- unless ($contents) {
- $r->print('<html><body>Empty Map.</body></html>');
- } else {
+=head2 Resource/Nav Map Navigation
-# ------------------------------------------------------------------ Build page
+=over 4
- my $currenturl=$ENV{'form.postdata'};
- $currenturl=~s/^http\:\/\///;
- $currenturl=~s/^[^\/]+//;
-
-# ---------------------------------------------------------------- Send headers
-
- my $date=localtime;
- my $now=time;
-# ----------------------------------------- Get email status and discussiontime
-
- my %emailstatus=&Apache::lonnet::dump('email_status');
- my $logouttime=$emailstatus{'logout'};
- my $courseleave=$emailstatus{'logout_'.$ENV{'request.course.id'}};
- my $lastcheck=($courseleave>$logouttime?$courseleave:$logouttime);
-
- my %discussiontimes=&Apache::lonnet::dump('discussiontimes',
- $cdom,$cnum);
-
- my %feedback=();
- my %error=();
- foreach my $msgid (split(/\&/,&Apache::lonnet::reply('keys:'.
- $ENV{'user.domain'}.':'.
- $ENV{'user.name'}.':nohist_email',
- $ENV{'user.home'}))) {
- $msgid=&Apache::lonnet::unescape($msgid);
- my $plain=&Apache::lonnet::unescape(&Apache::lonnet::unescape($msgid));
- if ($plain=~/(Error|Feedback) \[([^\]]+)\]/) {
- my ($what,$url)=($1,$2);
- my %status=
- &Apache::lonnet::get('email_status',[$msgid]);
- if ($status{$msgid}=~/^error\:/) {
- $status{$msgid}='';
- }
-
- if (($status{$msgid} eq 'new') ||
- (!$status{$msgid})) {
- if ($what eq 'Error') {
- $error{$url}.=','.$msgid;
- } else {
- $feedback{$url}.=','.$msgid;
- }
- }
- }
- }
-# ----------------------------------------------------------- Start Page Output
- $r->print('<html><head><title>Navigate LON-CAPA Maps ');
- $r->print('print(' onLoad="window.location.hash='."'curloc'".'"');
- }
- $r->print('>'.
- 'Navigate Course Map '.
- "$date ");
- $r->rflush();
- $r->print('');
- if (($currenturl=~/^\/res/) &&
- ($currenturl!~/^\/res\/adm/)) {
- $r->print('Current Location
');
- }
-# ----------------------------------------------------- The little content list
- for ($i=0;$i<=$#rows;$i++) {
- if ($rows[$i]) {
- my @colcont=split(/\&/,$rows[$i]);
- my $avespan=$lcm/($#colcont+1);
- for ($j=0;$j<=$#colcont;$j++) {
- my $rid=$colcont[$j];
- if ($rid=~/^h(.+)/) {
- $rid=$1;
- $r->print(' '.$hash{'title_'.$rid}.
- '
');
- for ($i=0;$i<=$#rows;$i++) {
- if ($rows[$i]) {
- $r->print("\n");
- my @colcont=split(/\&/,$rows[$i]);
- my $avespan=$lcm/($#colcont+1);
- for ($j=0;$j<=$#colcont;$j++) {
- my $indent;my $indentstr;
- my $linkid;
- my $rid=$colcont[$j];
- $rid=~/(\d+)\.(\d+)$/;
- my $src=
- &Apache::lonnet::declutter($hash{'src_'.$1.'.'.$2});
- my $symb=
- &Apache::lonnet::declutter($hash{'map_id_'.$1}).'___'.$2.'___'.$src;
- my $add='';
- my $adde=' ';
- my $hwk='';
- my $hwke=' ';
- if ($rid=~/^l(\d+\.\d+),(.+)/) { $linkid=$1; $rid=$2; }
- if ($rid=~/^i(\d+),(.+)/) { $indent=$1; $rid=$2; }
- if ($rid=~/^h(.+)/) {
- $rid=$1;
- $add='';
- $adde=' ';
- }
- if ($code eq '3') {
- $add=' ';
- } elsif ($code eq '4') {
- $add=' ';
- } else {
- $add=' ';
- if ($tcode eq '2') {
- $add=' ';
- }
- if ($tcode eq '4') {
- $add=' ';
- $adde=' ';
- }
- }
- $hwk='';
- $hwke=' ';
- $hwke=' ('.$ctext.')';
- $hwke=' ('.$ctext.')> < '.
- $hwk.$hash{'title_'.$rid}.$hwke.' ');
- }
- $r->print($adde);
- }
- $r->print(' ');
- }
- }
- $r->print("\n
");
- $r->print('