--- loncom/interface/lonwhatsnew.pm 2005/04/11 21:51:43 1.10 +++ loncom/interface/lonwhatsnew.pm 2005/07/10 02:31:30 1.23 @@ -1,5 +1,5 @@ # -# $Id: lonwhatsnew.pm,v 1.10 2005/04/11 21:51:43 raeburn Exp $ +# $Id: lonwhatsnew.pm,v 1.23 2005/07/10 02:31:30 albertel Exp $ # # Copyright Michigan State University Board of Trustees # @@ -35,6 +35,7 @@ use Apache::lonhtmlcommon(); use Apache::lonlocal; use Apache::loncoursedata(); use Apache::lonnavmaps(); +use Apache::lonuserstate; use Apache::Constants qw(:common :http); use Time::Local; @@ -52,10 +53,13 @@ sub handler { } &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},['command']); - my $command = $env{'form.command'}; - - if ($command eq '') { - $command = "info"; + my $command; + if ($env{'form.action'} eq 'reset') { + $command = 'reset'; + } elsif ($env{'form.action'} eq 'update') { + $command = 'update'; + } else { + $command = $env{'form.command'}; } &Apache::loncommon::content_type($r,'text/html'); @@ -68,20 +72,21 @@ sub handler { } &Apache::lonhtmlcommon::clear_breadcrumbs(); - if ($command eq 'config') { + if ($command eq 'chgthreshold') { &Apache::lonhtmlcommon::add_breadcrumb - ({href=>'/adm/whatsnew?command=config', - text=>"Configure display"}); + ({href=>'/adm/whatsnew?command=threshold', + text=>"Change thresholds"}); $r->print(&Apache::lonhtmlcommon::breadcrumbs - (undef,'Course Action Items','Course_Action_Items_Config')); + (undef,'Course Action Items','Course_Action_Items_Thresholds')); } else { &Apache::lonhtmlcommon::add_breadcrumb - ({href=>'/adm/whatsnew?command=info', + ({href=>'/adm/whatsnew', text=>"Display Action Items"}); $r->print(&Apache::lonhtmlcommon::breadcrumbs (undef,'Course Action Items','Course_Action_Items_Display')); } &display_main_box($r,$command); + return OK; } #------------------------------ @@ -94,30 +99,20 @@ sub display_main_box { my ($r,$command) = @_; my $domain=&Apache::loncommon::determinedomain(); my $tabbg=&Apache::loncommon::designparm('coordinator.tabbg',$domain); - my $selconfig; - my $selinfo; - if ($command eq 'config') { - $selinfo = 'selected="selected"'; - } else { - $selconfig = 'selected="selected"'; - } - my $picker = (' -
- - - - -
'); - $r->print('
'); - - if ($command eq 'config') { - &display_config_box($r,$picker); + + my %threshold_titles = ( + av_attempts => 'Average number of attempts', + degdiff => 'Degree of difficulty', + numstudents => 'Total number of students with submissions', + ); + my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'}; + my $crs = $env{'course.'.$env{'request.course.id'}.'.num'}; + + if ($command eq 'chgthreshold') { + &display_config_box($r,$command,$tabbg,\%threshold_titles,$cdom,$crs); } else { - &display_actions_box($r,$picker); + &display_actions_box($r,$command,\%threshold_titles,$cdom,$crs); } $r->print(< @@ -155,7 +150,7 @@ ENDHEAD #------------------------------- sub display_actions_box() { - my ($r,$picker) = @_; + my ($r,$command,$threshold_titles,$cdom,$crs) = @_; my $rowColor1 = "#ffffff"; my $rowColor2 = "#eeeeee"; @@ -164,11 +159,14 @@ sub display_actions_box() { my %unread = (); my %ungraded = (); my %bombed = (); + my %triggered = (); my @newmsgs = (); my @critmsgs = (); my @newdiscussions = (); my @tograde = (); my @bombs = (); + my @warnings = (); + my %res_title = (); my $domain=&Apache::loncommon::determinedomain(); my $function; @@ -179,59 +177,40 @@ sub display_actions_box() { $function='admin'; } + my %threshold = ( + av_attempts => 2, + degdiff => 0.5, + numstudents => 2, + ); + my $pgbg=&Apache::loncommon::designparm($function.'.pgbg',$domain); my $tabbg=&Apache::loncommon::designparm($function.'.tabbg',$domain); - &getitems(\%unread,\%ungraded,\%bombed,\@newdiscussions,\@tograde,\@bombs); - my ($msgcount,$critmsgcount) = &getmail(\@newmsgs,\@critmsgs); - unless ($env{'request.course.id'}) { - $r->print('
You are accessing an invalid course


'); + $r->print('
You are accessing an invalid course.


'); return; } - $r->print(''.$picker.'
'); + $r->print(''); $rowNum ++; $mailcount ++; } @@ -371,18 +436,85 @@ END $r->print('
'); + my ($furl,$ferr)= + &Apache::lonuserstate::readmap($cdom.'/'.$crs); + $r->print('Go to first resource
Change your preferences to suppress display of this screen when accessing courses as Course Coordinator in the future.
'); -## UNREAD COURSE DISCUSSION POSTS ## - $r->print(<<"END"); - -
- - - - - -
Unread course discussion posts:
- -END + my $result; - if (@newdiscussions > 0) { - $r->print(''); -# @newdiscussions = sort { &cmp_title($a,$b) } @newdiscussions; - my $rowNum = 0; - foreach my $ressymb (@newdiscussions) { - my $forum_title = $unread{$ressymb}{'title'}; - my $type = 'Resource'; - my $feedurl=&Apache::lonfeedback::get_feedurl($ressymb); - if ($feedurl =~ /bulletinboard/) { - $type = 'Bulletin Board'; - } - my $unreadnum = keys(%{$unread{$ressymb}}); - $unreadnum = $unreadnum - 2; - if ($unreadnum > 0) { - if ($rowNum %2 == 1) { - $rowColor = $rowColor1; - } else { - $rowColor = $rowColor2; - } - $r->print(''); - $rowNum ++; - } - } - } else { - $r->print(''); + if ($command eq 'reset') { + $result = &process_reset($cdom,$crs); + } elsif ($command eq 'update') { + $result = &process_update($cdom,$crs,$threshold_titles); } - $r->print('
LocationTypeNumber of new posts
'.$forum_title.': '.$type.''.$unreadnum.' 

 No unread posts in course discussions


'); + if ($result) { + $r->print($result.'
'); + } + + &get_curr_thresholds(\%threshold,$cdom,$crs); + &getitems(\%unread,\%ungraded,\%bombed,\%triggered,\@newdiscussions,\@tograde,\@bombs,\@warnings,$rowColor1,$rowColor2,\%threshold,$cdom,$crs,%res_title); + my ($msgcount,$critmsgcount) = &getmail(\@newmsgs,\@critmsgs); + + $r->print('
'); ## UNGRADED ITEMS ## $r->print(< - +
Problems requiring handgrading:
Problems requiring handgrading
@@ -281,14 +260,15 @@ END END my $bombnum = 0; if (@bombs > 0) { -# @bombs = sort { &cmp_title($a,$b) } @bombs; + $r->print(''); + @bombs = sort { &cmp_title($a,$b,\%res_title) } @bombs; foreach my $bomb (@bombs) { if ($bombnum %2 == 1) { - $rowColor = $rowColor1; + $rowColor = $rowColor1; } else { $rowColor = $rowColor2; } - $r->print(''); + $r->print(''); $bombnum ++; } } else { @@ -296,8 +276,93 @@ END } $r->print('
ResourceNumber of errors
'.$bombed{$bomb}{errorlink}.'
'.$bombed{$bomb}{errorlink}.''.$bombed{$bomb}{errorcount}.'

'); +# DEGDIFF AND AV. TRIES TRIGGERS + $r->print(<<"END"); + + +
+ + + + + + + + +
Problems with av. attempts ≥ $threshold{'av_attempts'} or deg. difficulty ≥ $threshold{'degdiff'}
and total number of students with submissions ≥ $threshold{'numstudents'}
Change thresholds?
+ +END + my $warningnum = 0; + if (@warnings > 0) { + @warnings = sort { &cmp_title($a,$b,\%res_title) } @warnings; + $r->print(''. + ' '."\n"); + $r->print(''); + foreach my $res (@warnings) { + if ($warningnum %2 == 1) { + $rowColor = $rowColor1; + } else { + $rowColor = $rowColor2; + } + my ($map,$id,$url)=&Apache::lonnet::decode_symb($res); + my $linkurl=&Apache::lonnet::clutter($url); + my $rowspan; + if ($triggered{$res}{numparts} > 1) { + $rowspan = 'rowspan="'.$triggered{$res}{numparts}.'"'; + } + $linkurl .= '?symb='.&Apache::lonnet::escape($res); + $r->print(''.$triggered{$res}{text}); + $warningnum ++; + } + $r->print(''); + } + $r->print('
ResourcePartNum. studentsAv. AttemptsDeg. DiffLast ResetReset Count?
'.$triggered{$res}{title}.'

'); + } else { + $r->print('

No problems satisfy threshold criteria.


'); + $r->print('		 '); +## UNREAD COURSE DISCUSSION POSTS ## + $r->print(<<"END"); + +
+ + + + + +
Unread course discussion posts
+ +END + + if (@newdiscussions > 0) { + $r->print(''); + @newdiscussions = sort { &cmp_title($a,$b,\%res_title) } @newdiscussions; + my $rowNum = 0; + foreach my $ressymb (@newdiscussions) { + my $forum_title = $unread{$ressymb}{'title'}; + my $type = 'Resource'; + my $feedurl=&Apache::lonfeedback::get_feedurl($ressymb); + if ($feedurl =~ /bulletinboard/) { + $type = 'Bulletin Board'; + } + my $unreadnum = keys(%{$unread{$ressymb}}); + $unreadnum = $unreadnum - 2; + if ($unreadnum > 0) { + if ($rowNum %2 == 1) { + $rowColor = $rowColor1; + } else { + $rowColor = $rowColor2; + } + $r->print(''); + $rowNum ++; + } + } + } else { + $r->print(''); + } + $r->print('
LocationTypeNumber of new posts
'.$forum_title.' '.$type.''.$unreadnum.' 

 No unread posts in course discussions


'); + ## MESSAGES ## $r->print(< @@ -321,7 +386,7 @@ END } else { $rowColor = $rowColor2; } - $r->print('
'.$mailcount.'.  '.$msg->{'shortsub'}.'    '.$msg->{'from'}.'@'.$msg->{'fromdom'}.' '.$msg->{'sendtime'}.'
'.$mailcount.'.  '.$msg->{'shortsub'}.'    '.$msg->{'from'}.'@'.$msg->{'fromdom'}.' '.$msg->{'sendtime'}.'
'); } +#------------------------------- +# display_config_box +# +# Display the threshold setting screen +# +#------------------------------- + +sub display_config_box() { + my ($r,$command,$tabbg,$threshold_titles,$cdom,$crs) = @_; + my %threshold = (); + my $rowColor1 = "#ffffff"; + my $rowColor2 = "#eeeeee"; + my $rowColor; + + my @thresholditems = ("av_attempts","degdiff","numstudents"); + my %threshold_titles = ( + av_attempts => 'Average number of attempts', + degdiff => 'Degree of difficulty', + numstudents => 'Total number of students with submissions', + ); + &get_curr_thresholds(\%threshold,$cdom,$crs); + + $r->print('
'."\n"; + } + if (@parts > 1) { + $$triggered{$symb}{text} .= ' + '; + } else { + $$triggered{$symb}{text} .= ' + '; + } + $$triggered{$symb}{text} .= ' + + + + + + '; + $$triggered{$symb}{numparts} ++; + } + } + push(@{$warnings},$symb); + $warningnum ++; + } + } +} + +sub get_curr_thresholds { + my ($threshold,$cdom,$crs) = @_; + my %coursesettings = &Apache::lonnet::dump('environment', + $cdom,$crs,'internal.threshold'); + if (exists($coursesettings{'internal.threshold_av_attempts'})) { + $$threshold{'av_attempts'} = $coursesettings{'internal.threshold_av_attempts'}; + } + if (exists($coursesettings{'internal.threshold_degdiff'})) { + $$threshold{'degdiff'} = $coursesettings{'internal.threshold_degdiff'}; + } + if (exists($coursesettings{'internal.threshold_numstudents'})) { + $$threshold{'numstudents'} = $coursesettings{'internal.threshold_numstudents'}; + } +} + +sub process_reset { + my ($dom,$crs) = @_; + my $result = 'Counters reset for following problems (and parts):
'; + my @agg_types = ('attempts','users','correct'); + my %agg_titles = ( + attempts => 'Number of submissions', + users => 'Students with submissions', + correct => 'Number of correct submissions', + ); + my @resets = (); + my %titles = (); + foreach my $key (keys(%env)) { + next if ($key !~ /^form\.reset_(.+)$/); + my $title = &Apache::lonnet::unescape($env{'form.title_'.$1}); + my $reset_item = &Apache::lonnet::unescape($1); + my %curr_aggregates = &Apache::lonnet::dump('nohist_resourcetracker',$dom,$crs,$reset_item); + my %aggregates = (); + my ($symb,$part) = split(/\0/,$reset_item); + foreach my $type (@agg_types) { + $aggregates{$reset_item."\0".$type} = 0; + } + $aggregates{$reset_item."\0".'resettime'} = time; + my $putresult = &Apache::lonnet::put('nohist_resourcetracker',\%aggregates, + $dom,$crs); + if ($putresult eq 'ok') { + $result .= $title.' -part '.$part.': '; + my %new_aggregates = &Apache::lonnet::dump('nohist_resourcetracker',$dom,$crs,$reset_item); + foreach my $type (@agg_types) { + $result .= $agg_titles{$type}.' = '.$new_aggregates{$reset_item."\0".$type}.'; '; + } + $result =~ s/; $//; + $result .= '
'; + } else { + $result = $title.' -part '.$part.': '.&mt('Unable to reset counters to zero due to [_1]',$putresult).'.
'."\n"; + } + } + return $result; +} + +sub process_update { + my ($dom,$crs,$threshold_titles) = @_; + my $setoutput = 'Changes to threshold(s) for problem tracking:
'; + foreach (keys %env) { + next if ($_!~/^form\.(.+)\_setparmval$/); + my $name = $1; + my $value = $env{'form.'.$name.'_value'}; + if ($name && defined($value)) { + my $put_result = &Apache::lonnet::put('environment', + {$name=>$value},$dom,$crs); + + my ($shortname) = ($name =~ /^internal\.threshold_(.+)$/); + if ($put_result eq 'ok') { + $setoutput.=&mt('Set threshold for [_1] to [_2]', + ''.$$threshold_titles{$shortname}.'', + ''.$value.'').'
'; + } else { + $setoutput.=&mt('Unable to set threshold for [_1] to [_2] due to [_3].', + ''.$name.'',''.$value.'', + ''.$put_result.'').'
'; + } + } } -# Compile maxtries and degree of difficulty. + return $setoutput; } sub getmail { @@ -528,7 +818,8 @@ sub getmail { } sub cmp_title { - my ($atitle,$btitle) = (lc($_[0]->compTitle),lc($_[1]->compTitle)); + my ($a,$b,$res_title) = @_; + my ($atitle,$btitle) = (lc($$res_title{$a}),lc($$res_title{$b})); $atitle=~s/^\s*//; $btitle=~s/^\s*//; return $atitle cmp $btitle; 500 Internal Server Error

Internal Server Error

The server encountered an internal error or misconfiguration and was unable to complete your request.

Please contact the server administrator at root@localhost to inform them of the time this error occurred, and the actions you performed just before this error.

More information about this error may be available in the server error log.

+ + +
+ + +
+ + + + + + '); + my $rowNum =0; + foreach my $type (@thresholditems) { + my $parameter = 'internal.threshold_'.$type; +# onchange is javascript to automatically check the 'Set' button. + my $onchange = 'onFocus="javascript:window.document.forms'. + "['thresholdform'].elements['".$parameter."_setparmval']". + '.checked=true;"'; + if ($rowNum %2 == 1) { + $rowColor = $rowColor1; + } else { + $rowColor = $rowColor2; + } + $r->print(' + + + + + '); + $rowNum ++; + } + $r->print('
Threshold NameCurrent valueChange?
'.$threshold_titles{$type}.''.&Apache::lonhtmlcommon::textbox($parameter.'_value', + $threshold{$type}, + 10,$onchange).'' + .&Apache::lonhtmlcommon::checkbox($parameter.'_setparmval'). + '
+
+ + '); +} + sub getitems { - my ($unread,$ungraded,$bombed,$newdiscussions,$tograde,$bombs) = @_; + my ($unread,$ungraded,$bombed,$triggered,$newdiscussions,$tograde,$bombs,$warnings,$rowColor1,$rowColor2,$threshold,$cdom,$crs,$res_title) = @_; my $navmap = Apache::lonnavmaps::navmap->new(); my @allres=$navmap->retrieveResources(); - my %discussiontime = &Apache::lonnet::dump('discussiontimes', - $env{'course.'.$env{'request.course.id'}.'.domain'}, - $env{'course.'.$env{'request.course.id'}.'.num'}); - my %lastread = &Apache::lonnet::dump('nohist_'.$env{'request.course.id'}.'_discuss',$env{'user.domain'},$env{'user.name'},'lastread'); + my %discussiontime = &Apache::lonnet::dump('discussiontimes',$cdom,$crs); + my %lastread = &Apache::lonnet::dump('nohist_'.$env{'request.course.id'}. + '_discuss',$env{'user.domain'},$env{'user.name'},'lastread'); my %lastreadtime = (); my @discussions = (); my ($classlist,$keylist) = &Apache::loncoursedata::get_classlist(); + my %resourcetracker = &Apache::lonnet::dump('nohist_resourcetracker', + $cdom,$crs); + my $warningnum = 0; foreach my $key (keys(%lastread)) { my $newkey = $key; $newkey =~ s/_lastread$//; @@ -392,12 +524,15 @@ sub getitems { my $result = ''; my $applies = 0; my $symb = $resource->symb(); - %{$$bombed{$symb}} = (); +# %{$$bombed{$symb}} = (); %{$$ungraded{$symb}} = (); + %{$$triggered{$symb}} = (); + $$triggered{$symb}{numparts} = 0; my $title = $resource->compTitle(); + $$res_title{$symb} = $title; my $ressymb = $resource->wrap_symb(); # Check for unread discussion postings - if (defined($discussiontime{$ressymb})) { + if ($resource->hasDiscussion()) { push(@discussions,$ressymb); my $prevread = 0; my $unreadcount = 0; @@ -407,9 +542,8 @@ sub getitems { if (defined($lastreadtime{$ressymb})) { $prevread = $lastreadtime{$ressymb}; } - my %contrib = &Apache::lonnet::restore($ressymb,$env{'request.course.id'}, - $env{'course.'.$env{'request.course.id'}.'.domain'}, - $env{'course.'.$env{'request.course.id'}.'.num'}); + my %contrib = &Apache::lonnet::restore($ressymb, + $env{'request.course.id'},$cdom,$crs); if ($contrib{'version'}) { for (my $id=1;$id<=$contrib{'version'};$id++) { unless (($contrib{'hidden'}=~/\.$id\./) || ($contrib{'deleted'}=~/\.$id\./)) { @@ -427,43 +561,199 @@ sub getitems { if ($resource->is_problem()) { my $ctr = 0; my ($map,$ind,$url)=&Apache::lonnet::decode_symb($symb); - my ($partlist,$handgrade,$responseType) = &Apache::grades::response_type($url,$symb); - foreach my $student (keys(%$classlist)) { - my ($uname,$udom) = split(/:/,$student); - my %status=&Apache::grades::student_gradeStatus($url,$symb,$udom,$uname,$partlist); - my $submitted = 0; - my $ungraded = 0; - foreach (keys(%status)) { - $submitted = 1 if ($status{$_} ne 'nothing'); - $ungraded = 1 if ($status{$_} =~ /^ungraded/); - my ($foo,$partid,$foo1) = split(/\./,$_); - if ($status{'resource.'.$partid.'.submitted_by'} ne '') { - $submitted = 0; - } - } - next if (!$submitted || !$ungraded); - $ctr ++; - } - if ($ctr) { - $$ungraded{$symb}{count} = $ctr; - $$ungraded{$symb}{title} = $title; - push(@{$tograde}, $symb); - } + my ($partlist,$handgrade,$responseType) = + &Apache::grades::response_type($url,$symb); + my $handgradeable; + foreach my $value (values(%{$handgrade})) { + if ($value eq 'yes') { $handgradeable=1; last; } + } + if ($handgradeable) { + foreach my $student (keys(%$classlist)) { + my ($uname,$udom) = split(/:/,$student); + my %status=&Apache::grades::student_gradeStatus($url,$symb,$udom,$uname,$partlist); + my $submitted = 0; + my $ungraded = 0; + foreach (keys(%status)) { + $submitted = 1 if ($status{$_} ne 'nothing'); + $ungraded = 1 if ($status{$_} =~ /^ungraded/); + my ($foo,$partid,$foo1) = split(/\./,$_); + if ($status{'resource.'.$partid.'.submitted_by'} ne '') { + $submitted = 0; + } + } + next if (!$submitted || !$ungraded); + $ctr ++; + } + if ($ctr) { + $$ungraded{$symb}{count} = $ctr; + $$ungraded{$symb}{title} = $title; + push(@{$tograde}, $symb); + } + } } # Check for bombs if ($resource->getErrors()) { my $errors = $resource->getErrors(); + $errors =~ s/^,//; my @bombs = split(/,/, $errors); my $errorcount = scalar(@bombs); my $errorlink = ''; + &Apache::lonnet::escape($bombs[0]).'">'. + $title.''; $$bombed{$symb}{errorcount} = $errorcount; $$bombed{$symb}{errorlink} = $errorlink; push(@{$bombs}, $symb); } +# Compile maxtries and degree of difficulty for problem parts + my @parts = @{$resource->parts()}; + my %stats; + my %lastreset = (); + my $warning = 0; + my $rowColor; + foreach my $part (@parts) { + %{$stats{$part}} = (); + my ($attempts,$users,$corrects,$degdiff,$av_attempts); + if (exists($resourcetracker{$symb."\0".$part."\0attempts"})) { + $attempts = $resourcetracker{$symb."\0".$part."\0attempts"}; + } + if (exists($resourcetracker{$symb."\0".$part."\0users"})) { + $users = $resourcetracker{$symb."\0".$part."\0users"}; + } + if (exists($resourcetracker{$symb."\0".$part."\0correct"})) { + $corrects = $resourcetracker{$symb."\0".$part."\0correct"}; + } + if ($attempts > 0) { + $degdiff = 1 - ($corrects/$attempts); + $degdiff = sprintf("%.2f",$degdiff); + } + if ($users > 0) { + $av_attempts = $attempts/$users; + $av_attempts = sprintf("%.2f",$av_attempts); + } + if ((($degdiff ne '' && $degdiff >= $$threshold{'degdiff'}) || ($av_attempts ne '' && $av_attempts >= $$threshold{'av_attempts'})) && ($users >= $$threshold{'numstudents'})) { + $stats{$part}{degdiff} = $degdiff; + $stats{$part}{attempts} = $av_attempts; + $stats{$part}{users} = $users; + $lastreset{$part} = $resourcetracker{$symb."\0".$part."\0resettime"}; + $warning = 1; + } + } + if ($warning) { + if ($warningnum %2 == 1) { + $rowColor = $rowColor1; + } else { + $rowColor = $rowColor2; + } + $$triggered{$symb}{title} = $resource->title; + foreach my $part (@parts) { + if (exists($stats{$part}{users})) { + my $resetname = 'reset_'.&Apache::lonnet::escape($symb."\0".$part); + my $resettitle = 'title_'.&Apache::lonnet::escape($symb."\0".$part); + if ($$triggered{$symb}{numparts}) { + $$triggered{$symb}{text} .= '
part - '.$part.'single part'.$stats{$part}{users}.''.$stats{$part}{attempts}.''.$stats{$part}{degdiff}.''.$lastreset{$part}.'