Annotation of loncom/interface/lonwhatsnew.pm, revision 1.33

1.2       albertel    1: #
1.33    ! raeburn     2: # $Id: lonwhatsnew.pm,v 1.32 2005/10/10 13:36:35 raeburn Exp $
1.2       albertel    3: #
                      4: # Copyright Michigan State University Board of Trustees
                      5: #
                      6: # This file is part of the LearningOnline Network with CAPA (LON-CAPA).
                      7: #
                      8: # LON-CAPA is free software; you can redistribute it and/or modify
                      9: # it under the terms of the GNU General Public License as published by
                     10: # the Free Software Foundation; either version 2 of the License, or
                     11: # (at your option) any later version.
                     12: #
                     13: # LON-CAPA is distributed in the hope that it will be useful,
                     14: # but WITHOUT ANY WARRANTY; without even the implied warranty of
                     15: # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
                     16: # GNU General Public License for more details.
                     17: #
                     18: # You should have received a copy of the GNU General Public License
                     19: # along with LON-CAPA; if not, write to the Free Software
                     20: # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
                     21: #
                     22: # /home/httpd/html/adm/gpl.txt
                     23: #
                     24: # http://www.lon-capa.org/
                     25: #
                     26: 
                     27: 
1.1       raeburn    28: package Apache::lonwhatsnew;
                     29: 
                     30: use strict;
                     31: use lib qw(/home/httpd/lib/perl);
                     32: use Apache::lonnet;
1.3       albertel   33: use Apache::loncommon();
                     34: use Apache::lonhtmlcommon();
1.1       raeburn    35: use Apache::lonlocal;
1.3       albertel   36: use Apache::loncoursedata();
                     37: use Apache::lonnavmaps();
1.18      raeburn    38: use Apache::lonuserstate;
1.1       raeburn    39: use Apache::Constants qw(:common :http);
                     40: use Time::Local;
1.24      albertel   41: use GDBM_File;
1.1       raeburn    42: 
                     43: #----------------------------
                     44: # handler
                     45: #
                     46: #----------------------------
                     47: 
                     48: sub handler {
                     49:     my $r = shift;
1.7       raeburn    50:     if ($r->header_only) {
                     51:         &Apache::loncommon::content_type($r,'text/html');
                     52:         $r->send_http_header;
                     53:         return OK;
                     54:     }
1.1       raeburn    55:     &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},['command']);
                     56: 
1.13      raeburn    57:     my $command;
                     58:     if ($env{'form.action'} eq 'reset') {
                     59:         $command = 'reset';
                     60:     } elsif ($env{'form.action'} eq 'update') {
                     61:         $command = 'update';
                     62:     } else {
                     63:         $command = $env{'form.command'};
1.1       raeburn    64:     }
                     65: 
1.7       raeburn    66:     &Apache::loncommon::content_type($r,'text/html');
                     67:     $r->send_http_header;
1.33    ! raeburn    68:     $r->print(&display_header($command));
        !            69:     if (! (($env{'request.course.fn'}) && (&Apache::lonnet::allowed('bre',$env{'request.course.id'})))) {
        !            70:         # Not in a course, or not allowed to view action items
        !            71:         $env{'user.error.msg'}="/adm/whatsnew:bre:0:0:Cannot display what's new screen";
1.1       raeburn    72:         return HTTP_NOT_ACCEPTABLE;
                     73:     }
                     74: 
1.7       raeburn    75:     &Apache::lonhtmlcommon::clear_breadcrumbs();
1.33    ! raeburn    76:     if (($command eq 'chgthreshold') && (&Apache::lonnet::allowed('vgr',$env{'request.course.id'}))) {
1.7       raeburn    77:         &Apache::lonhtmlcommon::add_breadcrumb
1.13      raeburn    78:             ({href=>'/adm/whatsnew?command=threshold',
                     79:               text=>"Change thresholds"});
1.7       raeburn    80:         $r->print(&Apache::lonhtmlcommon::breadcrumbs
1.13      raeburn    81:             (undef,'Course Action Items','Course_Action_Items_Thresholds'));
1.7       raeburn    82:     } else {
                     83:         &Apache::lonhtmlcommon::add_breadcrumb
1.13      raeburn    84:             ({href=>'/adm/whatsnew',
1.7       raeburn    85:               text=>"Display Action Items"});
                     86:         $r->print(&Apache::lonhtmlcommon::breadcrumbs
                     87:             (undef,'Course Action Items','Course_Action_Items_Display'));
                     88:     }
