--- loncom/interface/lonwhatsnew.pm 2005/04/05 22:49:17 1.1 +++ loncom/interface/lonwhatsnew.pm 2005/12/02 23:17:47 1.33 @@ -1,15 +1,44 @@ +# +# $Id: lonwhatsnew.pm,v 1.33 2005/12/02 23:17:47 raeburn Exp $ +# +# Copyright Michigan State University Board of Trustees +# +# This file is part of the LearningOnline Network with CAPA (LON-CAPA). +# +# LON-CAPA is free software; you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation; either version 2 of the License, or +# (at your option) any later version. +# +# LON-CAPA is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with LON-CAPA; if not, write to the Free Software +# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA +# +# /home/httpd/html/adm/gpl.txt +# +# http://www.lon-capa.org/ +# + + package Apache::lonwhatsnew; use strict; use lib qw(/home/httpd/lib/perl); use Apache::lonnet; -use Apache::loncommon; -use Apache::lonhtmlcommon; +use Apache::loncommon(); +use Apache::lonhtmlcommon(); use Apache::lonlocal; -use Apache::loncoursedata; -use Apache::lonnavmaps; +use Apache::loncoursedata(); +use Apache::lonnavmaps(); +use Apache::lonuserstate; use Apache::Constants qw(:common :http); use Time::Local; +use GDBM_File; #---------------------------- # handler @@ -18,22 +47,47 @@ use Time::Local; sub handler { my $r = shift; + if ($r->header_only) { + &Apache::loncommon::content_type($r,'text/html'); + $r->send_http_header; + return OK; + } &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'}; } - $r->print(&display_header()); - if (! (($ENV{'request.course.fn'}) && (&Apache::lonnet::allowed('vsa',$ENV{'request.course.id'})))) { - # Not in a course, or not allowed to modify parms - $ENV{'user.error.msg'}="/adm/whatsnew:vsa:0:0:Cannot display student activity"; + &Apache::loncommon::content_type($r,'text/html'); + $r->send_http_header; + $r->print(&display_header($command)); + if (! (($env{'request.course.fn'}) && (&Apache::lonnet::allowed('bre',$env{'request.course.id'})))) { + # Not in a course, or not allowed to view action items + $env{'user.error.msg'}="/adm/whatsnew:bre:0:0:Cannot display what's new screen"; return HTTP_NOT_ACCEPTABLE; } + &Apache::lonhtmlcommon::clear_breadcrumbs(); + if (($command eq 'chgthreshold') && (&Apache::lonnet::allowed('vgr',$env{'request.course.id'}))) { + &Apache::lonhtmlcommon::add_breadcrumb + ({href=>'/adm/whatsnew?command=threshold', + text=>"Change thresholds"}); + $r->print(&Apache::lonhtmlcommon::breadcrumbs + (undef,'Course Action Items','Course_Action_Items_Thresholds')); + } else { + &Apache::lonhtmlcommon::add_breadcrumb + ({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; } #------------------------------ @@ -46,63 +100,22 @@ sub display_main_box { my ($r,$command) = @_; my $domain=&Apache::loncommon::determinedomain(); my $tabbg=&Apache::loncommon::designparm('coordinator.tabbg',$domain); - $r->print(< -
- - -
- - - - -
- - - - - - '); - $r->print(' - -
- - - - -
- - - - - - -
- Course Action Items  -
-
-
- - -
-END_OF_BLOCK - &display_nav_box($r,$command); - $r->print('
 - -
'); - - if ($command eq 'config') { - &display_config_box($r); + $r->print(' -
'); + + 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') && (&Apache::lonnet::allowed('vgr',$env{'request.course.id'}))) { + &display_config_box($r,$command,$tabbg,\%threshold_titles,$cdom,$crs); } else { - &display_actions_box($r); + &display_actions_box($r,$command,\%threshold_titles,$cdom,$crs); } $r->print(< -
-
-
-

@@ -111,37 +124,6 @@ END_OF_BLOCK END_OF_BLOCK } -#------------------------------ -# display_nav_box -# -# Display the navigation box -#------------------------------ - -sub display_nav_box { - my ($r,$command) = @_; - $r->print(''."\n"); - if ($command eq "info") { - $r->print(''); - } else { - $r->print(''); - } - $r->print(''); - if ($command eq "config") { - $r->print(''); - } else { - $r->print(''); - } - $r->print('
'); - $r->print('Action Items
'); - $r->print('
'); - $r->print('Current Action Items
'); - $r->print('
 
