File:  [LON-CAPA] / loncom / interface / lonwhatsnew.pm
Revision 1.17: download - view: text, annotated - select for diffs
Sat Jun 4 03:36:36 2005 UTC (19 years ago) by albertel
Branches: MAIN
CVS tags: HEAD
- chanign it so that no longer storing and restoring to a putted DB

#
# $Id: lonwhatsnew.pm,v 1.17 2005/06/04 03:36:36 albertel 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::Constants qw(:common :http);
use Time::Local;

#----------------------------
# handler
#
#----------------------------

sub handler {
    my $r = shift;
    if ($r->header_only) {
        &Apache::loncommon::content_type($r,'text/html');
        $r->send_http_header;
        return OK;
    }
    &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},['command']);

    my $command;
    if ($env{'form.action'} eq 'reset') {
        $command = 'reset';
    } elsif ($env{'form.action'} eq 'update') {
        $command = 'update';
    } else {
        $command = $env{'form.command'};
    }

    &Apache::loncommon::content_type($r,'text/html');
    $r->send_http_header;
    $r->print(&display_header());
    if (! (($env{'request.course.fn'}) && (&Apache::lonnet::allowed('vsa',$env{'request.course.id'})))) {
        # Not in a course, or not allowed to modify parms
        $env{'user.error.msg'}="/adm/whatsnew:vsa:0:0:Cannot display student activity";
        return HTTP_NOT_ACCEPTABLE;
    }

    &Apache::lonhtmlcommon::clear_breadcrumbs();
    if ($command eq 'chgthreshold') {
        &Apache::lonhtmlcommon::add_breadcrumb
            ({href=>'/adm/whatsnew?command=threshold',
              text=>"Change thresholds"});
        $r->print(&Apache::lonhtmlcommon::breadcrumbs
            (undef,'Course Action Items','Course_Action_Items_Thresholds'));
    } else {
        &Apache::lonhtmlcommon::add_breadcrumb
            ({href=>'/adm/whatsnew',
              text=>"Display Action Items"});
        $r->print(&Apache::lonhtmlcommon::breadcrumbs
            (undef,'Course Action Items','Course_Action_Items_Display'));
    }
    &display_main_box($r,$command);
    return OK;
}

#------------------------------
# display_main_box
#
# Display all the elements within the main box
#------------------------------
                                                                                
sub display_main_box {
    my ($r,$command) = @_;
    my $domain=&Apache::loncommon::determinedomain();
    my $tabbg=&Apache::loncommon::designparm('coordinator.tabbg',$domain);
    $r->print('<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') {
        &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><br />
</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 $rowColor;

    my %unread = ();
    my %ungraded = ();
    my %bombed = ();
    my %triggered = ();
    my @newmsgs = ();
    my @critmsgs = ();
    my @newdiscussions = ();
    my @tograde = ();
    my @bombs = ();
    my @warnings = ();
    my %res_title = ();

    my $domain=&Apache::loncommon::determinedomain();
    my $function;
    if ($env{'request.role'}=~/^(cc|in|ta|ep)/) {
        $function='coordinator';
    }
    if ($env{'request.role'}=~/^(su|dc|ad|li)/) {
        $function='admin';
    }

    my %threshold = (
                      av_attempts => 0,
                      degdiff => 0.01,
                      numstudents => 0,
                     );

    my $pgbg=&Apache::loncommon::designparm($function.'.pgbg',$domain);
    my $tabbg=&Apache::loncommon::designparm($function.'.tabbg',$domain);

    unless ($env{'request.course.id'}) {
        $r->print('<br /><b><center>You are accessing an invalid course</center></b><br /><br />');
        return;
    }

    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%" />');
    }

    &get_curr_thresholds(\%threshold,$cdom,$crs);
    &getitems(\%unread,\%ungraded,\%bombed,\%triggered,\@newdiscussions,\@tograde,\@bombs,\@warnings,$rowColor1,$rowColor2,\%threshold,$cdom,$crs,%res_title);
    my ($msgcount,$critmsgcount) = &getmail(\@newmsgs,\@critmsgs);

    $r->print('<br /><table border="0" width="100%" cellpadding="2" cellspacing="4"><tr><td align="left" valign="top" width="45%">');

## UNGRADED ITEMS ##
    $r->print(<<END);
           <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"><b>Problems requiring handgrading</b></td></tr>
                  <tr>
                   <td bgcolor="#ffffff">
                     <table cellpadding="2" cellspacing="0" border="0" width="100%">
END

    if (@tograde > 0) {
        $r->print('<tr bgcolor="#cccccc"><td><b><small>Problem Name</small></b></td><td align="right"><b><small>Number ungraded</small></b></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.'"><small>'.$ungraded{$res}{title}.'</small></a></td><td align="right"><small>'.$ungraded{$res}{count}.'</small></td></tr>');
            $rowNum ++;
        }
    } else {
        $r->print('<tr><td bgcolor="#ffffff"><br><center><i><b><small>&nbsp;&nbsp;No problems require handgrading&nbsp;&nbsp;</small><br><br></b></i></td></tr>');
    }
    $r->print('</table></td></tr></table></td></tr></table><br />');

## BOMBS ##
     $r->print(<<"END");
           <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"><b>Problems with errors</b></td>
               </tr>
                <tr>
                <td bgcolor="#ffffff">
                 <table width="100%" cellspacing="0" cellpadding="0" border="0">
END
     my $bombnum = 0;
     if (@bombs > 0) {
        $r->print('<tr bgcolor="#cccccc"><td><b><small>Resource</small></b></td><td align="right"><b><small>Number of errors</small></b></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><small>'.$bombed{$bomb}{errorlink}.'</small></td><td align="right"><small>'.$bombed{$bomb}{errorcount}.'</small></td></tr>');
            $bombnum ++;
        }
    } else {
        $r->print('<tr><td bgcolor="#ffffff"><br /><center><b><i><small>No problems with errors</small></i></b></center><br /></td></tr>');
    }
    $r->print('</table></td></tr></table></td></tr></table><br />');

