# # $Id: lonwhatsnew.pm,v 1.28 2005/09/12 01:45:25 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::lonlocal; use Apache::loncoursedata(); use Apache::lonnavmaps(); use Apache::lonuserstate; use Apache::Constants qw(:common :http); use Time::Local; use GDBM_File; #---------------------------- # handler # #---------------------------- 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; 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'); $r->send_http_header; $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"; return HTTP_NOT_ACCEPTABLE; } &Apache::lonhtmlcommon::clear_breadcrumbs(); if ($command eq 'chgthreshold') { &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; } #------------------------------ # display_main_box # # Display all the elements within the main box #------------------------------ sub display_main_box { my ($r,$command) = @_; my $domain=&Apache::loncommon::determinedomain(); my $tabbg=&Apache::loncommon::designparm('coordinator.tabbg',$domain); $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') { &display_config_box($r,$command,$tabbg,\%threshold_titles,$cdom,$crs); } else { &display_actions_box($r,$command,\%threshold_titles,$cdom,$crs); } $r->print(<

END_OF_BLOCK } #------------------------------- # display_header # # Display the header information and set # up the HTML #------------------------------- sub display_header{ my $html=&Apache::lonxml::xmlbegin(); my $bodytag=&Apache::loncommon::bodytag('Course Action Items'); return(< Course Action Items $bodytag ENDHEAD } #------------------------------- # display_actions_box # # Display the action items # #------------------------------- sub display_actions_box() { my ($r,$command,$threshold_titles,$cdom,$crs) = @_; my $rowColor1 = "#ffffff"; my $rowColor2 = "#eeeeee"; my $rowColor; 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; if ($env{'request.role'}=~/^(cc|in|ta|ep)/) { $function='coordinator'; } 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); unless ($env{'request.course.id'}) { $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('
'); ## UNGRADED ITEMS ## $r->print(<
Problems requiring handgrading
END if (@tograde > 0) { $r->print(''); 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(''); $rowNum ++; } } else { $r->print(''); } $r->print('
Problem NameNumber ungraded
'.$ungraded{$res}{title}.''.$ungraded{$res}{count}.'

  No problems require handgrading  


'); ## BOMBS ## $r->print(<<"END");
Problems with errors
END my $bombnum = 0; if (@bombs > 0) { $r->print(''); @bombs = sort { &cmp_title($a,$b,\%res_title) } @bombs; foreach my $bomb (@bombs) { if ($bombnum %2 == 1) { $rowColor = $rowColor1; } else { $rowColor = $rowColor2; } $r->print(''); $bombnum ++; } } else { $r->print(''); } $r->print('
ResourceNumber of errors
'.$bombed{$bomb}{errorlink}.''.$bombed{$bomb}{errorcount}.'

No problems with errors


'); # 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(<
New course messages
END if ($msgcount > 0) { $r->print(''); my $rowNum = 0; my $mailcount = 1; foreach my $msg (@newmsgs) { if ($rowNum %2 == 1) { $rowColor = $rowColor1; } else { $rowColor = $rowColor2; } $r->print(''); $rowNum ++; $mailcount ++; } } else { $r->print(''); } $r->print('
'.&mt('Number').''.&mt('Subject').''.&mt('Sender').''.&mt('Date/Time').'
'.$mailcount.'.  '.$msg->{'shortsub'}.'    '.$msg->{'from'}.'@'.$msg->{'fromdom'}.' '.$msg->{'sendtime'}.'

No new course messages


'); $r->print(<
New critical messages in course
END if ($critmsgcount > 0) { $r->print(''); my $rowNum = 0; my $mailcount = 1; foreach my $msg (@critmsgs) { if ($rowNum %2 == 1) { $rowColor = $rowColor1; } else { $rowColor = $rowColor2; } $r->print(''); $rowNum ++; $mailcount ++; } } else { $r->print(''); } $r->print('
NumberSubjectSenderDate/Time
'.$mailcount.'.  '.$msg->{'shortsub'}.'    '.$msg->{'from'}.'@'.$msg->{'fromdom'}.' '.$msg->{'sendtime'}.'

No unread critical messages in course


'); $r->print(' '); $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('
'."\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.'').'
'; } } } return $setoutput; } sub getmail { my ($newmsgs,$critmsgs) = @_; # Check for unread mail in course my $msgcount = 0; 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) && ($fromcid eq $env{'request.course.id'})) { if (defined($sendtime) && $sendtime!~/error/) { my $numsendtime = $sendtime; $sendtime = &Apache::lonlocal::locallocaltime($sendtime); if ($status eq 'new') { $msgcount ++; if ($shortsubj eq '') { $shortsubj = &mt('No subject'); } $shortsubj = &Apache::lonnet::unescape($shortsubj); push(@{$newmsgs}, { msgid => $msgid, sendtime => $sendtime, shortsub => $shortsubj, from => $fromname, fromdom => $fromdom }); } } } } # 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,$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 => $shortsubj, from => $fromname, fromdom => $fromdom }); } } } return ($msgcount,$critmsgcount); } sub cmp_title { 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; } 1;
'); 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 Name Current value Change?
'.$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,$threshold,$cdom,$crs,$res_title) = @_; my $navmap = Apache::lonnavmaps::navmap->new(); # 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', $cdom,$crs); my $warningnum = 0; foreach my $key (keys(%lastread)) { my $newkey = $key; $newkey =~ s/_lastread$//; $lastreadtime{$newkey} = $lastread{$key}; } 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(); $$res_title{$symb} = $title; my $ressymb = $resource->wrap_symb(); # Check for unread discussion postings if ($resource->hasDiscussion()) { 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'},$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=$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 = ''. $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}.'