'); - $r->print('Display options
'); - $r->print('
'); - $r->print('Display options
'); - $r->print('
'); -} - #------------------------------- # display_header # @@ -150,9 +132,10 @@ sub display_nav_box { #------------------------------- sub display_header{ + my $html=&Apache::lonxml::xmlbegin(); my $bodytag=&Apache::loncommon::bodytag('Course Action Items'); return(< +$html Course Action Items @@ -168,338 +151,593 @@ ENDHEAD #------------------------------- sub display_actions_box() { - my $r = shift; + my ($r,$command,$threshold_titles,$cdom,$crs) = @_; my $rowColor1 = "#ffffff"; my $rowColor2 = "#eeeeee"; - my $rowColor; my %unread = (); my %ungraded = (); my %bombed = (); + my %triggered = (); + my %changed = (); my @newmsgs = (); my @critmsgs = (); my @newdiscussions = (); my @tograde = (); my @bombs = (); + my @warnings = (); + my $msgcount = 0; + my $critmsgcount = 0; + + my %res_title = (); + my %show = (); + my $needitems = 0; + my $boxcount = 0; my $domain=&Apache::loncommon::determinedomain(); my $function; - if ($ENV{'request.role'}=~/^(cc|in|ta|ep)/) { + if ($env{'request.role'}=~/^(cc|in|ta|ep)/) { $function='coordinator'; } - if ($ENV{'request.role'}=~/^(su|dc|ad|li)/) { + if ($env{'request.role'}=~/^(su|dc|ad|li)/) { $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


'); + unless ($env{'request.course.id'}) { + $r->print('
You are accessing an invalid course.


