loncom/interface/lonwhatsnew.pm - view

File: [LON-CAPA] / loncom / interface / lonwhatsnew.pm
Revision 1.33: download - view: text, annotated - select for diffs
Fri Dec 2 23:17:47 2005 UTC (19 years, 2 months ago) by raeburn
Branches: MAIN
CVS tags: HEAD

Working on bugs 4240 and 4389.  Streamlining of display building code. Visibility of different components now based on individual privileges.  Infrastructure added for show/hide of individual components. Display of resources with version changes added. Handgraded check uses grading queue. A few small pieces left to do prior to testing.

# # $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::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($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; } #------------------------------ # 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('<table width="100%" border="0" cellpadding="5" cellspacing="0"><tr><td width="100%">'); 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,$command,\%threshold_titles,$cdom,$crs); } $r->print(<<END_OF_BLOCK); </td> </tr> </table> </body> </html> 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(<<ENDHEAD); $html <head> <title>Course Action Items</title> </head> $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 %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)/) { $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(' <center>You are accessing an invalid course.</center> '); return; } 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', ); if ($checkallowed{'abovethreshold'}) { &get_curr_thresholds(\%threshold,$cdom,$crs); } $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'}; 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; } } } foreach my $item (@actionorder) { unless ($item eq 'coursenormalmail' || $item eq 'coursecritmail') { if ($show{$item}) { $needitems = 1; last; } } } if (tie(my %bighash,'GDBM_File',$env{'request.course.fn'}.'.db', &GDBM_READER(),0640)) { my $furl=$bighash{'first_url'}; $r->print('<a href="'.$furl.'">Go to first resource</a><a href="/adm/preferences?action=changecourseinit"> Change your preferences</a> to suppress display of this screen when accessing courses as Course Coordinator in the future. <hr />'); 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.'<hr width="100%" />'); } $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|<a href="javascript:changeAll('hide');">Hide All</a>  <a href="javascript:changeAll('show');">Show All</a>|); $r->print(' <table border="0" width="100%" cellpadding="2" cellspacing="4"><tr><td align="left" valign="top" width="45%">'); 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('</td><td width="5%"> </td><td align="left" valign="top" width-"50%">'); } &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 ++; } } $r->print(' </table> </td> </tr> </table> </td> </tr> </table>'); } #------------------------------- # 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(' <form name="thresholdform" method="post"><table border="0" cellpadding="2" cellspacing="4"><tr><td align="left" valign="top" width="45%"> <table border="0" cellpadding="0" cellspacing="0" bgcolor="#000000"> <tr> <td> <table border="0" cellpadding="1" cellspacing="1" bgcolor="#000000"> <tr> <td bgcolor="#ffffff"> <table cellspacing="0" cellpadding="4" border="0"> <tr bgcolor="'.$tabbg.'"> <th>Threshold Name</th> <th>Current value</th> <th>Change?</th> </tr>'); 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(' <tr bgcolor="'.$rowColor.'"> <td>'.$threshold_titles{$type}.'</td> <td>'.&Apache::lonhtmlcommon::textbox($parameter.'_value', $threshold{$type}, 10,$onchange).'</td> <td>' .&Apache::lonhtmlcommon::checkbox($parameter.'_setparmval'). '</td> </tr>'); $rowNum ++; } $r->print('</table></td></tr></table></td></tr></table> <input type="submit" name="threshold" value="Make changes" /> <input type="hidden" name="action" value="update" /> </form>'); } 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); } } &end_box($r); } return; } sub getitems { 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(); # 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(); $$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 ($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); } } } 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 ($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); } } } } 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 = '<a href="/adm/email?display='. &Apache::lonnet::escape($bombs[0]).'">'. $title.'</a>'; $$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} .= '<tr bgcolor="'.$rowColor.'">'."\n"; } if (@parts > 1) { $$triggered{$symb}{text} .= ' <td align="right">part - '.$part.'</td>'; } else { $$triggered{$symb}{text} .= ' <td align="right">single part</td>'; } $$triggered{$symb}{text} .= ' <td align="right">'.$stats{$part}{users}.'</td> <td align="right">'.$stats{$part}{attempts}.'</td> <td align="right">'.$stats{$part}{degdiff}.'</td> <td align="right">'.$lastreset{$part}.'</td> <td align="right"><input type="checkbox" name="'.$resetname.'" /><input type="hidden" name="'.$resettitle.'" value="'.&Apache::lonnet::escape($$triggered{$symb}{title}).'" /></td> </tr>'; $$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.'', '<tt>'.$put_result.'</tt>').' '; } } } return $setoutput; } sub getnormalmail { my ($newmsgs) = @_; # 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 }); } } } } 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,$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 $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('<tr bgcolor="#cccccc"><td>'.$lt{'prna'}.'</td><td align="right">'.$lt{'nmun'}.'</td></tr>'); 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('<tr bgcolor="'.$rowColor.'"><td><a href="'.$linkurl.'">'.$$ungraded{$res}{title}.'</a></td><td align="right">'.$$ungraded{$res}{count}.'</td></tr>'); $rowNum ++; } } else { $r->print('<tr><td bgcolor="#ffffff"> <center>  '.$lt{'nopr'}.'   </td></tr>'); } } 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('<tr bgcolor="#cccccc"><td>'.$lt{'reso'}.'</td><td align="right">'.$lt{'nmer'}.'</td></tr>'); @{$bombs} = sort { &cmp_title($a,$b,$res_title) } @{$bombs}; foreach my $bomb (@{$bombs}) { if ($bombnum %2 == 1) { $rowColor = $rowColor1; } else { $rowColor = $rowColor2; } $r->print('<tr bgcolor="'.$rowColor.'"><td>'.$$bombed{$bomb}{errorlink}.'</td><td align="right">'.$$bombed{$bomb}{errorcount}.'</td></tr>'); $bombnum ++; } } else { $r->print('<tr><td bgcolor="#ffffff"> <center>'.$lt{'noer'}.'</center> </td></tr>'); } 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('<form name="reset_tracking" method="post">'. ' <input type="hidden" name="action" value="reset" />'."\n"); $r->print('<tr bgcolor="#cccccc"><td>'.$lt{'reso'}.'</td><td align="right">'.$lt{'part'}.'</td><td align="right">'.$lt{'nust'}.'</td><td align="right">'.$lt{'avat'}.'</td><td align="right">'.$lt{'dedi'}.'</td><td align="right">'.$lt{'lare'}.'</td><td align="right">'.$lt{'reco'}.'</td></tr>'); 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('<tr bgcolor="'.$rowColor.'"><td '.$rowspan.'><a href="'.$linkurl.'">'.$$triggered{$res}{title}.'</a></td>'.$$triggered{$res}{text}); $warningnum ++; } $r->print('<tr bgcolor="#cccccc"><td colspan="7" align="right"> <input type="submit" name="counters" value="'.$lt{'rese'}.'/></form>'); } else { $r->print('<tr><td bgcolor="#ffffff"> <center>'.$lt{'nopr'}.'</center> </td></tr>'); } } 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('<tr bgcolor="#cccccc"><td>'.$lt{'reso'}.'</td><td>'.$lt{'revd'}.'</td><td>'.$lt{'newv'}.'</td><td>'.$lt{'veru'}.'</td></tr>'); 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('<tr bgcolor="'.$rowColor.'"><td><a href="'.$linkurl.'">'.$$res_title{$item}.'</a></td><td>'.$$changed{$item}{'revdate'}.'</td><td>'.$$changed{$item}{'current'}.'</td><td>'.$$changed{$item}{'version'}.'</td></tr>'); $changenum ++; } } else { $r->print('<tr><td bgcolor="#ffffff"> <center>'.$lt{'noup'}.' '.$interval.'</center> </td></tr>'); } 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('<tr bgcolor="#cccccc"><td>'.$lt{'loca'}. '</td><td>'.$lt{'type'}. '<td align="right">'.$lt{'numn'}. '</td></tr>'); @{$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('<tr bgcolor="'.$rowColor.'"><td><a href="'.$feedurl.'?symb='.$$unread{$ressymb}{symb}.'">'.$forum_title.'</a> </td><td>'.$type.'</td><td align="right">'.$unreadnum.' </td></tr>'); $rowNum ++; } } } else { $r->print('<tr><td bgcolor="#ffffff"> <center> '. $lt{'noun'}.' </td></tr>'); } } sub display_coursenormalmail { my ($r,$msgcount,$newmsgs,$rowColor1,$rowColor2) = @_; my $rowColor; if ($msgcount > 0) { $r->print('<tr bgcolor="#cccccc"><td>'.&mt('Number').'</td><td>'.&mt('Subject').'</td><td>'.&mt('Sender').'</td><td>'.&mt('Date/Time').'</td></tr>'); my $rowNum = 0; my $mailcount = 1; foreach my $msg (@{$newmsgs}) { if ($rowNum %2 == 1) { $rowColor = $rowColor1; } else { $rowColor = $rowColor2; } $r->print('<tr bgcolor="'.$rowColor.'"><td valign="top">'.$mailcount.'.  </td><td valign="top"><a href="/adm/communicate">'.$msg->{'shortsub'}.'</a>   </td><td valign="top"> '.$msg->{'from'}.'@'.$msg->{'fromdom'}.' </td><td valign="top">'.$msg->{'sendtime'}.'</td></tr>'); $rowNum ++; $mailcount ++; } } else { $r->print('<tr><td bgcolor="#ffffff" width="100%"><center> '.&mt('No new course messages').' </center></td></tr>'); } } sub display_coursecritmail { my ($r,$critmsgcount,$critmsgs,$rowColor1,$rowColor2) = @_; my $rowColor; if ($critmsgcount > 0) { $r->print('<tr bgcolor="#cccccc"><td>'.&mt('Number').'</td><td>'.&mt('Subject').'</td><td>'.&mt('Sender').'</td><td>'.&mt('Date/Time').'</td></tr>'); my $rowNum = 0; my $mailcount = 1; foreach my $msg (@{$critmsgs}) { if ($rowNum %2 == 1) { $rowColor = $rowColor1; } else { $rowColor = $rowColor2; } $r->print('<tr bgcolor="'.$rowColor.'"><td valign="top">'.$mailcount.'.  </td><td valign="top"><a href="/adm/email?folder=critical">'.$msg->{'shortsub'}.'</a>   </td><td valign="top"> '.$msg->{'from'}.'@'.$msg->{'fromdom'}.' </td><td valign="top">'.$msg->{'sendtime'}.'</td></tr>'); $rowNum ++; $mailcount ++; } } else { $r->print('<tr><td bgcolor="#ffffff" width="100%"><center> '.&mt('No unread critical messages in course').' </center></td></tr>'); } } 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; } 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 = '<a href="javascript:change_display('."'".$caller. "','hide'".');">Hide</a>'; } else { $showhide = '<a href="javascript:change_display('."'".$caller. "','show'".');">Show</a>'; } $r->print(' <table border="0" cellpadding="0" cellspacing="0" bgcolor="#000000" width="100%"> <tr> <td> <table border="0" cellpadding="1" cellspacing="1" bgcolor="#000000" width="100%"> <tr> <td bgcolor="'.$tabbg.'"> <table width="100%" border="0" cellspacing="0" cellpadding="0"> <tr> <td>'.$$heading{$caller}.'</td> <td valign="top" align="right">'.$showhide.'</td> </tr> </table> </td> </tr>'); if (($caller eq 'abovethreshold') && ($$show{$caller})) { $r->print(' <tr> <td bgcolor="'.$tabbg.'" align="right"><a href="/adm/whatsnew?command=chgthreshold">'.$lt{'chth'}.'</a></td> </tr>'); } elsif (($caller eq 'versionchanges') && ($$show{$caller})) { $r->print(' <tr> <td bgcolor="'.$tabbg.'" align="right"><a href="/adm/whatsnew?command=chginterval">'.$lt{'chin'}.'</a></td> </tr>'); } $r->print(' <tr> <td bgcolor="#ffffff"> <table cellpadding="2" cellspacing="0" border="0" width="100%"> '); return; } sub end_box { my ($r) = shift; $r->print(' </table> </td> </tr> </table> </td> </tr> </table> '); return; } 1;