1.1       raeburn    89:     &display_main_box($r,$command);
1.14      albertel   90:     return OK;
1.1       raeburn    91: }
                     92: 
                     93: #------------------------------
                     94: # display_main_box
                     95: #
                     96: # Display all the elements within the main box
                     97: #------------------------------
                     98:                                                                                 
                     99: sub display_main_box {
                    100:     my ($r,$command) = @_;
                    101:     my $domain=&Apache::loncommon::determinedomain();
                    102:     my $tabbg=&Apache::loncommon::designparm('coordinator.tabbg',$domain);
1.7       raeburn   103:     $r->print('<table width="100%" border="0" cellpadding="5" cellspacing="0"><tr><td width="100%">');
1.13      raeburn   104: 
                    105:     my %threshold_titles = (
                    106:                          av_attempts => 'Average number of attempts',
                    107:                          degdiff => 'Degree of difficulty',
                    108:                          numstudents => 'Total number of students with submissions',
                    109:     );
1.15      raeburn   110:     my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                    111:     my $crs = $env{'course.'.$env{'request.course.id'}.'.num'};
                    112: 
1.33    ! raeburn   113:     if (($command eq 'chgthreshold') && (&Apache::lonnet::allowed('vgr',$env{'request.course.id'}))) {
1.15      raeburn   114:         &display_config_box($r,$command,$tabbg,\%threshold_titles,$cdom,$crs);
1.1       raeburn   115:     } else {
1.15      raeburn   116:         &display_actions_box($r,$command,\%threshold_titles,$cdom,$crs);
1.1       raeburn   117:     }
                    118:     $r->print(<<END_OF_BLOCK);
                    119:   </td>
                    120:  </tr>
                    121: </table><br />
                    122: </body>
                    123: </html>
                    124: END_OF_BLOCK
                    125: }
                    126: 
                    127: #-------------------------------
                    128: # display_header
                    129: #
                    130: # Display the header information and set
                    131: # up the HTML
                    132: #-------------------------------
                    133: 
                    134: sub display_header{
1.3       albertel  135:     my $html=&Apache::lonxml::xmlbegin();
1.1       raeburn   136:     my $bodytag=&Apache::loncommon::bodytag('Course Action Items');
                    137:     return(<<ENDHEAD);
1.3       albertel  138: $html
1.1       raeburn   139: <head>
                    140: <title>Course Action Items</title>
                    141: </head>
                    142: $bodytag
                    143: ENDHEAD
                    144: }
                    145: 
                    146: #-------------------------------
                    147: # display_actions_box
                    148: #
                    149: # Display the action items
                    150: #
                    151: #-------------------------------
                    152:                                                                                 
                    153: sub display_actions_box() {
1.15      raeburn   154:     my ($r,$command,$threshold_titles,$cdom,$crs) = @_;
1.1       raeburn   155: 
                    156:     my $rowColor1 = "#ffffff";
                    157:     my $rowColor2 = "#eeeeee";
                    158: 
                    159:     my %unread = ();
                    160:     my %ungraded = ();
                    161:     my %bombed = ();
1.11      raeburn   162:     my %triggered = ();
1.33    ! raeburn   163:     my %changed = ();
1.1       raeburn   164:     my @newmsgs = ();
                    165:     my @critmsgs = ();
                    166:     my @newdiscussions = ();
                    167:     my @tograde = ();
                    168:     my @bombs = ();
1.11      raeburn   169:     my @warnings = ();
1.33    ! raeburn   170:     my $msgcount = 0;
        !           171:     my $critmsgcount = 0;
        !           172: 
1.16      raeburn   173:     my %res_title = ();
1.33    ! raeburn   174:     my %show = ();
        !           175:     my $needitems = 0;
        !           176:     my $boxcount = 0;
1.1       raeburn   177: 
                    178:     my $domain=&Apache::loncommon::determinedomain();
                    179:     my $function;
1.5       albertel  180:     if ($env{'request.role'}=~/^(cc|in|ta|ep)/) {
1.1       raeburn   181:         $function='coordinator';
                    182:     }
1.5       albertel  183:     if ($env{'request.role'}=~/^(su|dc|ad|li)/) {
1.1       raeburn   184:         $function='admin';
                    185:     }
                    186: 
1.13      raeburn   187:     my %threshold = (
1.22      www       188:                       av_attempts => 2,
                    189:                       degdiff => 0.5,
                    190:                       numstudents => 2,
1.13      raeburn   191:                      );
                    192: 
1.1       raeburn   193:     my $pgbg=&Apache::loncommon::designparm($function.'.pgbg',$domain);
                    194:     my $tabbg=&Apache::loncommon::designparm($function.'.tabbg',$domain);
                    195: 
1.5       albertel  196:     unless ($env{'request.course.id'}) {
1.18      raeburn   197:         $r->print('<br /><b><center>You are accessing an invalid course.</center></b><br /><br />');
1.1       raeburn   198:         return;
                    199:     }
1.33    ! raeburn   200: 
        !           201:     my %checkallowed = (
        !           202:              coursediscussion => &Apache::lonnet::allowed('pch',$env{'request.course.id'}),
        !           203:              handgrading => &Apache::lonnet::allowed('mgr',$env{'request.course.id'}),
        !           204:              abovethreshold => &Apache::lonnet::allowed('vgr',$env{'request.course.id'}),
        !           205:              haserrors => &Apache::lonnet::allowed('opa',$env{'request.course.id'}),
        !           206:              versionchanges => &Apache::lonnet::allowed('opa',$env{'request.course.id'}),
        !           207:              coursenormalmail => 1,
        !           208:              coursecritmail => 1,
        !           209:     );
        !           210: 
        !           211:     my %display_settings = &get_display_settings();
        !           212:     my $starttime = 86400;
        !           213:     my %intervals = (
        !           214:                   all => 'since resource creation',
        !           215:                    -1 => 'since start of course',
        !           216:               2592000 => 'since last month',
        !           217:                604800 => 'since last week',
        !           218:                 86400 => 'since yesterday',
        !           219:     );
        !           220:     my $interval = $intervals{$starttime};
        !           221: 
        !           222:     my %headings = &Apache::lonlocal::texthash(
        !           223:                 coursediscussion =>  'Unread course discussion posts',
        !           224:                 handgrading =>  'Problems requiring handgrading',
        !           225:                 haserrors => 'Problems with errors',
        !           226:                 versionchanges => 'Resources in course with version changes '.$interval,
        !           227:                 coursenormalmail => 'New course message',
        !           228:                 coursecritmail => 'New critical messages in course',
        !           229:     );
        !           230: 
        !           231:     if ($checkallowed{'abovethreshold'}) {
        !           232:         &get_curr_thresholds(\%threshold,$cdom,$crs);
        !           233:     }
        !           234: 
        !           235:     $headings{'abovethreshold'} = &mt('Problems with av. attempts').' &ge; '.$threshold{'av_attempts'}.' '.&mt('or deg. difficulty').' &ge; '.$threshold{'degdiff'}.'<br /> '.&mt('and total number of students with submissions').' &ge; '.$threshold{'numstudents'};
        !           236: 
        !           237:     my @actionorder = ('handgrading','haserrors','abovethreshold','versionchanges','coursediscussion','coursenormalmail','coursecritmail');
        !           238: 
        !           239:     foreach my $key (keys(%checkallowed)) {
        !           240:         $show{$key} = 0;
        !           241:         if ($checkallowed{$key}) {
        !           242:             unless ($display_settings{$key} eq 'off') {
        !           243:                 $show{$key} = 1;
        !           244:             }
        !           245:         }
        !           246:     }
        !           247: 
        !           248:     foreach my $item (@actionorder) {
        !           249:         unless ($item eq 'coursenormalmail' || $item eq 'coursecritmail') {
        !           250:             if ($show{$item}) {
        !           251:                 $needitems = 1;
        !           252:                 last;
        !           253:             }
        !           254:         }
        !           255:     }
        !           256: 
        !           257: 
1.24      albertel  258:     if (tie(my %bighash,'GDBM_File',$env{'request.course.fn'}.'.db',
                    259: 	    &GDBM_READER(),0640)) {
                    260: 	my $furl=$bighash{'first_url'};
                    261: 	$r->print('<font size="+1"><a href="'.$furl.'">Go to first resource</a></font><a href="/adm/preferences?action=changecourseinit"></font><br />Change your preferences</a> to suppress display of this screen when accessing courses as Course Coordinator in the future.<br /><hr />');
                    262: 	untie(%bighash);
                    263:     }
1.18      raeburn   264: 
1.13      raeburn   265:     my $result;
                    266: 
                    267:     if ($command eq 'reset') {
                    268:         $result = &process_reset($cdom,$crs);
                    269:     } elsif ($command eq 'update') {
                    270:         $result = &process_update($cdom,$crs,$threshold_titles);
                    271:     }
                    272:     if ($result) {
                    273:         $r->print($result.'<hr width="100%" />');
                    274:     }
1.27      albertel  275:     $r->rflush();
1.13      raeburn   276: 
1.33    ! raeburn   277:     if ($needitems) {
        !           278:         &getitems(\%unread,\%ungraded,\%bombed,\%triggered,\%changed,\@newdiscussions,\@tograde,\@bombs,\@warnings,$rowColor1,$rowColor2,\%threshold,$cdom,$crs,\%res_title,\%show,$starttime);
1.1       raeburn   279:     }
1.33    ! raeburn   280:     if ($show{'coursenormalmail'}) {
        !           281:         &getnormalmail(\@newmsgs);
1.7       raeburn   282:     }
1.33    ! raeburn   283:     if ($show{'coursecritmail'}) {
        !           284:         &getcritmail(\@critmsgs);
1.11      raeburn   285:     }
                    286: 
1.33    ! raeburn   287:     $r->print(qq|<a href="javascript:changeAll('hide');">Hide All</a>&nbsp;&nbsp;<a href="javascript:changeAll('show');">Show All</a>|);
1.1       raeburn   288: 
1.33    ! raeburn   289:     $r->print('<br /><table border="0" width="100%" cellpadding="2" cellspacing="4"><tr><td align="left" valign="top" width="45%">');
1.1       raeburn   290: 
1.33    ! raeburn   291:     my $displayed = 0;
        !           292:     my $totalboxes = keys(%checkallowed);
        !           293:     my $halfway = int($totalboxes/2) + $totalboxes%2;
        !           294:     foreach my $actionitem (@actionorder) {
        !           295:         if ($checkallowed{$actionitem}) {
        !           296:             if ($displayed == $halfway) {
        !           297:                 $r->print('</td><td width="5%">&nbsp;</td><td align="left" valign="top" width-"50%">');
1.1       raeburn   298:             }
1.33    ! raeburn   299:             &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);
        !           300:             $displayed ++; 
1.1       raeburn   301:         }
                    302:     }
                    303:     $r->print('
                    304:            </table>
                    305:           </td>
                    306:          </tr>
1.33    ! raeburn   307:         </table>
        !           308:       </td>
        !           309:     </tr>
        !           310:    </table>');
1.1       raeburn   311: }
                    312: 
1.11      raeburn   313: #-------------------------------
                    314: # display_config_box
                    315: #