'); return; } - $r->print('Course Action Items
'); + my %checkallowed = ( + coursediscussion => &Apache::lonnet::allowed('pch',$env{'request.course.id'}), + handgrading => &Apache::lonnet::allowed('mgr',$env{'request.course.id'}), + abovethreshold => &Apache::lonnet::allowed('vgr',$env{'request.course.id'}), + haserrors => &Apache::lonnet::allowed('opa',$env{'request.course.id'}), + versionchanges => &Apache::lonnet::allowed('opa',$env{'request.course.id'}), + coursenormalmail => 1, + coursecritmail => 1, + ); + + my %display_settings = &get_display_settings(); + my $starttime = 86400; + my %intervals = ( + all => 'since resource creation', + -1 => 'since start of course', + 2592000 => 'since last month', + 604800 => 'since last week', + 86400 => 'since yesterday', + ); + my $interval = $intervals{$starttime}; + + my %headings = &Apache::lonlocal::texthash( + coursediscussion => 'Unread course discussion posts', + handgrading => 'Problems requiring handgrading', + haserrors => 'Problems with errors', + versionchanges => 'Resources in course with version changes '.$interval, + coursenormalmail => 'New course message', + coursecritmail => 'New critical messages in course', + ); -## UNREAD COURSE DISCUSSION POSTS ## - $r->print(<<"END"); - -
- - - - - -
Unread course discussion posts:
- -END - - if (@newdiscussions > 0) { -# @newdiscussions = sort { &cmp_title($a,$b) } @newdiscussions; - my $rowNum = 0; - foreach my $ressymb (@newdiscussions) { - my $forum_title = $unread{$ressymb}{'title'}; - my ($map,$ind,$url)=&Apache::lonnet::decode_symb($ressymb); - my $feedurl = &Apache::lonnet::clutter($url); -# backward compatibility (bulletin boards used to be 'wrapped') - if ($feedurl=~m|^/adm/wrapper/adm/.*/bulletinboard$|) { - $feedurl=~s|^/adm/wrapper||; - } - 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 ($checkallowed{'abovethreshold'}) { + &get_curr_thresholds(\%threshold,$cdom,$crs); } - $r->print('
'.$forum_title.': '.$unreadnum.' 

 No unread posts in course discussions


'); -## UNGRADED ITEMS ## - $r->print(< -
- - - - -
Problems requiring handgrading:
- -END + $headings{'abovethreshold'} = &mt('Problems with av. attempts').' ≥ '.$threshold{'av_attempts'}.' '.&mt('or deg. difficulty').' ≥ '.$threshold{'degdiff'}.'
'.&mt('and total number of students with submissions').' ≥ '.$threshold{'numstudents'}; - if (@tograde > 0) { - $r->print(''); - my $rowNum = 0; - foreach my $res (@tograde) { - if ($rowNum %2 == 1) { - $rowColor = $rowColor1; - } else { - $rowColor = $rowColor2; + my @actionorder = ('handgrading','haserrors','abovethreshold','versionchanges','coursediscussion','coursenormalmail','coursecritmail'); + + foreach my $key (keys(%checkallowed)) { + $show{$key} = 0; + if ($checkallowed{$key}) { + unless ($display_settings{$key} eq 'off') { + $show{$key} = 1; } - - $r->print(''); - $rowNum ++; } - } else { - $r->print(''); } - $r->print('
Problem NameNumber ungraded
'.$ungraded{$res}{title}.''.$ungraded{$res}{count}.'

  No problems require handgrading  


'); - $r->print(' '); -## MESSAGES ## - $r->print(< - - - - - - - -
New course messages
- -END - if ($msgcount > 0) { - my $rowNum = 0; - my $mailcount = 1; - foreach my $msg (@newmsgs) { - if ($rowNum %2 == 1) { - $rowColor = $rowColor1; - } else { - $rowColor = $rowColor2; + foreach my $item (@actionorder) { + unless ($item eq 'coursenormalmail' || $item eq 'coursecritmail') { + if ($show{$item}) { + $needitems = 1; + last; } - $r->print(''); - $rowNum ++; - $mailcount ++; } - } else { - $r->print(''); } - $r->print('
'.$mailcount.'.  '.$msg->{'shortsub'}.'    '.$msg->{'from'}.'@'.$msg->{'fromdom'}.' '.$msg->{'sendtime'}.'

No new course messages


'); - $r->print(< - - - - - - -
New critical messages in course
- -END + 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); + } - if ($critmsgcount > 0) { - my $rowNum = 0; - my $mailcount = 1; - foreach my $msg (@critmsgs) { - if ($rowNum %2 == 1) { - $rowColor = $rowColor1; - } else { - $rowColor = $rowColor2; + 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(); + + if ($needitems) { + &getitems(\%unread,\%ungraded,\%bombed,\%triggered,\%changed,\@newdiscussions,\@tograde,\@bombs,\@warnings,$rowColor1,$rowColor2,\%threshold,$cdom,$crs,\%res_title,\%show,$starttime); + } + if ($show{'coursenormalmail'}) { + &getnormalmail(\@newmsgs); + } + if ($show{'coursecritmail'}) { + &getcritmail(\@critmsgs); + } + + $r->print(qq|Hide All  Show All|); + + $r->print('
'); - $rowNum ++; - $mailcount ++; + &display_launcher($r,$actionitem,\%checkallowed,$tabbg,$rowColor1,$rowColor2,\%show,\%headings,\%res_title,\@tograde,\%ungraded,\@bombs,\%bombed,\%changed,\@warnings,\%triggered,\@newdiscussions,\%unread,$msgcount,\@newmsgs,$critmsgcount,\@critmsgs,$interval); + $displayed ++; } - } else { - $r->print(''); } - - $r->print('
'); + + my $displayed = 0; + my $totalboxes = keys(%checkallowed); + my $halfway = int($totalboxes/2) + $totalboxes%2; + foreach my $actionitem (@actionorder) { + if ($checkallowed{$actionitem}) { + if ($displayed == $halfway) { + $r->print(' '); } - $r->print('
'.$mailcount.'.  '.$msg->{'shortsub'}.'    '.$msg->{'from'}.'@'.$msg->{'fromdom'}.' '.$msg->{'sendtime'}.'

No unread critical messages in course


'); + $r->print(' + + + + + + + '); +} -## BOMBS ## - $r->print(< +#------------------------------- +# 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('
'); - $bombnum ++; } - } else { - $r->print(''); + &end_box($r); } - $r->print('
+
- - - - - +
Problems with errors
+
- -END - my $bombnum = 0; - if (@bombs > 0) { -# @bombs = sort { &cmp_title($a,$b) } @bombs; - foreach my $bomb (@bombs) { - if ($bombnum %2 == 1) { - $rowColor = $rowColor1; - } else { - $rowColor = $rowColor2; +
+ + + + + '); + 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 display_launcher { + my ($r,$action,$checkallowed,$tabbg,$rowColor1,$rowColor2,$show, + $headings,$res_title,$tograde,$ungraded,$bombs,$bombed,$changed, + $warnings,$triggered,$newdiscussions,$unread,$msgcount,$newmsgs, + $critmsgcount,$critmsgs,$interval) = @_; + + if ($$checkallowed{$action}) { + &start_box($r,$tabbg,$show,$headings,$action); + if ($$show{$action}) { + if ($action eq 'handgrading') { # UNGRADED ITEMS + &display_handgrade($r,$tograde,$rowColor1,$rowColor2, + $ungraded); + } elsif ($action eq 'haserrors') { # BOMBS + &display_haserrors($r,$bombs,$rowColor1,$rowColor2,$bombed, + $res_title); + } elsif ($action eq 'versionchanges') { # VERSION CHANGES + &display_versionchanges($r,$changed,$res_title,$rowColor1, + $rowColor2,$interval); + + } elsif ($action eq 'abovethreshold') { # DEGDIFF/AV. TRIES TRIGGERS + &display_abovethreshold($r,$warnings,$triggered,$res_title, + $rowColor1,$rowColor2); + } elsif ($action eq 'coursediscussion') { # UNREAD COURSE DISCUSSION + &display_coursediscussion($r,$newdiscussions,$unread, + $res_title); + } elsif ($action eq 'coursenormalmail') { # NORMAL MESSAGES + &display_coursenormalmail($r,$msgcount,$newmsgs,$rowColor1, + $rowColor2); + } elsif ($action eq 'coursecritmail') { # CRITICAL MESSAGES + &display_coursecritmail($r,$critmsgcount,$critmsgs,$rowColor1, + $rowColor2); } - $r->print('
'.$bombed{$bomb}{errorlink}.'

No problems with errors

'); - $r->print(' - - - - '); - $r->print(''); + return; } sub getitems { - my ($unread,$ungraded,$bombed,$newdiscussions,$tograde,$bombs) = @_; + my ($unread,$ungraded,$bombed,$triggered,$changed,$newdiscussions, + $tograde,$bombs,$warnings,$rowColor1,$rowColor2,$threshold,$cdom,$crs, + $res_title,$show,$starttime) = @_; 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 %lastreadtime = (); - my @discussions = (); - my ($classlist,$keylist) = &Apache::loncoursedata::get_classlist(); - - foreach (keys %lastread) { - my $key = $_; - $key =~ s/_lastread$//; - $lastreadtime{$key} = $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 %lastreadtime; + my %resourcetracker; + +# Resource version changes + if ($$show{'versionchanges'}) { + &checkversions($cdom,$crs,$navmap,$changed,$starttime); + } + + if ($$show{'coursediscussions'}) { + my %lastread = &Apache::lonnet::dump('nohist_'. + $env{'request.course.id'}.'_discuss', + $env{'user.domain'},$env{'user.name'},'lastread'); + foreach my $key (keys(%lastread)) { + my $newkey = $key; + $newkey =~ s/_lastread$//; + $lastreadtime{$newkey} = $lastread{$key}; + } } + + if ($$show{'abovethreshold'}) { + %resourcetracker = &Apache::lonnet::dump('nohist_resourcetracker', + $cdom,$crs); + } + + my $warningnum = 0; foreach my $resource (@allres) { my $result = ''; my $applies = 0; my $symb = $resource->symb(); %{$$bombed{$symb}} = (); %{$$ungraded{$symb}} = (); + %{$$triggered{$symb}} = (); + $$triggered{$symb}{numparts} = 0; my $title = $resource->compTitle(); - my $ressymb = $symb; - if ($ressymb =~ m-(___adm/\w+/\w+)/(\d+)/bulletinboard$-) { - $ressymb = 'bulletin___'.$2.$1.'/'.$2.'/bulletinboard'; - unless ($ressymb =~ m|bulletin___\d+___adm/wrapper|) { - $ressymb=~s|(bulletin___\d+___)|$1adm/wrapper/|; + $$res_title{$symb} = $title; + my $ressymb = $resource->wrap_symb(); + +# Check for unread discussion postings + if ($$show{'coursediscussion'}) { + &check_discussions($cdom,$crs,$resource,$symb,$ressymb,$title, + $newdiscussions,$unread,\&lastreadtime); + } + +# Check for ungraded problems + if ($resource->is_problem()) { + if ($$show{'handgrading'}) { + &check_handgraded($resource,$symb,$title,$cdom,$crs,$ungraded, + $tograde); } } +# Check for bombs + if ($$show{'haserrors'}) { + &check_bombed($resource,$symb,$title,$bombs,$bombed); + } + +# Maxtries and degree of difficulty for problem parts, unless handgradeable + if ($$show{'abovethreshold'}) { + &check_thresholds($resource,$symb,\%resourcetracker,$triggered, + $threshold,$warnings,$warningnum,$rowColor1,$rowColor2); + } + + } +} + +sub check_discussions { + my ($cdom,$crs,$resource,$symb,$ressymb,$title,$newdiscussions,$unread, + $lastreadtime) = @_; # Check for unread discussion postings - if (defined($discussiontime{$ressymb})) { - push(@discussions,$ressymb); - my $prevread = 0; - my $unreadcount = 0; - %{$$unread{$ressymb}} = (); - $$unread{$ressymb}{'title'} = $title; - $$unread{$ressymb}{'symb'} = $symb; - 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'}); - if ($contrib{'version'}) { - for (my $id=1;$id<=$contrib{'version'};$id++) { - unless (($contrib{'hidden'}=~/\.$id\./) || ($contrib{'deleted'}=~/\.$id\./)) { - if ($prevread <$contrib{$id.':timestamp'}) { - $$unread{$ressymb}{$unreadcount} = $id.': '.$contrib{$id.':subject'}; - $unreadcount ++; - push(@{$newdiscussions}, $ressymb); - } + if ($resource->hasDiscussion()) { + my $prevread = 0; + my $unreadcount = 0; + %{$$unread{$ressymb}} = (); + $$unread{$ressymb}{'title'} = $title; + $$unread{$ressymb}{'symb'} = $symb; + if (defined($$lastreadtime{$ressymb})) { + $prevread = $$lastreadtime{$ressymb}; + } + 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\./)) { + if ($prevread <$contrib{$id.':timestamp'}) { + $$unread{$ressymb}{$unreadcount} = $id.': '.$contrib{$id.':subject'}; + $unreadcount ++; } } } } + if ($unreadcount) { push(@{$newdiscussions}, $ressymb); } + } +} -# Check for ungraded problems - 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 $graded = 0; - foreach (keys(%status)) { - $submitted = 1 if ($status{$_} ne 'nothing'); - $graded = 1 if ($status{$_} !~ /^correct/); - my ($foo,$partid,$foo1) = split(/\./,$_); - if ($status{'resource.'.$partid.'.submitted_by'} ne '') { - $submitted = 0; - } - } - next if (!$submitted || !$graded); - $ctr ++; +sub check_handgraded { + my ($resource,$symb,$title,$cdom,$cnum,$ungraded,$tograde) = @_; + if ($resource->is_problem()) { + my ($map,$ind,$url)=&Apache::lonnet::decode_symb($symb); + my $partlist=$resource->parts(); + my $handgradeable; + foreach my $part (@$partlist) { + if ($resource->handgrade($part) eq 'yes') { + $handgradeable=1; last; } - if ($ctr) { - $$ungraded{$symb}{count} = $ctr; + } + if ($handgradeable) { + my @ungraded = &Apache::bridgetask::get_users_in_queue( + 'gradingqueue',$symb,$cdom,$cnum); + if (@ungraded > 0) { + $$ungraded{$symb}{count} = scalar(@ungraded); $$ungraded{$symb}{title} = $title; push(@{$tograde}, $symb); } } + } +} -# Check for bombs - if ($resource->getErrors()) { - my $errors = $resource->getErrors(); - my @bombs = split(/,/, $errors); - my $errorcount = scalar(@bombs); - my $errorlink = ''; - $$bombed{$symb}{errorcount} = $errorcount; - $$bombed{$symb}{errorlink} = $errorlink; - push(@{$bombs}, $symb); +sub check_bombed { + my ($resource,$symb,$title,$bombs,$bombed) = @_; + if ($resource->getErrors()) { + my $errors = $resource->getErrors(); + $errors =~ s/^,//; + my @bombs = split(/,/, $errors); + my $errorcount = scalar(@bombs); + my $errorlink = ''. + $title.''; + $$bombed{$symb}{errorcount} = $errorcount; + $$bombed{$symb}{errorlink} = $errorlink; + push(@{$bombs}, $symb); + } +} + +sub check_thresholds { + my ($resource,$symb,$resourcetracker,$triggered,$threshold,$warnings, + $warningnum,$rowColor1,$rowColor2) = @_; +# Compile maxtries and degree of difficulty for problem parts, unless handgradeable + my @parts = @{$resource->parts()}; + my %stats; + my %lastreset = (); + my $warning = 0; + my $rowColor; + foreach my $part (@parts) { + if ($resource->handgrade($part) eq 'yes') { + next; + } + %{$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"}; + if ($lastreset{$part}) { + $lastreset{$part} = &Apache::lonnavmaps::timeToHumanString($lastreset{$part}); + } + $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} .= ''."\n"; + } + if (@parts > 1) { + $$triggered{$symb}{text} .= ' + part - '.$part.''; + } else { + $$triggered{$symb}{text} .= ' + single part'; + } + $$triggered{$symb}{text} .= ' + '.$stats{$part}{users}.' + '.$stats{$part}{attempts}.' + '.$stats{$part}{degdiff}.' + '.$lastreset{$part}.' + + '; + $$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"; } } -# Compile maxtries and degree of difficulty. + return $result; } -sub getmail { - my ($newmsgs,$critmsgs) = @_; +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 getnormalmail { + my ($newmsgs) = @_; # Check for unread mail in course my $msgcount = 0; - my @msgids = sort split(/\&/,&Apache::lonnet::reply - ('keys:'.$ENV{'user.domain'}.':'. - $ENV{'user.name'}.':nohist_email', - $ENV{'user.home'})); - foreach my $msgid (@msgids) { - my ($sendtime,$shortsubj,$fromname,$fromdom,$fromcid,$status)= + + my @messages = sort(&Apache::lonnet::getkeys('nohist_email')); + foreach my $message (@messages) { + my $msgid=&Apache::lonnet::escape($message); + my ($sendtime,$shortsubj,$fromname,$fromdom,$status,$fromcid)= &Apache::lonmsg::unpackmsgid($msgid); - if ($fromcid eq $ENV{'request.course.id'}) { + if (($fromcid) && ($fromcid eq $env{'request.course.id'})) { if (defined($sendtime) && $sendtime!~/error/) { my $numsendtime = $sendtime; $sendtime = &Apache::lonlocal::locallocaltime($sendtime); if ($status eq 'new') { - $$msgcount ++; + $msgcount ++; + if ($shortsubj eq '') { + $shortsubj = &mt('No subject'); + } + $shortsubj = &Apache::lonnet::unescape($shortsubj); push(@{$newmsgs}, { msgid => $msgid, sendtime => $sendtime, - shortsub => &Apache::lonnet::unescape($shortsubj), + shortsub => $shortsubj, from => $fromname, fromdom => $fromdom }); @@ -507,36 +745,387 @@ sub getmail { } } } + return $msgcount; +} +sub getcritmail { + my ($critmsgs) = @_; # Check for critical messages in course my %what=&Apache::lonnet::dump('critical'); my $result = ''; my $critmsgcount = 0; - foreach my $msgid (sort keys %what) { - my ($sendtime,$shortsubj,$fromname,$fromdom,$fromcid,$status)= - &Apache::lonmsg::unpackmsgid($_); - if ($fromcid eq $ENV{'request.course.id'}) { + foreach my $msgid (sort(keys(%what))) { + my ($sendtime,$shortsubj,$fromname,$fromdom,$status,$fromcid)= + &Apache::lonmsg::unpackmsgid($msgid); + if (($fromcid) && ($fromcid eq $env{'request.course.id'})) { if (defined($sendtime) && $sendtime!~/error/) { my $numsendtime = $sendtime; $sendtime = &Apache::lonlocal::locallocaltime($sendtime); $critmsgcount ++; + if ($shortsubj eq '') { + $shortsubj = &mt('No subject'); + } + $shortsubj = &Apache::lonnet::unescape($shortsubj); push(@{$critmsgs}, { msgid => $msgid, sendtime => $sendtime, - shortsub => &Apache::lonnet::unescape($shortsubj), + shortsub => $shortsubj, from => $fromname, fromdom => $fromdom }); } } } - return ($msgcount,$critmsgcount); + return $critmsgcount; +} + + +sub checkversions { + my ($cdom,$crs,$navmap,$changed,$starttime) = @_; + my %changes=&Apache::lonnet::dump('versionupdate',$cdom,$crs); + my ($tmp) = keys(%changes); + if ($tmp =~/^error\:/) { + &Apache::lonnet::logthis('Error retrieving version update information: '. + $tmp.' for '.$cdom.'_'.$crs.' in whatsnew'); + } else { + if (keys(%changes) > 0) { + foreach my $key (sort(keys(%changes))) { + if ($changes{$key} > $starttime) { + my $version; + my ($root,$extension)=($key=~/^(.*)\.(\w+)$/); + my $currentversion=&Apache::lonnet::getversion($key); + my $revdate = + &Apache::lonnet::metadata($root.'.'.$extension, + 'lastrevisiondate'); + print STDERR "revdate for $root and $extension is $revdate\n"; + $revdate = &Apache::lonlocal::locallocaltime($revdate); + my $linkurl=&Apache::lonnet::clutter($key); + my $usedversion=$navmap->usedVersion('version_'.$linkurl); + my @resources = $navmap->getResourceByUrl($linkurl,1); + if (($usedversion) && ($usedversion ne 'mostrecent')) { + $version = $usedversion; + } else { + $version = $currentversion; + } + foreach my $res (@resources) { + my $symb = $res->symb(); + %{$$changed{$symb}} = ( + current => $currentversion, + version => $version, + revdate => $revdate, + ); + } + } + } + } + } + return; +} + +sub display_handgrade { + my ($r,$tograde,$rowColor1,$rowColor2,$ungraded) = @_; + my $rowColor; + my %lt = &Apache::lonlocal::texthash( + 'prna' => 'Problem Name', + 'nmun' => 'Number ungraded', + 'nopr' => 'No problems require handgrading', + ); + if (@{$tograde} > 0) { + $r->print(''.$lt{'prna'}.''.$lt{'nmun'}.''); + my $rowNum = 0; + foreach my $res (@{$tograde}) { + if ($rowNum %2 == 1) { + $rowColor = $rowColor1; + } else { + $rowColor = $rowColor2; + } + my ($map,$id,$url)=&Apache::lonnet::decode_symb($res); + my $linkurl=&Apache::lonnet::clutter($url); + $linkurl .= '?symb='.&Apache::lonnet::escape($res); + + $r->print(''.$$ungraded{$res}{title}.''.$$ungraded{$res}{count}.''); + $rowNum ++; + } + } else { + $r->print('
  '.$lt{'nopr'}.'  

'); + } +} + +sub display_haserrors { + my ($r,$bombs,$rowColor1,$rowColor2,$bombed,$res_title) = @_; + my $bombnum = 0; + my $rowColor; + my %lt = &Apache::lonlocal::texthash( + reso => 'Resource', + nmer => 'Number of errors', + noer => 'No problems with errors', + ); + if (@{$bombs} > 0) { + $r->print(''.$lt{'reso'}.''.$lt{'nmer'}.''); + @{$bombs} = sort { &cmp_title($a,$b,$res_title) } @{$bombs}; + foreach my $bomb (@{$bombs}) { + if ($bombnum %2 == 1) { + $rowColor = $rowColor1; + } else { + $rowColor = $rowColor2; + } + $r->print(''.$$bombed{$bomb}{errorlink}.''.$$bombed{$bomb}{errorcount}.''); + $bombnum ++; + } + } else { + $r->print('
'.$lt{'noer'}.'

'); + } + return; +} + +sub display_abovethreshold { + my ($r,$warnings,$triggered,$res_title,$rowColor1,$rowColor2) = @_; + my %lt = &Apache::lonlocal::texthash( + reso => 'Resource', + part => 'Part', + nust => 'Num. students', + avat => 'Av. Attempts', + dedi => 'Deg. Diff', + lare => 'Last Reset', + reco => 'Reset Count?', + rese => 'Reset counters to 0', + nopr => 'No problems satisfy threshold criteria', + ); + my $rowColor; + my $warningnum = 0; + if (@{$warnings} > 0) { + @{$warnings} = sort { &cmp_title($a,$b,$res_title) } @{$warnings}; + $r->print('
'. + ' '."\n"); + $r->print(''.$lt{'reso'}.''.$lt{'part'}.''.$lt{'nust'}.''.$lt{'avat'}.''.$lt{'dedi'}.''.$lt{'lare'}.''.$lt{'reco'}.''); + 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}{title}.''.$$triggered{$res}{text}); + $warningnum ++; + } + $r->print('

'.$lt{'nopr'}.'

'); + } +} + +sub display_versionchanges { + my ($r,$changed,$res_title,$rowColor1,$rowColor2,$interval) = @_; + my %lt = &Apache::lonlocal::texthash( + 'reso' => 'Resource', + 'revd' => 'Last revised', + 'newv' => 'New version', + 'veru' => 'Version used', + 'noup' => 'No updated versions', + ); + my $rowColor; + if (keys(%{$changed}) > 0) { + $r->print(''.$lt{'reso'}.''.$lt{'revd'}.''.$lt{'newv'}.''.$lt{'veru'}.''); + + + my @changes = sort { &cmp_title($a,$b,$res_title) } keys(%{$changed}); + my $changenum = 0; + foreach my $item (@changes) { + if ($changenum %2 == 1) { + $rowColor = $rowColor1; + } else { + $rowColor = $rowColor2; + } + my ($map,$id,$url)=&Apache::lonnet::decode_symb($item); + my $linkurl=&Apache::lonnet::clutter($url); + $linkurl .= '?symb='.&Apache::lonnet::escape($item); + + $r->print(''.$$res_title{$item}.''.$$changed{$item}{'revdate'}.''.$$changed{$item}{'current'}.''.$$changed{$item}{'version'}.''); + $changenum ++; + } + } else { + $r->print('
'.$lt{'noup'}.' '.$interval.'

'); + } + return; +} + +sub display_coursediscussion { + my ($r,$newdiscussions,$unread,$res_title,$rowColor1,$rowColor2) = @_; + my %lt = &Apache::lonlocal::texthash( + 'loca' => 'Location', + 'type' => 'Type', + 'numn' => 'Number of new posts', + 'noun' => 'No unread posts in course discussions', + ); + my $rowColor; + if (@{$newdiscussions} > 0) { + $r->print(''.$lt{'loca'}. + ''.$lt{'type'}. + ''.$lt{'numn'}. + ''); + @{$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(''.$forum_title.' '.$type.''.$unreadnum.' '); + $rowNum ++; + } + } + } else { + $r->print('
 '. + $lt{'noun'}.'

'); + } +} + +sub display_coursenormalmail { + my ($r,$msgcount,$newmsgs,$rowColor1,$rowColor2) = @_; + my $rowColor; + if ($msgcount > 0) { + $r->print(''.&mt('Number').''.&mt('Subject').''.&mt('Sender').''.&mt('Date/Time').''); + my $rowNum = 0; + my $mailcount = 1; + foreach my $msg (@{$newmsgs}) { + if ($rowNum %2 == 1) { + $rowColor = $rowColor1; + } else { + $rowColor = $rowColor2; + } + $r->print(''.$mailcount.'.  '.$msg->{'shortsub'}.'    '.$msg->{'from'}.'@'.$msg->{'fromdom'}.' '.$msg->{'sendtime'}.''); + $rowNum ++; + $mailcount ++; + } + } else { + $r->print('

'.&mt('No new course messages').'

'); + } +} + +sub display_coursecritmail { + my ($r,$critmsgcount,$critmsgs,$rowColor1,$rowColor2) = @_; + my $rowColor; + if ($critmsgcount > 0) { + $r->print(''.&mt('Number').''.&mt('Subject').''.&mt('Sender').''.&mt('Date/Time').''); + my $rowNum = 0; + my $mailcount = 1; + foreach my $msg (@{$critmsgs}) { + if ($rowNum %2 == 1) { + $rowColor = $rowColor1; + } else { + $rowColor = $rowColor2; + } + $r->print(''.$mailcount.'.  '.$msg->{'shortsub'}.'    '.$msg->{'from'}.'@'.$msg->{'fromdom'}.' '.$msg->{'sendtime'}.''); + $rowNum ++; + $mailcount ++; + } + } else { + $r->print('

'.&mt('No unread critical messages in course').'

'); + } } 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; } +sub get_display_settings { + my $udom = $env{'user.domain'}; + my $uname = $env{'user.name'}; + my $cid = $env{'request.course.id'}; + my %settings = &Apache::lonnet::dump('nohist_whatsnew',$udom,$uname,$cid); + my ($tmp) = keys(%settings); + if ($tmp=~/^error:/) { + %settings = (); + unless ($tmp eq 'error: 2 tie(GDBM) Failed while attempting dump') { + &logthis('Error retrieving whatsnew settings: '.$tmp.' for '. + $uname.':'.$udom.' for course: '.$cid); + } + } + return %settings; +} + +sub start_box { + my ($r,$tabbg,$show,$heading,$caller) = @_; + my %lt = &Apache::lonlocal::texthash( + chth => 'Change thresholds?', + chin => 'Change interval?', + ); + my $showhide; + if ($$show{$caller}) { + $showhide = 'Hide'; + + } else { + $showhide = 'Show'; + } + + $r->print(' + + + + +
+ + + + '); + if (($caller eq 'abovethreshold') && ($$show{$caller})) { + $r->print(' + + + '); + } elsif (($caller eq 'versionchanges') && ($$show{$caller})) { + $r->print(' + + + '); + } + $r->print(' + + + +
+ + + + + +
'.$$heading{$caller}.''.$showhide.'
+
'.$lt{'chth'}.'
'.$lt{'chin'}.'
+ +'); + return; +} + +sub end_box { + my ($r) = shift; + $r->print(' +
+
+

'); + return; +} + +1;