# DEGDIFF AND AV. TRIES TRIGGERS
    $r->print(<<"END");
           <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"><b>Problems with av. attempts &ge; $threshold{'av_attempts'} or deg. difficulty &ge; $threshold{'degdiff'}<br /> and total number of students with submissions &ge; $threshold{'numstudents'}</b></td>
               </tr>
               <tr>
                <td bgcolor="$tabbg" align="right"><a href="/adm/whatsnew?command=chgthreshold"><b><small>Change thresholds?</small></b></a></td>
               </tr>
                <tr>
                <td bgcolor="#ffffff">
                 <table width="100%" cellspacing="2" cellpadding="2" border="0">
END
    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><b><small>Resource</small></b></td><td align="right"><b><small>Part</small></b></td><td align="right"><b><small>Num. students</small></b></td><td align="right"><b><small>Av. Attempts</small></b></td><td align="right"><b><small>Deg. Diff</small></b></td><td align="right"><b><small>Last Reset</small></b></td><td align="right"><b><small>Reset Count?</small></b></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.'"><small>'.$triggered{$res}{title}.'</small></a></td>'.$triggered{$res}{text});
            $warningnum ++;
        }
        $r->print('<tr bgcolor="#cccccc"><td colspan="7" align="right"><br /><b><small><input type="submit" name="counters" value="Reset counters to 0" /></form>'); 
    } else {
        $r->print('<tr><td bgcolor="#ffffff"><br /><center><b><i><small>No problems satisfy threshold criteria.</small></i></b></center><br /></td></tr>');
    }
    $r->print('</table></td></tr></table></td></tr></table><br />');

    $r->print('</td><td width="5%">&nbsp;</td><td align="left" valign="top" width-"50%">');

## UNREAD COURSE DISCUSSION POSTS ##
    $r->print(<<"END");
              <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"><b>Unread course discussion posts</b></td>
                 </tr>
                 <tr>
                   <td bgcolor="#ffffff">
                   <table cellpadding="2" cellspacing="0" border="0" width="100%">
END
                                                                                  
    if (@newdiscussions > 0) {
        $r->print('<tr bgcolor="#cccccc"><td><b><small>Location</small></b></td><td><b><small>Type</small></b><td align="right"><b><small>Number of new posts</small></b></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><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>');
                $rowNum ++;
            }
        }
    } else {
        $r->print('<tr><td bgcolor="#ffffff"><br><center>&nbsp;<i><b><small>No unread posts in course discussions</small></b></i><br><br></td></tr>');
    }
    $r->print('</table></td></tr></table></td></tr></table><br />');

