--- loncom/interface/lonwhatsnew.pm 2005/04/18 20:35:07 1.11 +++ loncom/interface/lonwhatsnew.pm 2005/10/10 13:36:35 1.32 @@ -1,5 +1,5 @@ # -# $Id: lonwhatsnew.pm,v 1.11 2005/04/18 20:35:07 raeburn Exp $ +# $Id: lonwhatsnew.pm,v 1.32 2005/10/10 13:36:35 raeburn Exp $ # # Copyright Michigan State University Board of Trustees # @@ -35,8 +35,10 @@ use Apache::lonhtmlcommon(); use Apache::lonlocal; use Apache::loncoursedata(); use Apache::lonnavmaps(); +use Apache::lonuserstate; use Apache::Constants qw(:common :http); use Time::Local; +use GDBM_File; #---------------------------- # handler @@ -52,10 +54,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 +73,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 +100,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 +151,7 @@ ENDHEAD #------------------------------- sub display_actions_box() { - my ($r,$picker) = @_; + my ($r,$command,$threshold_titles,$cdom,$crs) = @_; my $rowColor1 = "#ffffff"; my $rowColor2 = "#eeeeee"; @@ -171,6 +167,7 @@ sub display_actions_box() { my @tograde = (); my @bombs = (); my @warnings = (); + my %res_title = (); my $domain=&Apache::loncommon::determinedomain(); my $function; @@ -181,18 +178,43 @@ 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,\%triggered,\@newdiscussions,\@tograde,\@bombs,\@warnings,$rowColor1,$rowColor2); - 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; } + if (tie(my %bighash,'GDBM_File',$env{'request.course.fn'}.'.db', + &GDBM_READER(),0640)) { + my $furl=$bighash{'first_url'}; + $r->print('Go to first resource
Change your preferences to suppress display of this screen when accessing courses as Course Coordinator in the future.
'); + untie(%bighash); + } + + my $result; + + if ($command eq 'reset') { + $result = &process_reset($cdom,$crs); + } elsif ($command eq 'update') { + $result = &process_update($cdom,$crs,$threshold_titles); + } + if ($result) { + $r->print($result.'
'); + } + $r->rflush(); + + &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(''.$picker.'
'); + $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 { @@ -258,25 +281,30 @@ END $r->print('
'); ## UNGRADED ITEMS ## $r->print(< 0) { -# @bombs = sort { &cmp_title($a,$b) } @bombs; + $r->print('
ResourceNumber of errors
'.$bombed{$bomb}{errorlink}.'
'.$bombed{$bomb}{errorlink}.''.$bombed{$bomb}{errorcount}.'

