--- loncom/interface/lonnavmaps.pm 2005/04/11 12:20:22 1.321 +++ loncom/interface/lonnavmaps.pm 2005/10/07 17:57:39 1.343 @@ -1,7 +1,7 @@ # The LearningOnline Network with CAPA # Navigate Maps Handler # -# $Id: lonnavmaps.pm,v 1.321 2005/04/11 12:20:22 raeburn Exp $ +# $Id: lonnavmaps.pm,v 1.343 2005/10/07 17:57:39 albertel Exp $ # # Copyright Michigan State University Board of Trustees # @@ -57,6 +57,7 @@ my %statusIconMap = $resObj->CLOSED => '', $resObj->OPEN => 'navmap.open.gif', $resObj->CORRECT => 'navmap.correct.gif', + $resObj->PARTIALLY_CORRECT => 'navmap.ellipsis.gif', $resObj->INCORRECT => 'navmap.wrong.gif', $resObj->ATTEMPTED => 'navmap.ellipsis.gif', $resObj->ERROR => '' @@ -81,21 +82,28 @@ my %colormap = $resObj->OPEN => '', $resObj->NOTHING_SET => '', $resObj->ATTEMPTED => '', - $resObj->ANSWER_SUBMITTED => '' + $resObj->ANSWER_SUBMITTED => '', + $resObj->PARTIALLY_CORRECT => '#006600' ); # And a special case in the nav map; what to do when the assignment # is not yet done and due in less then 24 hours my $hurryUpColor = "#FF0000"; sub launch_win { - my ($mode,$script,$toplinkitems)=@_; + my ($mode,$script,$toplinkitems,$firsttime)=@_; my $result; if ($script ne 'no') { $result.=' +MENU + } + } + if ($ENV{QUERY_STRING} eq 'turningOffExternal') { + $env{'environment.remotenavmap'}='off'; } # Create the nav map @@ -288,7 +310,7 @@ ENDSUBM if ($ENV{QUERY_STRING} eq 'launchExternal') { $r->print(' -
'); $r->print(' @@ -492,22 +514,22 @@ sub getDescription { return &mt("Not currently assigned."); } if ($status == $res->OPEN_LATER) { - return "Open " . timeToHumanString($res->opendate($part)); + return "Open " . timeToHumanString($res->opendate($part),'start'); } if ($status == $res->OPEN) { if ($res->duedate($part)) { - return &mt("Due")." " .timeToHumanString($res->duedate($part)); + return &mt("Due")." " .timeToHumanString($res->duedate($part),'end'); } else { return &mt("Open, no due date"); } } if ($status == $res->PAST_DUE_ANSWER_LATER) { - return &mt("Answer open")." " . timeToHumanString($res->answerdate($part)); + return &mt("Answer open")." " . timeToHumanString($res->answerdate($part),'start'); } if ($status == $res->PAST_DUE_NO_ANSWER) { - return &mt("Was due")." " . timeToHumanString($res->duedate($part)); + return &mt("Was due")." " . timeToHumanString($res->duedate($part),'end'); } - if ($status == $res->ANSWER_OPEN) { + if ($status == $res->ANSWER_OPEN || $status == $res->PARTIALLY_CORRECT) { return &mt("Answer available"); } if ($status == $res->EXCUSED) { @@ -527,7 +549,7 @@ sub getDescription { } } if ($res->duedate($part)) { - return &mt("Due")." " . timeToHumanString($res->duedate($part)) . + return &mt("Due")." " . timeToHumanString($res->duedate($part),'end') . " $triesString"; } else { return &mt("No due date")." $triesString"; @@ -581,7 +603,7 @@ sub advancedUser { # Very, very, very, VERY English-only... goodness help a localizer on # this func... sub timeToHumanString { - my ($time) = @_; + my ($time,$type) = @_; # zero, '0' and blank are bad times if (!$time) { return &mt('never'); @@ -658,21 +680,27 @@ sub timeToHumanString { my $timeStr = strftime("%A, %b %e at %I:%M %P", localtime($time)); $timeStr =~ s/12:00 am/00:00/; $timeStr =~ s/12:00 pm/noon/; - return ($inPast ? "last " : "next ") . + return ($inPast ? "last " : "this ") . $timeStr; } + my $conjunction='on'; + if ($type eq 'start') { + $conjunction='at'; + } elsif ($type eq 'end') { + $conjunction='by'; + } # Is it this year? if ( $time[5] == $now[5]) { # Return on Month Day, HH:MM meridian - my $timeStr = strftime("on %A, %b %e at %I:%M %P", localtime($time)); + my $timeStr = strftime("$conjunction %A, %b %e at %I:%M %P", localtime($time)); $timeStr =~ s/12:00 am/00:00/; $timeStr =~ s/12:00 pm/noon/; return $timeStr; } # Not this year, so show the year - my $timeStr = strftime("on %A, %b %e %Y at %I:%M %P", localtime($time)); + my $timeStr = strftime("$conjunction %A, %b %e %Y at %I:%M %P", localtime($time)); $timeStr =~ s/12:00 am/00:00/; $timeStr =~ s/12:00 pm/noon/; return $timeStr; @@ -1039,7 +1067,7 @@ sub render_resource { my $location=&Apache::loncommon::lonhttpdurl("/adm/lonIcons"); # If this is a new branch, label it so if ($params->{'isNewBranch'}) { - $newBranchText = ""; + $newBranchText = "Branch"; } # links to open and close the folder @@ -1051,16 +1079,16 @@ sub render_resource { my $linkclose = ""; # Default icon: unknown page - my $icon = ""; + my $icon = ""; if ($resource->is_problem()) { if ($part eq '0' || $params->{'condensed'}) { - $icon =''; + $icon ='  '; } else { $icon = $params->{'indentString'}; } } else { - $icon = ""; + $icon = "  "; } # Display the correct map icon to open or shut map @@ -1075,7 +1103,8 @@ sub render_resource { if (!$params->{'resource_no_folder_link'}) { $icon = "navmap.$folderType." . ($nowOpen ? 'closed' : 'open') . '.gif'; - $icon = ""; + $icon = "". + ($nowOpen ? "; $linkopen = "{'queryString'} . '&filter='; @@ -1093,7 +1122,8 @@ sub render_resource { # Don't allow users to manipulate folder $icon = "navmap.$folderType." . ($nowOpen ? 'closed' : 'open') . '.nomanip.gif'; - $icon = ""; + $icon = "". + ($nowOpen ? "; $linkopen = ""; $linkclose = ""; @@ -1103,6 +1133,9 @@ sub render_resource { if ($resource->randomout()) { $nonLinkedText .= ' (hidden) '; } + if (!$resource->condval()) { + $nonLinkedText .= ' (conditionally hidden) '; + } # We're done preparing and finally ready to start the rendering my $result = ""; @@ -1160,7 +1193,11 @@ sub render_communication_status { my $discussionHTML = ""; my $feedbackHTML = ""; my $errorHTML = ""; my $link = $params->{"resourceLink"}; - my $linkopen = ""; + 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()) { @@ -1173,7 +1210,7 @@ sub render_communication_status { my $feedback = $resource->getFeedback(); foreach (split(/\,/, $feedback)) { if ($_) { - $feedbackHTML .= ' ' . ''; @@ -1188,7 +1225,7 @@ sub render_communication_status { last if ($errorcount>=10); # Only output 10 bombs maximum if ($_) { $errorcount++; - $errorHTML .= ' ' . ''; @@ -1210,7 +1247,11 @@ sub render_quick_status { $params->{'multipart'} && $part eq "0"; my $link = $params->{"resourceLink"}; - my $linkopen = ""; + my $target; + if ($env{'environment.remotenavmap'} eq 'on') { + $target=' target="loncapaclient" '; + } + my $linkopen = ""; my $linkclose = ""; if ($resource->is_problem() && @@ -1369,7 +1410,6 @@ sub render { # no columns, no nav maps. return ''; } - my $mustCloseNavMap = 0; my $navmap; if (defined($args->{'navmap'})) { $navmap = $args->{'navmap'}; @@ -1418,22 +1458,27 @@ sub render { # Step 1: Check to see if we have a navmap if (!defined($navmap)) { $navmap = Apache::lonnavmaps::navmap->new(); - $mustCloseNavMap = 1; - } + if (!defined($navmap)) { + # no londer in course + return 'No course selected
+ Select a course
'; + } + } # Step two: Locate what kind of here marker is necessary # Determine where the "here" marker is and where the screen jumps to. - if ($env{'form.postsymb'}) { + if ($env{'form.postsymb'} ne '') { $here = $jump = &Apache::lonnet::symbclean($env{'form.postsymb'}); - } elsif ($env{'form.postdata'}) { + } elsif ($env{'form.postdata'} ne '') { # couldn't find a symb, is there a URL? my $currenturl = $env{'form.postdata'}; #$currenturl=~s/^http\:\/\///; #$currenturl=~s/^[^\/]+//; $here = $jump = &Apache::lonnet::symbread($currenturl); - } else { + } + if ($here eq '') { my $last; if (tie(my %hash,'GDBM_File',$env{'request.course.fn'}.'_symb.db', &GDBM_READER(),0640)) { @@ -1482,7 +1527,6 @@ sub render { # Step 1: Check to see if we have a navmap if (!defined($navmap)) { $navmap = Apache::lonnavmaps::navmap->new(); - $mustCloseNavMap = 1; } # See if we're being passed a specific map @@ -1588,11 +1632,7 @@ END my @allres=$navmap->retrieveResources(); foreach my $resource (@allres) { if ($resource->hasDiscussion()) { - my $ressymb = $resource->symb(); - if ($ressymb =~ m-___adm/\w+/\w+/\d+/bulletinboard$-) { - $ressymb = $resource->wrap_symb(); - } - $haveDisc .= $ressymb.':'; + $haveDisc .= $resource->wrap_symb().':'; $totdisc ++; } } @@ -1654,7 +1694,7 @@ END $args->{'condensed'} = 0; my $location= &Apache::loncommon::lonhttpdurl("/adm/lonIcons/whitespace1.gif"); - $args->{'indentString'} = setDefault($args->{'indentString'}, ""); + $args->{'indentString'} = setDefault($args->{'indentString'}, "  "); $args->{'displayedHereMarker'} = 0; # If we're suppressing empty sequences, look for them here. Use DFS for speed, @@ -2116,54 +2156,34 @@ sub generate_course_user_opt { 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.'_'; + my $cdom=$env{'course.'.$cid.'.domain'}; + my $cnum=$env{'course.'.$cid.'.num'}; - my %courserdatas; my %useropt; my %courseopt; my %userrdatas; - unless ($uhome eq 'no_host') { # ------------------------------------------------- Get coursedata (if present) - unless ((time-$courserdatas{$cid.'.last_cache'})<240) { - my $reply=&Apache::lonnet::reply('dump:'.$cdom.':'.$cnum. - ':resourcedata',$chome); - # Check for network failure - if ( $reply =~ /no.such.host/i || $reply =~ /con_lost/i) { - $self->{NETWORK_FAILURE} = 1; - } elsif ($reply!~/^error\:/) { - $courserdatas{$cid}=$reply; - $courserdatas{$cid.'.last_cache'}=time; - } - } - foreach (split(/\&/,$courserdatas{$cid})) { - my ($name,$value)=split(/\=/,$_); - $courseopt{$userprefix.&Apache::lonnet::unescape($name)}= - &Apache::lonnet::unescape($value); + 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); + } + # --------------------------------------------------- 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; - } - # check to see if network failed - elsif ( $reply=~/no.such.host/i || $reply=~/con.*lost/i ) - { - $self->{NETWORK_FAILURE} = 1; - } - } - foreach (split(/\&/,$userrdatas{$uname.'___'.$udom})) { - my ($name,$value)=split(/\=/,$_); - $useropt{$userprefix.&Apache::lonnet::unescape($name)}= - &Apache::lonnet::unescape($value); + + 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; } - $self->{COURSE_OPT} = \%courseopt; - $self->{USER_OPT} = \%useropt; + undef($useropt); } + $self->{COURSE_OPT} = $courseopt; + $self->{USER_OPT} = $useropt; + $self->{COURSE_USER_OPT_GENERATED} = 1; return; @@ -2175,7 +2195,8 @@ sub generate_email_discuss_status { if ($self->{EMAIL_DISCUSS_GENERATED}) { return; } my $cid=$env{'request.course.id'}; - my ($cdom,$cnum)=split(/\_/,$cid); + my $cdom=$env{'course.'.$cid.'.domain'}; + my $cnum=$env{'course.'.$cid.'.num'}; my %emailstatus = &Apache::lonnet::dump('email_status'); my $logoutTime = $emailstatus{'logout'}; @@ -2195,13 +2216,10 @@ sub generate_email_discuss_status { my %feedback=(); my %error=(); - my $keys = &Apache::lonnet::reply('keys:'. - $env{'user.domain'}.':'. - $env{'user.name'}.':nohist_email', - $env{'user.home'}); + my @keys = &Apache::lonnet::getkeys('nohist_email',$env{'user.domain'}, + $env{'user.name'}); - foreach my $msgid (split(/\&/, $keys)) { - $msgid=&Apache::lonnet::unescape($msgid); + foreach my $msgid (@keys) { if ((!$emailstatus{$msgid}) || ($emailstatus{$msgid} eq 'new')) { my $plain= &Apache::lonnet::unescape(&Apache::lonnet::unescape($msgid)); @@ -2285,11 +2303,8 @@ sub hasDiscussion { #return defined($self->{DISCUSSION_TIME}->{$symb}); -# backward compatibility (bulletin boards used to be 'wrapped') - my $ressymb = $symb; - if ($ressymb =~ m-___adm/\w+/\w+/\d+/bulletinboard$-) { - $ressymb = $self->wrap_symb($ressymb); - } + # 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 { @@ -2298,22 +2313,21 @@ sub hasDiscussion { } } -# 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 wrap_symb { - my $self=shift; + my $self = shift; my $symb = shift; - my $ressymb = $symb; - if ($ressymb =~ m-___(adm/\w+/\w+/)(\d+)(/bulletinboard)$-) { - unless ($ressymb =~ m|adm/wrapper/adm|) { - $ressymb = 'bulletin___'.$2.'___adm/wrapper/'.$1.$2.$3; + if ($symb =~ m-___(adm/\w+/\w+/)(\d+)(/bulletinboard)$-) { + unless ($symb =~ m|adm/wrapper/adm|) { + $symb = 'bulletin___'.$2.'___adm/wrapper/'.$1.$2.$3; } } - return $ressymb; + return $symb; } +# 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; @@ -2469,7 +2483,7 @@ sub parmval_real { my $symbparm=$symb.'.'.$what; my $mapparm=$mapname.'___(all).'.$what; - my $usercourseprefix=$uname.'_'.$udom.'_'.$cid; + my $usercourseprefix=$cid; my $seclevel= $usercourseprefix.'.['.$csec.'].'.$what; my $seclevelr=$usercourseprefix.'.['.$csec.'].'.$symbparm; @@ -3530,6 +3544,15 @@ sub shown_symb { 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+)/; @@ -3561,7 +3584,19 @@ sub condition { my $condition=&Apache::lonnet::directcondval($condid); return $condition; } - +sub condval { + my $self=shift; + my $uri=&Apache::lonnet::deversion(&Apache::lonnet::declutter($self->src())); + my ($pathname,$filename)=($uri=~m|(.*)/([^/]*)|); + $pathname=~s/^adm\/wrapper\///; + + 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(); @@ -3627,7 +3662,7 @@ sub is_page { sub is_problem { my $self=shift; my $src = $self->src(); - return ($src =~ /\.(problem|exam|quiz|assess|survey|form|library)$/) + return ($src =~ /\.(problem|exam|quiz|assess|survey|form|library|task)$/) } sub contains_problem { my $self=shift; @@ -3843,6 +3878,10 @@ sub duedate { } return $self->parmval("duedate", $part); } +sub handgrade { + (my $self, my $part) = @_; + return $self->parmval("handgrade", $part); +} sub maxtries { (my $self, my $part) = @_; return $self->parmval("maxtries", $part); @@ -4127,7 +4166,7 @@ sub extractParts { return; } foreach (split(/\,/,$metadata)) { - if ($_ =~ /^part_(.*)$/) { + if ($_ =~ /^(?:part|Task)_(.*)$/) { my $part = $1; # This floods the logs if it blows up if (defined($parts{$part})) { @@ -4392,14 +4431,17 @@ 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', shift); + 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 '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; } @@ -4503,6 +4545,7 @@ An answer has been submitted, but the st sub TRIES_LEFT { return 20; } sub ANSWER_SUBMITTED { return 21; } +sub PARTIALLY_CORRECT{ return 22; } sub status { my $self = shift; @@ -4521,14 +4564,29 @@ sub status { 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->answerdate($part) && $self->answerdate($part) < time()) { + 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 ) { - return $suppressFeedback? ANSWER_SUBMITTED : CORRECT; + 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; + } + + # If it's WRONG... and not open + if ( ($completionStatus == INCORRECT || + $completionStatus == INCORRECT_BY_OVERRIDE) + && (!$self->opendate($part) || $self->opendate($part) > time()) ) { + return INCORRECT; } if ($completionStatus == ATTEMPTED) { @@ -4615,6 +4673,7 @@ 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, @@ -4735,7 +4794,7 @@ sub getNext { my $to = $self->to(); foreach my $branch ( split(/,/, $to) ) { my $choice = $self->{NAV_MAP}->getById($branch); - if (!$choice->condition()) { next; } + #if (!$choice->condition()) { next; } my $next = $choice->goesto(); $next = $self->{NAV_MAP}->getById($next);