## MESSAGES ##
    $r->print(<<END);
           <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"><b>New course messages</b></td>
               </tr>
               <tr>
                <td bgcolor="#ffffff">
                 <table width="100%" cellspacing="0" cellpadding="0" border="0">
END
    if ($msgcount > 0) {
        $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>');
        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"><small>'.$mailcount.'. &nbsp;<small></td><td valign="top"><small><a href="/adm/mail?">'.$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>');
            $rowNum ++;
            $mailcount ++;
        }
    } else {
        $r->print('<tr><td bgcolor="#ffffff" width="100%"><center><br /><b><i><small>No new course messages</small></i></b><br /><br /></center></td></tr>');
    }

    $r->print('</table></td></tr></table></td></tr></table><br />');

    $r->print(<<END);
           <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"><b>New critical messages in course</b></td>
               </tr>
               <tr>                 <td bgcolor="#ffffff">
                 <table width="100%" cellspacing="0" cellpadding="0" border="0">
END

    if ($critmsgcount > 0) {
        $r->print('<tr bgcolor="#cccccc"><td><b><small>Number</small></b></td><td><b><small>Subject</small></b></td><td><b><small>Sender</small></b></td><td><b><small>Date/Time</small></b></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"><small>'.$mailcount.'. &nbsp;<small></td><td valign="top"><small><a href="/adm/mail?">'.$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>');
            $rowNum ++;
            $mailcount ++;
        }
    } else {
        $r->print('<tr><td bgcolor="#ffffff" width="100%"><center><br /><b><i><small>No unread critical messages in course</small></i></b><br /><br /></center></td></tr>');
    }
                                                                               
    $r->print('</table></td></tr></table></td></tr></table><br />');

    $r->print('
           </table>
          </td>
         </tr>
        </table>');
    $r->print('</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('<br /><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>
           <br /><input type="submit" name="threshold" value="Make changes" />
                 <input type="hidden" name="action" value="update" />
               </form>');
}

sub getitems {
    my ($unread,$ungraded,$bombed,$triggered,$newdiscussions,$tograde,$bombs,$warnings,$rowColor1,$rowColor2,$threshold,$cdom,$crs,$res_title) = @_;
    my $navmap = Apache::lonnavmaps::navmap->new();
    my @allres=$navmap->retrieveResources();
    my %discussiontime = &Apache::lonnet::dump('discussiontimes',$cdom,$crs);
    my %lastread = &Apache::lonnet::dump('nohist_'.$env{'request.course.id'}.
                '_discuss',$env{'user.domain'},$env{'user.name'},'lastread');
    my %lastreadtime = ();
    my @discussions = ();
    my ($classlist,$keylist) = &Apache::loncoursedata::get_classlist();

    my %resourcetracker =  &Apache::lonnet::dump('nohist_resourcetracker',
               $cdom,$crs);
    my $warningnum = 0;
    foreach my $key (keys(%lastread)) {
        my $newkey = $key;
        $newkey =~ s/_lastread$//;
        $lastreadtime{$newkey} = $lastread{$key};
    }
    foreach my $resource (@allres) {
        my $result = '';
        my $applies = 0;
        my $symb = $resource->symb();
#        %{$$bombed{$symb}} = ();
        %{$$ungraded{$symb}} = ();
        %{$$triggered{$symb}} = ();
        $$triggered{$symb}{numparts} = 0;
        my $title = $resource->compTitle();
        $$res_title{$symb} = $title;
        my $ressymb = $resource->wrap_symb();
# Check for unread discussion postings
        if (defined($discussiontime{$ressymb})) {
            push(@discussions,$ressymb);
            my $prevread = 0;
            my $unreadcount = 0;
            %{$$unread{$ressymb}} = ();
            $$unread{$ressymb}{'title'} = $title;
            $$unread{$ressymb}{'symb'} = $symb;
            if (defined($lastreadtime{$ressymb})) {
                $prevread = $lastreadtime{$ressymb};
            }
            my %contrib = &Apache::lonnet::restore($ressymb,
                             $env{'request.course.id'},$cdom,$crs);
            if ($contrib{'version'}) {
                for (my $id=1;$id<=$contrib{'version'};$id++) {
                    unless (($contrib{'hidden'}=~/\.$id\./) || ($contrib{'deleted'}=~/\.$id\./)) {
                        if ($prevread <$contrib{$id.':timestamp'}) {
                            $$unread{$ressymb}{$unreadcount} = $id.': '.$contrib{$id.':subject'};
                            $unreadcount ++;
                        }
                    }
                }
            }
            if ($unreadcount) { push(@{$newdiscussions}, $ressymb); }
	}

# Check for ungraded problems
        if ($resource->is_problem()) {
            my $ctr = 0;
            my ($map,$ind,$url)=&Apache::lonnet::decode_symb($symb);
            my ($partlist,$handgrade,$responseType) = &Apache::grades::response_type($url,$symb);
            foreach my $student (keys(%$classlist)) {
                my ($uname,$udom) = split(/:/,$student);
                my %status=&Apache::grades::student_gradeStatus($url,$symb,$udom,$uname,$partlist);
                my $submitted = 0;
                my $ungraded = 0;
                foreach (keys(%status)) {
                    $submitted = 1 if ($status{$_} ne 'nothing');
                    $ungraded = 1 if ($status{$_} =~ /^ungraded/);
                    my ($foo,$partid,$foo1) = split(/\./,$_);
                    if ($status{'resource.'.$partid.'.submitted_by'} ne '') {
                        $submitted = 0;
                    }
                }
                next if (!$submitted || !$ungraded);
                $ctr ++;
            }
            if ($ctr) {
                $$ungraded{$symb}{count} = $ctr;
                $$ungraded{$symb}{title} = $title;
                push(@{$tograde}, $symb);
            }
        }

# Check for bombs
        if ($resource->getErrors()) {
            my $errors = $resource->getErrors();
            $errors =~ s/^,//;
            my @bombs = split(/,/, $errors);
            my $errorcount = scalar(@bombs);
            my $errorlink = '<a href="/adm/email?display='.
                            &Apache::lonnet::escape($bombs[0]).'">'.
                            $title.'</a>';
            $$bombed{$symb}{errorcount} = $errorcount;
            $$bombed{$symb}{errorlink} = $errorlink;
            push(@{$bombs}, $symb);
        }
# Compile maxtries and degree of difficulty for problem parts
        my @parts = @{$resource->parts()};
        my %stats;
        my %lastreset = ();
        my $warning = 0;
        my $rowColor;
        foreach my $part (@parts) {
            %{$stats{$part}} = ();
            my ($attempts,$users,$corrects,$degdiff,$av_attempts);
            if (exists($resourcetracker{$symb."\0".$part."\0attempts"})) {
                $attempts = $resourcetracker{$symb."\0".$part."\0attempts"};
            }
            if (exists($resourcetracker{$symb."\0".$part."\0users"})) {
                $users = $resourcetracker{$symb."\0".$part."\0users"};
            }
            if (exists($resourcetracker{$symb."\0".$part."\0correct"})) {
                $corrects = $resourcetracker{$symb."\0".$part."\0correct"};
            }
            if ($attempts > 0) {
                $degdiff =  1 - ($corrects/$attempts);
                $degdiff = sprintf("%.2f",$degdiff);
            }
            if ($users > 0) {
                $av_attempts = $attempts/$users;
                $av_attempts = sprintf("%.2f",$av_attempts);
            }
            if ((($degdiff ne '' && $degdiff >= $$threshold{'degdiff'}) || ($av_attempts ne '' && $av_attempts >= $$threshold{'av_attempts'})) && ($users >= $$threshold{'numstudents'})) {
                $stats{$part}{degdiff} = $degdiff;
                $stats{$part}{attempts} = $av_attempts;
                $stats{$part}{users} = $users;
		$lastreset{$part} = $resourcetracker{$symb."\0".$part."\0resettime"};
                $warning = 1;
            }
        }
        if ($warning) {
            if ($warningnum %2 == 1) {
                $rowColor = $rowColor1;
            } else {
                $rowColor = $rowColor2;
            }
            $$triggered{$symb}{title} = $resource->title;
            foreach my $part (@parts) {
                if (exists($stats{$part}{users})) {
                    my $resetname = 'reset_'.&Apache::lonnet::escape($symb."\0".$part);
                    my $resettitle = 'title_'.&Apache::lonnet::escape($symb."\0".$part);
                    if ($$triggered{$symb}{numparts}) {
                        $$triggered{$symb}{text} .= '<tr bgcolor="'.$rowColor.'">'."\n";
                    }
                    if (@parts > 1) {
                        $$triggered{$symb}{text} .= '
                         <td align="right"><small>part - '.$part.'<small></td>';
                    } else {
                        $$triggered{$symb}{text} .= '
                         <td align="right"><small>single part</small></td>';
                    }
                    $$triggered{$symb}{text} .= '
                         <td align="right"><small>'.$stats{$part}{users}.'</small></td>
                         <td align="right"><small>'.$stats{$part}{attempts}.'</small></td>
                         <td align="right"><small>'.$stats{$part}{degdiff}.'</small></td>
                         <td align="right"><small>'.$lastreset{$part}.'</small></td>
                         <td align="right"><small><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 = '<b>Counters reset for following problems (and parts):</b><br />';
    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 .= '<br />';
        } else {
            $result = $title.' -part '.$part.': '.&mt('Unable to reset counters to zero due to [_1]',$putresult).'.<br />'."\n";
        }
    }
    return $result;
}

sub process_update {
    my ($dom,$crs,$threshold_titles) = @_;
    my $setoutput = '<b>Changes to threshold(s) for problem tracking:</b><br />';
    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]',
				'<b>'.$$threshold_titles{$shortname}.'</b>',
				'<b>'.$value.'</b>').'<br />';
	    } else {
                $setoutput.=&mt('Unable to set threshold for [_1] to [_2] due to [_3].',
				'<b>'.$name.'</b>','<b>'.$value.'</b>',
				'<tt>'.$put_result.'</tt>').'<br />';
            }
        }
    }
    return $setoutput;
}