'); # DEGDIFF AND AV. TRIES TRIGGERS - $r->print(<<"END"); + $r->print(<<"END");
- + + + +
Problems with average attempts > 0 or degree of difficulty > 0Problems 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) } @warnings; - $r->print(''); + 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; + $rowColor = $rowColor1; } else { $rowColor = $rowColor2; } @@ -290,8 +318,9 @@ END $r->print(''.$triggered{$res}{text}); $warningnum ++; } + $r->print(''); + $r->print(''); } $r->print('
ResourcePartNum. studentsAv. AttemptsDeg. Diff
ResourcePartNum. studentsAv. AttemptsDeg. DiffLast ResetReset Count?
'.$triggered{$res}{title}.'

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

No problems with av. attempts or degree of difficulty above thresholds


No problems satisfy threshold criteria.


'); @@ -312,7 +341,7 @@ END if (@newdiscussions > 0) { $r->print('LocationTypeNumber of new posts'); -# @newdiscussions = sort { &cmp_title($a,$b) } @newdiscussions; + @newdiscussions = sort { &cmp_title($a,$b,\%res_title) } @newdiscussions; my $rowNum = 0; foreach my $ressymb (@newdiscussions) { my $forum_title = $unread{$ressymb}{'title'}; @@ -361,7 +390,7 @@ END } else { $rowColor = $rowColor2; } - $r->print(''.$mailcount.'.  '.$msg->{'shortsub'}.'    '.$msg->{'from'}.'@'.$msg->{'fromdom'}.' '.$msg->{'sendtime'}.''); + $r->print(''.$mailcount.'.  '.$msg->{'shortsub'}.'    '.$msg->{'from'}.'@'.$msg->{'fromdom'}.' '.$msg->{'sendtime'}.''); $rowNum ++; $mailcount ++; } @@ -393,7 +422,7 @@ END } else { $rowColor = $rowColor2; } - $r->print(''.$mailcount.'.  '.$msg->{'shortsub'}.'    '.$msg->{'from'}.'@'.$msg->{'fromdom'}.' '.$msg->{'sendtime'}.''); + $r->print(''.$mailcount.'.  '.$msg->{'shortsub'}.'    '.$msg->{'from'}.'@'.$msg->{'fromdom'}.' '.$msg->{'sendtime'}.''); $rowNum ++; $mailcount ++; } @@ -414,33 +443,82 @@ END #------------------------------- # display_config_box # -# Display the action items +# Display the threshold setting screen # #------------------------------- sub display_config_box() { - my ($r,$picker) = @_; - $r->print(''.$picker.'
'); + 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} ++; } @@ -587,6 +688,86 @@ sub getitems { } } +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.'').'
'; + } + } + } + return $setoutput; +} + sub getmail { my ($newmsgs,$critmsgs) = @_; # Check for unread mail in course @@ -649,7 +830,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;
+ + +
+ + +
+ + + + + + '); + 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,$triggered,$newdiscussions,$tograde,$bombs,$warnings,$rowColor1,$rowColor2) = @_; + 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'); + # force retrieve Resource to seed the part id cache we'll need it later + my @allres=$navmap->retrieveResources(undef,sub {if ($_[0]->is_problem) { $_[0]->parts();} return 1;}); + 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', - $env{'course.'.$env{'request.course.id'}.'.domain'}, - $env{'course.'.$env{'request.course.id'}.'.num'}); - - my $diffcheck = 0; - my $triescheck = 0; + $cdom,$crs); my $warningnum = 0; foreach my $key (keys(%lastread)) { my $newkey = $key; @@ -451,14 +529,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; @@ -468,9 +547,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\./)) { @@ -488,57 +566,71 @@ 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=$resource->parts(); + my $handgradeable; + foreach my $part (@$partlist) { + if ($resource->handgrade($part) 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 +# Compile maxtries and degree of difficulty for problem parts, unless handgradeable my @parts = @{$resource->parts()}; - my %stats = (); + my %stats; + my %lastreset = (); my $warning = 0; my $rowColor; - foreach (@parts) { - %{$stats{$_}} = (); + foreach my $part (@parts) { + if ($resource->handgrade($part) eq 'yes') { + next; + } + %{$stats{$part}} = (); my ($attempts,$users,$corrects,$degdiff,$av_attempts); - if (exists($resourcetracker{$symb.'_'.$_.'_attempts'})) { - $attempts = $resourcetracker{$symb.'_'.$_.'_attempts'}; + if (exists($resourcetracker{$symb."\0".$part."\0attempts"})) { + $attempts = $resourcetracker{$symb."\0".$part."\0attempts"}; } - if (exists($resourcetracker{$symb.'_'.$_.'_users'})) { - $users = $resourcetracker{$symb.'_'.$_.'_users'}; + if (exists($resourcetracker{$symb."\0".$part."\0users"})) { + $users = $resourcetracker{$symb."\0".$part."\0users"}; } - if (exists($resourcetracker{$symb.'_'.$_.'_correct'})) { - $corrects = $resourcetracker{$symb.'_'.$_.'_correct'}; + if (exists($resourcetracker{$symb."\0".$part."\0correct"})) { + $corrects = $resourcetracker{$symb."\0".$part."\0correct"}; } if ($attempts > 0) { $degdiff = 1 - ($corrects/$attempts); @@ -546,11 +638,16 @@ sub getitems { } if ($users > 0) { $av_attempts = $attempts/$users; + $av_attempts = sprintf("%.2f",$av_attempts); } - if (($degdiff ne '' && $degdiff >= $diffcheck) || ($av_attempts ne '' && $av_attempts >= $triescheck)) { - $stats{$_}{degdiff} = $degdiff; - $stats{$_}{attempts} = $av_attempts; - $stats{$_}{users} = $users; + 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"}; + if ($lastreset{$part}) { + $lastreset{$part} = &Apache::lonnavmaps::timeToHumanString($lastreset{$part}); + } $warning = 1; } } @@ -561,22 +658,26 @@ sub getitems { $rowColor = $rowColor2; } $$triggered{$symb}{title} = $resource->title; - foreach (@parts) { - if (exists($stats{$_}{users})) { + 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 - '.$part.'single part'.$stats{$_}{users}.''.$stats{$_}{attempts}.''.$stats{$_}{degdiff}.''.$stats{$part}{users}.''.$stats{$part}{attempts}.''.$stats{$part}{degdiff}.''.$lastreset{$part}.'