1.13      raeburn   316: # Display the threshold setting screen 
1.11      raeburn   317: #
                    318: #-------------------------------
                    319:                                                                                 
                    320: sub display_config_box() {
1.15      raeburn   321:     my ($r,$command,$tabbg,$threshold_titles,$cdom,$crs) = @_;
1.13      raeburn   322:     my %threshold = ();
                    323:     my $rowColor1 = "#ffffff";
                    324:     my $rowColor2 = "#eeeeee";
                    325:     my $rowColor;
                    326: 
                    327:     my @thresholditems = ("av_attempts","degdiff","numstudents");
                    328:     my %threshold_titles = (
                    329:                          av_attempts => 'Average number of attempts',
                    330:                          degdiff => 'Degree of difficulty',
                    331:                          numstudents => 'Total number of students with submissions',
                    332:                          );
1.15      raeburn   333:     &get_curr_thresholds(\%threshold,$cdom,$crs);
1.13      raeburn   334: 
                    335:     $r->print('<br /><form name="thresholdform" method="post"><table border="0" cellpadding="2" cellspacing="4"><tr><td align="left" valign="top" width="45%">
                    336:            <table border="0" cellpadding="0" cellspacing="0" bgcolor="#000000">
                    337:             <tr>
                    338:              <td>
                    339:                <table border="0" cellpadding="1" cellspacing="1" bgcolor="#000000">
                    340:                 <tr>
                    341:                 <td bgcolor="#ffffff">
                    342:                  <table cellspacing="0" cellpadding="4" border="0">
                    343:      <tr bgcolor="'.$tabbg.'">
                    344:       <th>Threshold Name</th>
                    345:       <th>Current value</th>
                    346:       <th>Change?</th>
                    347:      </tr>');
                    348:     my $rowNum =0;
                    349:     foreach my $type (@thresholditems) {
                    350:         my $parameter = 'internal.threshold_'.$type;
                    351: # onchange is javascript to automatically check the 'Set' button.
                    352:         my $onchange = 'onFocus="javascript:window.document.forms'.
                    353:               "['thresholdform'].elements['".$parameter."_setparmval']".
                    354:               '.checked=true;"';
                    355:         if ($rowNum %2 == 1) {
                    356:             $rowColor = $rowColor1;
                    357:         } else {
                    358:             $rowColor = $rowColor2;
                    359:         }
                    360:         $r->print('
                    361:      <tr bgcolor="'.$rowColor.'">
                    362:       <td>'.$threshold_titles{$type}.'</td>
                    363:       <td>'.&Apache::lonhtmlcommon::textbox($parameter.'_value',
                    364:                                             $threshold{$type},
                    365:                                             10,$onchange).'</td>
                    366:       <td>'
                    367:            .&Apache::lonhtmlcommon::checkbox($parameter.'_setparmval').
                    368:       '</td>
                    369:      </tr>');
                    370:         $rowNum ++;
                    371:     }
                    372:     $r->print('</table></td></tr></table></td></tr></table>
                    373:            <br /><input type="submit" name="threshold" value="Make changes" />
                    374:                  <input type="hidden" name="action" value="update" />
                    375:                </form>');
1.11      raeburn   376: }
                    377: 
1.33    ! raeburn   378: sub display_launcher {
        !           379:     my ($r,$action,$checkallowed,$tabbg,$rowColor1,$rowColor2,$show,
        !           380:         $headings,$res_title,$tograde,$ungraded,$bombs,$bombed,$changed,
        !           381:         $warnings,$triggered,$newdiscussions,$unread,$msgcount,$newmsgs,
        !           382:                                        $critmsgcount,$critmsgs,$interval) = @_;
        !           383: 
        !           384:     if ($$checkallowed{$action}) {
        !           385:         &start_box($r,$tabbg,$show,$headings,$action);
        !           386:         if ($$show{$action}) {
        !           387:             if ($action eq 'handgrading') {    # UNGRADED ITEMS
        !           388:                 &display_handgrade($r,$tograde,$rowColor1,$rowColor2,
        !           389:                                                                     $ungraded);
        !           390:             } elsif ($action eq 'haserrors') { # BOMBS
        !           391:                 &display_haserrors($r,$bombs,$rowColor1,$rowColor2,$bombed,
        !           392:                                                                    $res_title);
        !           393:             } elsif ($action eq 'versionchanges') { # VERSION CHANGES
        !           394:                 &display_versionchanges($r,$changed,$res_title,$rowColor1,
        !           395:                                                          $rowColor2,$interval);
        !           396: 
        !           397:             } elsif ($action eq 'abovethreshold') { # DEGDIFF/AV. TRIES TRIGGERS
        !           398:                 &display_abovethreshold($r,$warnings,$triggered,$res_title,
        !           399:                                                         $rowColor1,$rowColor2);
        !           400:             } elsif ($action eq 'coursediscussion') { # UNREAD COURSE DISCUSSION
        !           401:                 &display_coursediscussion($r,$newdiscussions,$unread,
        !           402:                                                                    $res_title);
        !           403:             } elsif ($action eq 'coursenormalmail') { # NORMAL MESSAGES
        !           404:                 &display_coursenormalmail($r,$msgcount,$newmsgs,$rowColor1,
        !           405:                                                                    $rowColor2);
        !           406:             } elsif ($action eq 'coursecritmail') { # CRITICAL MESSAGES
        !           407:                 &display_coursecritmail($r,$critmsgcount,$critmsgs,$rowColor1,
        !           408:                                                                    $rowColor2);
        !           409:             }
        !           410:         }
        !           411:         &end_box($r);
        !           412:     }
        !           413:     return;
        !           414: }
        !           415: 
1.1       raeburn   416: sub getitems {
1.33    ! raeburn   417:     my ($unread,$ungraded,$bombed,$triggered,$changed,$newdiscussions,
        !           418:         $tograde,$bombs,$warnings,$rowColor1,$rowColor2,$threshold,$cdom,$crs,
        !           419:                                              $res_title,$show,$starttime) = @_;
1.1       raeburn   420:     my $navmap = Apache::lonnavmaps::navmap->new();
1.26      albertel  421:     # force retrieve Resource to seed the part id cache we'll need it later
                    422:     my @allres=$navmap->retrieveResources(undef,sub {if ($_[0]->is_problem) { $_[0]->parts();} return 1;});
1.33    ! raeburn   423:     my %lastreadtime;
        !           424:     my %resourcetracker;
        !           425: 
        !           426: # Resource version changes
        !           427:     if ($$show{'versionchanges'}) {
        !           428:         &checkversions($cdom,$crs,$navmap,$changed,$starttime);
        !           429:     }
        !           430: 
        !           431:     if ($$show{'coursediscussions'}) {   
        !           432:         my %lastread = &Apache::lonnet::dump('nohist_'.
        !           433:                         $env{'request.course.id'}.'_discuss',
        !           434:                         $env{'user.domain'},$env{'user.name'},'lastread');
        !           435:         foreach my $key (keys(%lastread)) {
        !           436:             my $newkey = $key;
        !           437:             $newkey =~ s/_lastread$//;
        !           438:             $lastreadtime{$newkey} = $lastread{$key};
        !           439:         }
        !           440:     }
        !           441:  
        !           442:     if ($$show{'abovethreshold'}) {
        !           443:         %resourcetracker =  &Apache::lonnet::dump('nohist_resourcetracker',
        !           444:                                                                    $cdom,$crs);
        !           445:     }
1.1       raeburn   446: 
1.11      raeburn   447:     my $warningnum = 0;
1.1       raeburn   448:     foreach my $resource (@allres) {
                    449:         my $result = '';
                    450:         my $applies = 0;
                    451:         my $symb = $resource->symb();
1.33    ! raeburn   452:         %{$$bombed{$symb}} = ();
1.1       raeburn   453:         %{$$ungraded{$symb}} = ();
1.11      raeburn   454:         %{$$triggered{$symb}} = ();
                    455:         $$triggered{$symb}{numparts} = 0;
1.1       raeburn   456:         my $title = $resource->compTitle();
1.16      raeburn   457:         $$res_title{$symb} = $title;
1.8       albertel  458:         my $ressymb = $resource->wrap_symb();
1.33    ! raeburn   459: 
1.1       raeburn   460: # Check for unread discussion postings
1.33    ! raeburn   461:         if ($$show{'coursediscussion'}) {
        !           462:             &check_discussions($cdom,$crs,$resource,$symb,$ressymb,$title,
        !           463:                                        $newdiscussions,$unread,\&lastreadtime);
        !           464:         }
1.1       raeburn   465: 
                    466: # Check for ungraded problems
                    467:         if ($resource->is_problem()) {
1.33    ! raeburn   468:             if ($$show{'handgrading'}) {
        !           469:                 &check_handgraded($resource,$symb,$title,$cdom,$crs,$ungraded,
        !           470:                                                                      $tograde);
        !           471:             }
1.1       raeburn   472:         }
                    473: 
                    474: # Check for bombs
1.33    ! raeburn   475:         if ($$show{'haserrors'}) {
        !           476:             &check_bombed($resource,$symb,$title,$bombs,$bombed);
        !           477:         }
        !           478: 
        !           479: # Maxtries and degree of difficulty for problem parts, unless handgradeable
        !           480:         if ($$show{'abovethreshold'}) {  
        !           481:             &check_thresholds($resource,$symb,\%resourcetracker,$triggered,
        !           482:                        $threshold,$warnings,$warningnum,$rowColor1,$rowColor2);
        !           483:         }
        !           484: 
        !           485:     }
        !           486: }
        !           487: 
        !           488: sub check_discussions {
        !           489:     my ($cdom,$crs,$resource,$symb,$ressymb,$title,$newdiscussions,$unread,
        !           490:                                                            $lastreadtime) = @_;  
        !           491: # Check for unread discussion postings
        !           492:     if ($resource->hasDiscussion()) {
        !           493:         my $prevread = 0;
        !           494:         my $unreadcount = 0;
        !           495:         %{$$unread{$ressymb}} = ();
        !           496:         $$unread{$ressymb}{'title'} = $title;
        !           497:         $$unread{$ressymb}{'symb'} = $symb;
        !           498:         if (defined($$lastreadtime{$ressymb})) {
        !           499:             $prevread = $$lastreadtime{$ressymb};
        !           500:         }
        !           501:         my %contrib = &Apache::lonnet::restore($ressymb,
        !           502:                                          $env{'request.course.id'},$cdom,$crs);
        !           503:         if ($contrib{'version'}) {
        !           504:             for (my $id=1;$id<=$contrib{'version'};$id++) {
        !           505:                 unless (($contrib{'hidden'}=~/\.$id\./) || 
        !           506:                         ($contrib{'deleted'}=~/\.$id\./)) {
        !           507:                     if ($prevread <$contrib{$id.':timestamp'}) {
        !           508:                         $$unread{$ressymb}{$unreadcount} = $id.': '.$contrib{$id.':subject'};
        !           509:                         $unreadcount ++;
        !           510:                     }
        !           511:                 }
        !           512:             }
1.1       raeburn   513:         }
1.33    ! raeburn   514:         if ($unreadcount) { push(@{$newdiscussions}, $ressymb); }
        !           515:     }
        !           516: }
        !           517: 
        !           518: sub check_handgraded {
        !           519:     my ($resource,$symb,$title,$cdom,$cnum,$ungraded,$tograde) = @_;
        !           520:     if ($resource->is_problem()) {
        !           521:         my ($map,$ind,$url)=&Apache::lonnet::decode_symb($symb);
        !           522:         my $partlist=$resource->parts();
        !           523:         my $handgradeable;
        !           524:         foreach my $part (@$partlist) {
1.31      raeburn   525:             if ($resource->handgrade($part) eq 'yes') {
1.33    ! raeburn   526:                 $handgradeable=1; last;
1.31      raeburn   527:             }
1.33    ! raeburn   528:         }
        !           529:         if ($handgradeable) {
        !           530:             my @ungraded = &Apache::bridgetask::get_users_in_queue(
        !           531:                                              'gradingqueue',$symb,$cdom,$cnum);
        !           532:             if (@ungraded > 0) {
        !           533:                 $$ungraded{$symb}{count} = scalar(@ungraded);
        !           534:                 $$ungraded{$symb}{title} = $title;
        !           535:                 push(@{$tograde}, $symb);
1.11      raeburn   536:             }
                    537:         }
1.33    ! raeburn   538:     }
        !           539: }
        !           540: 
        !           541: sub check_bombed {
        !           542:     my ($resource,$symb,$title,$bombs,$bombed) = @_;
        !           543:     if ($resource->getErrors()) {
        !           544:         my $errors = $resource->getErrors();
        !           545:         $errors =~ s/^,//;
        !           546:         my @bombs = split(/,/, $errors);
        !           547:         my $errorcount = scalar(@bombs);
        !           548:         my $errorlink = '<a href="/adm/email?display='.
        !           549:                         &Apache::lonnet::escape($bombs[0]).'">'.
        !           550:                         $title.'</a>';
        !           551:         $$bombed{$symb}{errorcount} = $errorcount;
        !           552:         $$bombed{$symb}{errorlink} = $errorlink;
        !           553:         push(@{$bombs}, $symb);
        !           554:     }
        !           555: }
        !           556: 
        !           557: sub check_thresholds {
        !           558:     my ($resource,$symb,$resourcetracker,$triggered,$threshold,$warnings,
        !           559:                                        $warningnum,$rowColor1,$rowColor2) = @_;
        !           560: # Compile maxtries and degree of difficulty for problem parts, unless handgradeable
        !           561:     my @parts = @{$resource->parts()};
        !           562:     my %stats;
        !           563:     my %lastreset = ();
        !           564:     my $warning = 0;
        !           565:     my $rowColor;
        !           566:     foreach my $part (@parts) {
        !           567:         if ($resource->handgrade($part) eq 'yes') {
        !           568:             next;
        !           569:         }
        !           570:         %{$stats{$part}} = ();
        !           571:         my ($attempts,$users,$corrects,$degdiff,$av_attempts);
        !           572:         if (exists($$resourcetracker{$symb."\0".$part."\0attempts"})) {
        !           573:             $attempts = $$resourcetracker{$symb."\0".$part."\0attempts"};
        !           574:         }
        !           575:         if (exists($$resourcetracker{$symb."\0".$part."\0users"})) {
        !           576:             $users = $$resourcetracker{$symb."\0".$part."\0users"};
        !           577:         }
        !           578:         if (exists($$resourcetracker{$symb."\0".$part."\0correct"})) {
        !           579:             $corrects = $$resourcetracker{$symb."\0".$part."\0correct"};
        !           580:         }
        !           581:         if ($attempts > 0) {
        !           582:             $degdiff =  1 - ($corrects/$attempts);
        !           583:             $degdiff = sprintf("%.2f",$degdiff);
        !           584:         }
        !           585:         if ($users > 0) {
        !           586:             $av_attempts = $attempts/$users;
        !           587:             $av_attempts = sprintf("%.2f",$av_attempts);
        !           588:         }
        !           589:         if ((($degdiff ne '' && $degdiff >= $$threshold{'degdiff'}) || ($av_attempts ne '' && $av_attempts >= $$threshold{'av_attempts'})) && ($users >= $$threshold{'numstudents'})) {
        !           590:             $stats{$part}{degdiff} = $degdiff;
        !           591:             $stats{$part}{attempts} = $av_attempts;
        !           592:             $stats{$part}{users} = $users;
        !           593:             $lastreset{$part} = $$resourcetracker{$symb."\0".$part."\0resettime"};
        !           594:             if ($lastreset{$part}) {
        !           595:                 $lastreset{$part} = &Apache::lonnavmaps::timeToHumanString($lastreset{$part});
1.11      raeburn   596:             }
1.33    ! raeburn   597:             $warning = 1;
        !           598:         }
        !           599:     }
        !           600:     if ($warning) {
        !           601:         if ($$warningnum %2 == 1) {
        !           602:             $rowColor = $rowColor1;
        !           603:         } else {
        !           604:             $rowColor = $rowColor2;
        !           605:         }
        !           606:         $$triggered{$symb}{title} = $resource->title;
        !           607:         foreach my $part (@parts) {
        !           608:             if (exists($stats{$part}{users})) {
        !           609:                 my $resetname = 'reset_'.&Apache::lonnet::escape($symb."\0".$part);
        !           610:                 my $resettitle = 'title_'.&Apache::lonnet::escape($symb."\0".$part);
        !           611:                 if ($$triggered{$symb}{numparts}) {
        !           612:                     $$triggered{$symb}{text} .= '<tr bgcolor="'.$rowColor.'">'."\n";
        !           613:                 }
        !           614:                 if (@parts > 1) {
        !           615:                     $$triggered{$symb}{text} .= '
        !           616:                      <td align="right"><small>part - '.$part.'<small></td>';
        !           617:                 } else {
1.11      raeburn   618:                     $$triggered{$symb}{text} .= '
1.33    ! raeburn   619:                      <td align="right"><small>single part</small></td>';
1.11      raeburn   620:                 }
1.33    ! raeburn   621:                 $$triggered{$symb}{text} .= '
        !           622:                      <td align="right"><small>'.$stats{$part}{users}.'</small></td>
        !           623:                      <td align="right"><small>'.$stats{$part}{attempts}.'</small></td>
        !           624:                      <td align="right"><small>'.$stats{$part}{degdiff}.'</small></td>
        !           625:                      <td align="right"><small>'.$lastreset{$part}.'</small></td>
        !           626:                      <td align="right"><small><input type="checkbox" name="'.$resetname.'" /><input type="hidden" name="'.$resettitle.'" value="'.&Apache::lonnet::escape($$triggered{$symb}{title}).'" /></td>
        !           627:                     </tr>';
        !           628:                 $$triggered{$symb}{numparts} ++;
1.11      raeburn   629:             }
                    630:         }
1.33    ! raeburn   631:         push(@{$warnings},$symb);
        !           632:         $$warningnum ++;
1.1       raeburn   633:     }
                    634: }
                    635: 
1.33    ! raeburn   636: 
1.13      raeburn   637: sub get_curr_thresholds {
                    638:     my ($threshold,$cdom,$crs) = @_;
                    639:     my %coursesettings = &Apache::lonnet::dump('environment',
                    640:                                      $cdom,$crs,'internal.threshold');
                    641:     if (exists($coursesettings{'internal.threshold_av_attempts'})) {
                    642:         $$threshold{'av_attempts'} = $coursesettings{'internal.threshold_av_attempts'};
                    643:     }
                    644:     if (exists($coursesettings{'internal.threshold_degdiff'})) {
                    645:         $$threshold{'degdiff'} = $coursesettings{'internal.threshold_degdiff'};
                    646:     }
                    647:     if (exists($coursesettings{'internal.threshold_numstudents'})) {
                    648:         $$threshold{'numstudents'} = $coursesettings{'internal.threshold_numstudents'};
                    649:     }
                    650: }
                    651: 
                    652: sub process_reset {
                    653:     my ($dom,$crs) = @_;
                    654:     my $result = '<b>Counters reset for following problems (and parts):</b><br />';
                    655:     my @agg_types = ('attempts','users','correct');
                    656:     my %agg_titles = (
                    657:                      attempts => 'Number of submissions',
                    658:                      users => 'Students with submissions',
                    659:                      correct => 'Number of correct submissions',
                    660:                      );
                    661:     my @resets = ();
                    662:     my %titles = ();
1.17      albertel  663:     foreach my $key (keys(%env)) {
1.13      raeburn   664:         next if ($key !~ /^form\.reset_(.+)$/);
                    665:         my $title = &Apache::lonnet::unescape($env{'form.title_'.$1});
                    666:         my $reset_item = &Apache::lonnet::unescape($1);
                    667:         my %curr_aggregates = &Apache::lonnet::dump('nohist_resourcetracker',$dom,$crs,$reset_item);
                    668:         my %aggregates = ();
1.17      albertel  669:         my ($symb,$part) = split(/\0/,$reset_item);
1.13      raeburn   670:         foreach my $type (@agg_types) {
                    671:             $aggregates{$reset_item."\0".$type} = 0;
                    672:         }  
1.17      albertel  673: 	$aggregates{$reset_item."\0".'resettime'} = time;
1.13      raeburn   674:         my $putresult = &Apache::lonnet::put('nohist_resourcetracker',\%aggregates,
                    675:                           $dom,$crs);
                    676:         if ($putresult eq 'ok') {
                    677:             $result .= $title.' -part '.$part.': ';
                    678:             my %new_aggregates = &Apache::lonnet::dump('nohist_resourcetracker',$dom,$crs,$reset_item);
                    679:             foreach my $type (@agg_types) {
                    680:                 $result .= $agg_titles{$type}.' = '.$new_aggregates{$reset_item."\0".$type}.'; ';
                    681:             }
                    682:             $result =~ s/; $//;
                    683:             $result .= '<br />';
                    684:         } else {
1.14      albertel  685:             $result = $title.' -part '.$part.': '.&mt('Unable to reset counters to zero due to [_1]',$putresult).'.<br />'."\n";
1.13      raeburn   686:         }
                    687:     }
                    688:     return $result;
                    689: }
                    690: 
                    691: sub process_update {
                    692:     my ($dom,$crs,$threshold_titles) = @_;
1.15      raeburn   693:     my $setoutput = '<b>Changes to threshold(s) for problem tracking:</b><br />';
1.13      raeburn   694:     foreach (keys %env) {
                    695:         next if ($_!~/^form\.(.+)\_setparmval$/);
                    696:         my $name  = $1;
                    697:         my $value = $env{'form.'.$name.'_value'};
                    698:         if ($name && defined($value)) {
                    699:             my $put_result = &Apache::lonnet::put('environment',
                    700:                                                   {$name=>$value},$dom,$crs);
                    701:            
                    702:             my ($shortname) = ($name =~ /^internal\.threshold_(.+)$/); 
                    703:             if ($put_result eq 'ok') {
1.14      albertel  704:                 $setoutput.=&mt('Set threshold for [_1] to [_2]',
                    705: 				'<b>'.$$threshold_titles{$shortname}.'</b>',
                    706: 				'<b>'.$value.'</b>').'<br />';
                    707: 	    } else {
                    708:                 $setoutput.=&mt('Unable to set threshold for [_1] to [_2] due to [_3].',
                    709: 				'<b>'.$name.'</b>','<b>'.$value.'</b>',
                    710: 				'<tt>'.$put_result.'</tt>').'<br />';
1.13      raeburn   711:             }
                    712:         }
                    713:     }
                    714:     return $setoutput;
                    715: }
                    716: 
1.33    ! raeburn   717: sub getnormalmail {
        !           718:     my ($newmsgs) = @_;
1.1       raeburn   719: # Check for unread mail in course
                    720:     my $msgcount = 0;
1.3       albertel  721: 
1.10      raeburn   722:     my @messages = sort(&Apache::lonnet::getkeys('nohist_email'));
1.3       albertel  723:     foreach my $message (@messages) {
                    724: 	my $msgid=&Apache::lonnet::escape($message);
1.10      raeburn   725:         my ($sendtime,$shortsubj,$fromname,$fromdom,$status,$fromcid)=
1.1       raeburn   726:             &Apache::lonmsg::unpackmsgid($msgid);
1.10      raeburn   727:         if (($fromcid) && ($fromcid eq $env{'request.course.id'})) {
1.1       raeburn   728:             if (defined($sendtime) && $sendtime!~/error/) {
                    729:                 my $numsendtime = $sendtime;
                    730:                 $sendtime = &Apache::lonlocal::locallocaltime($sendtime);
                    731:                 if ($status eq 'new') {
1.10      raeburn   732:                     $msgcount ++;
                    733:                     if ($shortsubj eq '') {
                    734:                         $shortsubj = &mt('No subject');
                    735:                     }
                    736:                     $shortsubj = &Apache::lonnet::unescape($shortsubj);
1.1       raeburn   737:                     push(@{$newmsgs}, {
                    738:                         msgid    => $msgid,
                    739:                         sendtime => $sendtime,
1.10      raeburn   740:                         shortsub => $shortsubj,
1.1       raeburn   741:                         from     => $fromname,
                    742:                         fromdom  => $fromdom
                    743:                         });
                    744:                 }
                    745:             }
                    746:         }
                    747:     }
1.33    ! raeburn   748:     return $msgcount;
        !           749: }
1.1       raeburn   750: 
1.33    ! raeburn   751: sub getcritmail {
        !           752:     my ($critmsgs) = @_; 
1.1       raeburn   753: # Check for critical messages in course
                    754:     my %what=&Apache::lonnet::dump('critical');
                    755:     my $result = '';
                    756:     my $critmsgcount = 0;
1.3       albertel  757:     foreach my $msgid (sort(keys(%what))) {
1.10      raeburn   758:         my ($sendtime,$shortsubj,$fromname,$fromdom,$status,$fromcid)=
                    759:             &Apache::lonmsg::unpackmsgid($msgid);
                    760:         if (($fromcid) && ($fromcid eq  $env{'request.course.id'})) {
1.1       raeburn   761:             if (defined($sendtime) && $sendtime!~/error/) {
                    762:                 my $numsendtime = $sendtime;
                    763:                 $sendtime = &Apache::lonlocal::locallocaltime($sendtime);
                    764:                 $critmsgcount ++;
1.10      raeburn   765:                 if ($shortsubj eq '') {
                    766:                     $shortsubj = &mt('No subject');
                    767:                 }
                    768:                 $shortsubj = &Apache::lonnet::unescape($shortsubj);
1.1       raeburn   769:                 push(@{$critmsgs}, {
                    770:                         msgid    => $msgid,
                    771:                         sendtime => $sendtime,
1.10      raeburn   772:                         shortsub => $shortsubj,
1.1       raeburn   773:                         from     => $fromname,
                    774:                         fromdom  => $fromdom
                    775:                         });
                    776:             }
                    777:         }
                    778:     }
1.33    ! raeburn   779:     return $critmsgcount;
        !           780: }
        !           781: 
        !           782: 
        !           783: sub checkversions {
        !           784:     my ($cdom,$crs,$navmap,$changed,$starttime) = @_;
        !           785:     my %changes=&Apache::lonnet::dump('versionupdate',$cdom,$crs);
        !           786:     my ($tmp) = keys(%changes);
        !           787:     if ($tmp =~/^error\:/) {
        !           788:         &Apache::lonnet::logthis('Error retrieving version update information: '.
        !           789:         $tmp.' for '.$cdom.'_'.$crs.' in whatsnew');
        !           790:     } else {
        !           791:         if (keys(%changes) > 0) {
        !           792:             foreach my $key (sort(keys(%changes))) {
        !           793:                 if ($changes{$key} > $starttime) {
        !           794:                     my $version;
        !           795:                     my ($root,$extension)=($key=~/^(.*)\.(\w+)$/);
        !           796:                     my $currentversion=&Apache::lonnet::getversion($key);
        !           797:                     my $revdate = 
        !           798:                           &Apache::lonnet::metadata($root.'.'.$extension,
        !           799:                                                      'lastrevisiondate');
        !           800:                     print STDERR "revdate for $root and $extension is $revdate\n";
        !           801:                     $revdate =  &Apache::lonlocal::locallocaltime($revdate);
        !           802:                     my $linkurl=&Apache::lonnet::clutter($key);
        !           803:                     my $usedversion=$navmap->usedVersion('version_'.$linkurl);
        !           804:                     my @resources = $navmap->getResourceByUrl($linkurl,1);
        !           805:                     if (($usedversion) && ($usedversion ne 'mostrecent')) {
        !           806:                         $version = $usedversion;     
        !           807:                     } else {
        !           808:                         $version = $currentversion;
        !           809:                     }
        !           810:                     foreach my $res (@resources) {
        !           811:                         my $symb = $res->symb();
        !           812:                         %{$$changed{$symb}} = (
        !           813:                                                 current => $currentversion,
        !           814:                                                 version => $version,
        !           815:                                                 revdate => $revdate,
        !           816:                         );
        !           817:                     }
        !           818:                 }
        !           819:             }
        !           820:         }
        !           821:     }
        !           822:     return;
        !           823: }
        !           824: 
        !           825: sub display_handgrade {
        !           826:     my ($r,$tograde,$rowColor1,$rowColor2,$ungraded) = @_;
        !           827:     my $rowColor;
        !           828:     my %lt = &Apache::lonlocal::texthash(
        !           829:                         'prna' => 'Problem Name',
        !           830:                         'nmun' => 'Number ungraded',
        !           831:                         'nopr' => 'No problems require handgrading',
        !           832:     );
        !           833:     if (@{$tograde} > 0) {
        !           834:         $r->print('<tr bgcolor="#cccccc"><td><b><small>'.$lt{'prna'}.'</small></b></td><td align="right"><b><small>'.$lt{'nmun'}.'</small></b></td></tr>');
        !           835:         my $rowNum = 0;
        !           836:         foreach my $res (@{$tograde}) {
        !           837:             if ($rowNum %2 == 1) {
        !           838:                 $rowColor = $rowColor1;
        !           839:             } else {
        !           840:                 $rowColor = $rowColor2;
        !           841:             }
        !           842:             my ($map,$id,$url)=&Apache::lonnet::decode_symb($res);
        !           843:             my $linkurl=&Apache::lonnet::clutter($url);
        !           844:             $linkurl .= '?symb='.&Apache::lonnet::escape($res);
        !           845:                                                                                
        !           846:             $r->print('<tr bgcolor="'.$rowColor.'"><td><a href="'.$linkurl.'"><small>'.$$ungraded{$res}{title}.'</small></a></td><td align="right"><small>'.$$ungraded{$res}{count}.'</small></td></tr>');
        !           847:             $rowNum ++;
        !           848:         }
        !           849:     } else {
        !           850:         $r->print('<tr><td bgcolor="#ffffff"><br><center><i><b><small>&nbsp;&nbsp;'.$lt{'nopr'}.'&nbsp;&nbsp;</small><br><br></b></i></td></tr>');
        !           851:     }
        !           852: }
        !           853: 
        !           854: sub display_haserrors {
        !           855:     my ($r,$bombs,$rowColor1,$rowColor2,$bombed,$res_title) = @_;
        !           856:     my $bombnum = 0;
        !           857:     my $rowColor;
        !           858:     my %lt = &Apache::lonlocal::texthash(
        !           859:                                    reso => 'Resource',
        !           860:                                    nmer => 'Number of errors',
        !           861:                                    noer => 'No problems with errors',
        !           862:     );
        !           863:     if (@{$bombs} > 0) {
        !           864:         $r->print('<tr bgcolor="#cccccc"><td><b><small>'.$lt{'reso'}.'</small></b></td><td align="right"><b><small>'.$lt{'nmer'}.'</small></b></td></tr>');
        !           865:         @{$bombs} = sort { &cmp_title($a,$b,$res_title) } @{$bombs};
        !           866:         foreach my $bomb (@{$bombs}) {
        !           867:             if ($bombnum %2 == 1) {
        !           868:                 $rowColor = $rowColor1;
        !           869:             } else {
        !           870:                 $rowColor = $rowColor2;
        !           871:             }
        !           872:             $r->print('<tr bgcolor="'.$rowColor.'"><td><small>'.$$bombed{$bomb}{errorlink}.'</small></td><td align="right"><small>'.$$bombed{$bomb}{errorcount}.'</small></td></tr>');
        !           873:             $bombnum ++;
        !           874:         }
        !           875:     } else {
        !           876:         $r->print('<tr><td bgcolor="#ffffff"><br /><center><b><i><small>'.$lt{'noer'}.'</small></i></b></center><br /></td></tr>');
        !           877:     }
        !           878:     return;
        !           879: }
        !           880: 
        !           881: sub display_abovethreshold {
        !           882:     my ($r,$warnings,$triggered,$res_title,$rowColor1,$rowColor2) = @_;
        !           883:     my %lt = &Apache::lonlocal::texthash(
        !           884:                  reso => 'Resource',
        !           885:                  part => 'Part',
        !           886:                  nust => 'Num. students',
        !           887:                  avat => 'Av. Attempts',
        !           888:                  dedi => 'Deg. Diff',
        !           889:                  lare => 'Last Reset',
        !           890:                  reco => 'Reset Count?',
        !           891:                  rese => 'Reset counters to 0',
        !           892:                  nopr => 'No problems satisfy threshold criteria',
        !           893:     );
        !           894:     my $rowColor; 
        !           895:     my $warningnum = 0;
        !           896:     if (@{$warnings} > 0) {
        !           897:         @{$warnings} = sort { &cmp_title($a,$b,$res_title) } @{$warnings};
        !           898:         $r->print('<form name="reset_tracking" method="post">'.
        !           899:                 '  <input type="hidden" name="action" value="reset" />'."\n");
        !           900:         $r->print('<tr bgcolor="#cccccc"><td><b><small>'.$lt{'reso'}.'</small></b></td><td align="right"><b><small>'.$lt{'part'}.'</small></b></td><td align="right"><b><small>'.$lt{'nust'}.'</small></b></td><td align="right"><b><small>'.$lt{'avat'}.'</small></b></td><td align="right"><b><small>'.$lt{'dedi'}.'</small></b></td><td align="right"><b><small>'.$lt{'lare'}.'</small></b></td><td align="right"><b><small>'.$lt{'reco'}.'</small></b></td></tr>');
        !           901:         foreach my $res (@{$warnings}) {
        !           902:             if ($warningnum %2 == 1) {
        !           903:                 $rowColor = $rowColor1;
        !           904:             } else {
        !           905:                 $rowColor = $rowColor2;
        !           906:             }
        !           907:             my ($map,$id,$url)=&Apache::lonnet::decode_symb($res);
        !           908:             my $linkurl=&Apache::lonnet::clutter($url);
        !           909:             my $rowspan;
        !           910:             if ($$triggered{$res}{numparts} > 1) {
        !           911:                 $rowspan = 'rowspan="'.$$triggered{$res}{numparts}.'"';
        !           912:             }
        !           913:             $linkurl .= '?symb='.&Apache::lonnet::escape($res);
        !           914:             $r->print('<tr bgcolor="'.$rowColor.'"><td '.$rowspan.'><a href="'.$linkurl.'"><small>'.$$triggered{$res}{title}.'</small></a></td>'.$$triggered{$res}{text});
        !           915:             $warningnum ++;
        !           916:         }
        !           917:         $r->print('<tr bgcolor="#cccccc"><td colspan="7" align="right"><br /><b><small><input type="submit" name="counters" value="'.$lt{'rese'}.'/></form>');
        !           918:     } else {
        !           919:         $r->print('<tr><td bgcolor="#ffffff"><br /><center><b><i><small>'.$lt{'nopr'}.'</small></i></b></center><br /></td></tr>');
        !           920:     }
        !           921: }
        !           922: 
        !           923: sub display_versionchanges {
        !           924:     my ($r,$changed,$res_title,$rowColor1,$rowColor2,$interval) = @_;
        !           925:     my %lt = &Apache::lonlocal::texthash(
        !           926:         'reso' => 'Resource',
        !           927:         'revd' => 'Last revised',
        !           928:         'newv' => 'New version',
        !           929:         'veru' => 'Version used',
        !           930:         'noup' => 'No updated versions', 
        !           931:     );
        !           932:     my $rowColor;
        !           933:     if (keys(%{$changed}) > 0) {
        !           934:         $r->print('<tr bgcolor="#cccccc"><td><b><small>'.$lt{'reso'}.'</small></b></td><td><b><small>'.$lt{'revd'}.'</small></b></td><td><b><small>'.$lt{'newv'}.'</small></b></td><td><b><small>'.$lt{'veru'}.'</small></b></td></tr>');
        !           935:         
        !           936:         
        !           937:         my @changes = sort { &cmp_title($a,$b,$res_title) } keys(%{$changed});
        !           938:         my $changenum = 0;
        !           939:         foreach my $item (@changes) {
        !           940:             if ($changenum %2 == 1) {
        !           941:                 $rowColor = $rowColor1;
        !           942:             } else {
        !           943:                 $rowColor = $rowColor2;
        !           944:             }
        !           945:             my ($map,$id,$url)=&Apache::lonnet::decode_symb($item);
        !           946:             my $linkurl=&Apache::lonnet::clutter($url);
        !           947:             $linkurl .= '?symb='.&Apache::lonnet::escape($item);
        !           948: 
        !           949:             $r->print('<tr bgcolor="'.$rowColor.'"><td><small><a href="'.$linkurl.'">'.$$res_title{$item}.'</a></small></td><td><small>'.$$changed{$item}{'revdate'}.'</small></td><td><small>'.$$changed{$item}{'current'}.'</small></td><td><small>'.$$changed{$item}{'version'}.'</small></td></tr>');
        !           950:             $changenum ++;
        !           951:         }
        !           952:     } else {
        !           953:         $r->print('<tr><td bgcolor="#ffffff"><br /><center><b><i><small>'.$lt{'noup'}.' '.$interval.'</small></i></b></center><br /></td></tr>');
        !           954:     }
        !           955:     return;
        !           956: }
        !           957:  
        !           958: sub display_coursediscussion {
        !           959:     my ($r,$newdiscussions,$unread,$res_title,$rowColor1,$rowColor2) = @_;
        !           960:     my %lt = &Apache::lonlocal::texthash(
        !           961:                 'loca' => 'Location',
        !           962:                 'type' => 'Type',
        !           963:                 'numn' => 'Number of new posts',
        !           964:                 'noun' => 'No unread posts in course discussions',
        !           965:     );
        !           966:     my $rowColor;
        !           967:     if (@{$newdiscussions} > 0) {
        !           968:         $r->print('<tr bgcolor="#cccccc"><td><b><small>'.$lt{'loca'}.
        !           969:                   '</small></b></td><td><b><small>'.$lt{'type'}.
        !           970:                   '</small></b><td align="right"><b><small>'.$lt{'numn'}.
        !           971:                   '</small></b></td></tr>');
        !           972:         @{$newdiscussions} = sort { &cmp_title($a,$b,$res_title) }
        !           973:                                                             @{$newdiscussions};
        !           974:         my $rowNum = 0;
        !           975:         foreach my $ressymb (@{$newdiscussions}) {
        !           976:             my $forum_title = $$unread{$ressymb}{'title'};
        !           977:             my $type = 'Resource';
        !           978:             my $feedurl=&Apache::lonfeedback::get_feedurl($ressymb);
        !           979:             if ($feedurl =~ /bulletinboard/) {
        !           980:                 $type = 'Bulletin Board';
        !           981:             }
        !           982:             my $unreadnum = keys(%{$$unread{$ressymb}});
        !           983:             $unreadnum = $unreadnum - 2;
        !           984:             if ($unreadnum > 0) {
        !           985:                 if ($rowNum %2 == 1) {
        !           986:                     $rowColor = $rowColor1;
        !           987:                 } else {
        !           988:                     $rowColor = $rowColor2;
        !           989:                 }
        !           990:                 $r->print('<tr bgcolor="'.$rowColor.'"><td><small><a href="'.$feedurl.'?symb='.$$unread{$ressymb}{symb}.'">'.$forum_title.'</a>&nbsp;</td><td><small>'.$type.'</small></td><td align="right">'.$unreadnum.'&nbsp;</td></tr>');
        !           991:                 $rowNum ++;
        !           992:             }
        !           993:         }
        !           994:     } else {
        !           995:         $r->print('<tr><td bgcolor="#ffffff"><br><center>&nbsp;<i><b><small>'.
        !           996:                   $lt{'noun'}.'</small></b></i><br><br></td></tr>');
        !           997:     }
        !           998: }
        !           999: 
        !          1000: sub display_coursenormalmail {
        !          1001:     my ($r,$msgcount,$newmsgs,$rowColor1,$rowColor2) = @_;
        !          1002:     my $rowColor;
        !          1003:     if ($msgcount > 0) {
        !          1004:         $r->print('<tr bgcolor="#cccccc"><td><b><small>'.&mt('Number').'</small></b></td><td><b><small>'.&mt('Subject').'</small></b></td><td><b><small>'.&mt('Sender').'</small></b></td><td><b><small>'.&mt('Date/Time').'</small></b></td></tr>');
        !          1005:         my $rowNum = 0;
        !          1006:         my $mailcount = 1;
        !          1007:         foreach my $msg (@{$newmsgs}) {
        !          1008:             if ($rowNum %2 == 1) {
        !          1009:                 $rowColor = $rowColor1;
        !          1010:             } else {
        !          1011:                 $rowColor = $rowColor2;
        !          1012:             }
        !          1013:             $r->print('<tr bgcolor="'.$rowColor.'"><td valign="top"><small>'.$mailcount.'. &nbsp;</small></td><td valign="top"><small><a href="/adm/communicate">'.$msg->{'shortsub'}.'</a>&nbsp; &nbsp;</small></td><td valign="top"><small>&nbsp;'.$msg->{'from'}.'@'.$msg->{'fromdom'}.'&nbsp;</small></td><td valign="top"><small>'.$msg->{'sendtime'}.'</small></td></tr>');
        !          1014:             $rowNum ++;
        !          1015:             $mailcount ++;
        !          1016:         }
        !          1017:     } else {
        !          1018:         $r->print('<tr><td bgcolor="#ffffff" width="100%"><center><br /><b><i><small>'.&mt('No new course messages').'</small></i></b><br /><br /></center></td></tr>');
        !          1019:     }
        !          1020: }
        !          1021: 
        !          1022: sub display_coursecritmail {
        !          1023:     my ($r,$critmsgcount,$critmsgs,$rowColor1,$rowColor2) = @_;
        !          1024:     my $rowColor;
        !          1025:     if ($critmsgcount > 0) {
        !          1026:         $r->print('<tr bgcolor="#cccccc"><td><b><small>'.&mt('Number').'</small></b></td><td><b><small>'.&mt('Subject').'</small></b></td><td><b><small>'.&mt('Sender').'</small></b></td><td><b><small>'.&mt('Date/Time').'</small></b></td></tr>');
        !          1027:         my $rowNum = 0;
        !          1028:         my $mailcount = 1;
        !          1029:         foreach my $msg (@{$critmsgs}) {
        !          1030:             if ($rowNum %2 == 1) {
        !          1031:                 $rowColor = $rowColor1;
        !          1032:             } else {
        !          1033:                 $rowColor = $rowColor2;
        !          1034:             }
        !          1035:             $r->print('<tr bgcolor="'.$rowColor.'"><td valign="top"><small>'.$mailcount.'. &nbsp;<small></td><td valign="top"><small><a href="/adm/email?folder=critical">'.$msg->{'shortsub'}.'</a>&nbsp; &nbsp;</small></td><td valign="top"><small>&nbsp;'.$msg->{'from'}.'@'.$msg->{'fromdom'}.'&nbsp;</small></td><td valign="top"><small>'.$msg->{'sendtime'}.'</small></td></tr>');
        !          1036:             $rowNum ++;
        !          1037:             $mailcount ++;
        !          1038:         }
        !          1039:     } else {
        !          1040:         $r->print('<tr><td bgcolor="#ffffff" width="100%"><center><br /><b><i><small>'.&mt('No unread critical messages in course').'</small></i></b><br /><br /></center></td></tr>');
        !          1041:     }
1.1       raeburn  1042: }
                   1043: 
                   1044: sub cmp_title {
1.16      raeburn  1045:     my ($a,$b,$res_title) = @_;
                   1046:     my ($atitle,$btitle) = (lc($$res_title{$a}),lc($$res_title{$b}));
1.1       raeburn  1047:     $atitle=~s/^\s*//;
                   1048:     $btitle=~s/^\s*//;
                   1049:     return $atitle cmp $btitle;
                   1050: }
                   1051: 
1.33    ! raeburn  1052: sub get_display_settings {
        !          1053:     my $udom = $env{'user.domain'};
        !          1054:     my $uname = $env{'user.name'};
        !          1055:     my $cid = $env{'request.course.id'};
        !          1056:     my %settings = &Apache::lonnet::dump('nohist_whatsnew',$udom,$uname,$cid); 
        !          1057:     my ($tmp) = keys(%settings);
        !          1058:     if ($tmp=~/^error:/) {
        !          1059:         %settings = ();
        !          1060:         unless ($tmp eq 'error: 2 tie(GDBM) Failed while attempting dump') {
        !          1061:             &logthis('Error retrieving whatsnew settings: '.$tmp.' for '.
        !          1062:                                 $uname.':'.$udom.' for course: '.$cid);
        !          1063:         }
        !          1064:     }
        !          1065:     return %settings;
        !          1066: }
        !          1067: 
        !          1068: sub start_box {
        !          1069:     my ($r,$tabbg,$show,$heading,$caller) = @_;
        !          1070:     my %lt = &Apache::lonlocal::texthash( 
        !          1071:                        chth => 'Change thresholds?',
        !          1072:                        chin => 'Change interval?',
        !          1073:     );
        !          1074:     my $showhide;
        !          1075:     if ($$show{$caller}) {
        !          1076:         $showhide = '<b><a href="javascript:change_display('."'".$caller.
        !          1077:                                            "','hide'".');">Hide</a></b>';
        !          1078:    
        !          1079:     } else {
        !          1080:         $showhide = '<b><a href="javascript:change_display('."'".$caller.
        !          1081:                                             "','show'".');">Show</a></b>';
        !          1082:     }
        !          1083:     
        !          1084:     $r->print('
        !          1085:          <table border="0" cellpadding="0" cellspacing="0" bgcolor="#000000" width="100%">
        !          1086:           <tr>
        !          1087:            <td>
        !          1088:             <table border="0" cellpadding="1" cellspacing="1" bgcolor="#000000" width="100%">
        !          1089:               <tr>
        !          1090:                <td bgcolor="'.$tabbg.'">
        !          1091:                 <table width="100%" border="0" cellspacing="0" cellpadding="0">
        !          1092:                  <tr>
        !          1093:                   <td><b>'.$$heading{$caller}.'</b></td>
        !          1094:                   <td valign="top" align="right">'.$showhide.'</td>
        !          1095:                  </tr>
        !          1096:                 </table>
        !          1097:                </td>
        !          1098:               </tr>');
        !          1099:      if (($caller eq 'abovethreshold') && ($$show{$caller})) {
        !          1100:          $r->print('
        !          1101:               <tr>
        !          1102:                 <td bgcolor="'.$tabbg.'" align="right"><a href="/adm/whatsnew?command=chgthreshold"><b><small>'.$lt{'chth'}.'</small></b></a></td>
        !          1103:               </tr>');
        !          1104:      } elsif (($caller eq 'versionchanges') && ($$show{$caller})) {
        !          1105:          $r->print('
        !          1106:               <tr>
        !          1107:                 <td bgcolor="'.$tabbg.'" align="right"><a href="/adm/whatsnew?command=chginterval"><b><small>'.$lt{'chin'}.'</small></b></a></td>
        !          1108:               </tr>');
        !          1109:      }
        !          1110:      $r->print('
        !          1111:               <tr>
        !          1112:                <td bgcolor="#ffffff">
        !          1113:                 <table cellpadding="2" cellspacing="0" border="0" width="100%">
        !          1114: ');
        !          1115:     return;
        !          1116: }
        !          1117: 
        !          1118: sub end_box {
        !          1119:     my ($r) = shift;
        !          1120:     $r->print('
        !          1121:       </table>
        !          1122:      </td>
        !          1123:     </tr>
        !          1124:    </table>
        !          1125:   </td>
        !          1126:  </tr>
        !          1127: </table><br />');
        !          1128:     return;
        !          1129: }
        !          1130: 
1.7       raeburn  1131: 1;

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>