sub getmail {
    my ($newmsgs,$critmsgs) = @_;
# Check for unread mail in course
    my $msgcount = 0;

    my @messages = sort(&Apache::lonnet::getkeys('nohist_email'));
    foreach my $message (@messages) {
	my $msgid=&Apache::lonnet::escape($message);
        my ($sendtime,$shortsubj,$fromname,$fromdom,$status,$fromcid)=
            &Apache::lonmsg::unpackmsgid($msgid);
        if (($fromcid) && ($fromcid eq $env{'request.course.id'})) {
            if (defined($sendtime) && $sendtime!~/error/) {
                my $numsendtime = $sendtime;
                $sendtime = &Apache::lonlocal::locallocaltime($sendtime);
                if ($status eq 'new') {
                    $msgcount ++;
                    if ($shortsubj eq '') {
                        $shortsubj = &mt('No subject');
                    }
                    $shortsubj = &Apache::lonnet::unescape($shortsubj);
                    push(@{$newmsgs}, {
                        msgid    => $msgid,
                        sendtime => $sendtime,
                        shortsub => $shortsubj,
                        from     => $fromname,
                        fromdom  => $fromdom
                        });
                }
            }
        }
    }

# Check for critical messages in course
    my %what=&Apache::lonnet::dump('critical');
    my $result = '';
    my $critmsgcount = 0;
    foreach my $msgid (sort(keys(%what))) {
        my ($sendtime,$shortsubj,$fromname,$fromdom,$status,$fromcid)=
            &Apache::lonmsg::unpackmsgid($msgid);
        if (($fromcid) && ($fromcid eq  $env{'request.course.id'})) {
            if (defined($sendtime) && $sendtime!~/error/) {
                my $numsendtime = $sendtime;
                $sendtime = &Apache::lonlocal::locallocaltime($sendtime);
                $critmsgcount ++;
                if ($shortsubj eq '') {
                    $shortsubj = &mt('No subject');
                }
                $shortsubj = &Apache::lonnet::unescape($shortsubj);
                push(@{$critmsgs}, {
                        msgid    => $msgid,
                        sendtime => $sendtime,
                        shortsub => $shortsubj,
                        from     => $fromname,
                        fromdom  => $fromdom
                        });
            }
        }
    }
    return ($msgcount,$critmsgcount);
}

sub cmp_title {
    my ($a,$b,$res_title) = @_;
    my ($atitle,$btitle) = (lc($$res_title{$a}),lc($$res_title{$b}));
    $atitle=~s/^\s*//;
    $btitle=~s/^\s*//;
    return $atitle cmp $btitle;
}

1;

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
500 Internal Server Error

Internal Server Error

The server encountered an internal error or misconfiguration and was unable to complete your request.

Please contact the server administrator at root@localhost to inform them of the time this error occurred, and the actions you performed just before this error.

More information about this error may be available in the server error log.