--- loncom/interface/lonnavmaps.pm 2005/04/11 12:20:22 1.321
+++ loncom/interface/lonnavmaps.pm 2005/08/02 20:51:18 1.335
@@ -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.335 2005/08/02 20:51:18 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,7 +82,8 @@ 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
@@ -206,6 +208,20 @@ ENDSUBM
if ($ENV{QUERY_STRING} eq 'launchExternal') {
&Apache::lonnet::put('environment',{'remotenavmap' => 'on'});
&Apache::lonnet::appenv('environment.remotenavmap' => 'on');
+ my $menu=&Apache::lonmenu::reopenmenu();
+ my $navstatus=&Apache::lonmenu::get_nav_status();
+ if ($menu) {
+ $r->print(<
');
$r->print('
@@ -507,7 +523,7 @@ sub getDescription {
if ($status == $res->PAST_DUE_NO_ANSWER) {
return &mt("Was due")." " . timeToHumanString($res->duedate($part));
}
- if ($status == $res->ANSWER_OPEN) {
+ if ($status == $res->ANSWER_OPEN || $status == $res->PARTIALLY_CORRECT) {
return &mt("Answer available");
}
if ($status == $res->EXCUSED) {
@@ -658,7 +674,7 @@ 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;
}
@@ -1039,7 +1055,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 = "
";
}
# links to open and close the folder
@@ -1051,16 +1067,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 +1091,8 @@ sub render_resource {
if (!$params->{'resource_no_folder_link'}) {
$icon = "navmap.$folderType." . ($nowOpen ? 'closed' : 'open') . '.gif';
- $icon = "
";
+ $icon = "
";
$linkopen = "{'queryString'} . '&filter=';
@@ -1093,7 +1110,8 @@ sub render_resource {
# Don't allow users to manipulate folder
$icon = "navmap.$folderType." . ($nowOpen ? 'closed' : 'open') .
'.nomanip.gif';
- $icon = "
";
+ $icon = "
";
$linkopen = "";
$linkclose = "";
@@ -1160,7 +1178,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 +1195,7 @@ sub render_communication_status {
my $feedback = $resource->getFeedback();
foreach (split(/\,/, $feedback)) {
if ($_) {
- $feedbackHTML .= ' '
. '
';
@@ -1188,7 +1210,7 @@ sub render_communication_status {
last if ($errorcount>=10); # Only output 10 bombs maximum
if ($_) {
$errorcount++;
- $errorHTML .= ' '
. '
';
@@ -1210,7 +1232,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() &&
@@ -1424,16 +1450,17 @@ sub render {
# 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)) {
@@ -1588,11 +1615,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 +1677,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 +2139,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 $cdom=$env{'course.'.$cid.'.domain'};
+ my $cnum=$env{'course.'.$cid.'.num'};
- my $userprefix=$uname.'_'.$udom.'_';
-
- 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 +2178,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 +2199,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 +2286,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 +2296,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 +2466,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 +3527,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+)/;
@@ -3843,6 +3849,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);
@@ -4392,14 +4402,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 +4516,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 +4535,22 @@ 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 ($completionStatus == ATTEMPTED) {
@@ -4615,6 +4637,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,