Diff for /loncom/homework/grades.pm between versions 1.784 and 1.811

version 1.784, 2021/01/25 14:21:17 version 1.811, 2025/06/28 14:35:00
Line 47  use Apache::lonstathelpers; Line 47  use Apache::lonstathelpers;
 use Apache::lonquickgrades;  use Apache::lonquickgrades;
 use Apache::bridgetask();  use Apache::bridgetask();
 use Apache::lontexconvert();  use Apache::lontexconvert();
   use Apache::loncourserespicker;
 use String::Similarity;  use String::Similarity;
 use HTML::Parser();  use HTML::Parser();
 use File::MMagic;  use File::MMagic;
 use LONCAPA;  use LONCAPA;
   use LONCAPA::ltiutils();
   
 use POSIX qw(floor);  use POSIX qw(floor);
   
Line 65  my $ssi_retries = 5; Line 67  my $ssi_retries = 5;
 my $ssi_error;  my $ssi_error;
 my $ssi_error_resource;  my $ssi_error_resource;
 my $ssi_error_message;  my $ssi_error_message;
   my $registered_cleanup;
   
 sub ssi_with_retries {  sub ssi_with_retries {
     my ($resource, $retries, %form) = @_;      my ($resource, $retries, %form) = @_;
Line 636  COMMONJSFUNCTIONS Line 638  COMMONJSFUNCTIONS
 #--- Dumps the class list with usernames,list of sections,  #--- Dumps the class list with usernames,list of sections,
 #--- section, ids and fullnames for each user.  #--- section, ids and fullnames for each user.
 sub getclasslist {  sub getclasslist {
     my ($getsec,$filterbyaccstatus,$getgroup,$symb,$submitonly,$filterbysubmstatus) = @_;      my ($getsec,$filterbyaccstatus,$getgroup,$symb,$submitonly,$filterbysubmstatus,$filterbypbid,$possibles) = @_;
     my @getsec;      my @getsec;
     my @getgroup;      my @getgroup;
     my $stu_status = join(':',&Apache::loncommon::get_env_multiple('form.Status'));      my $stu_status = join(':',&Apache::loncommon::get_env_multiple('form.Status'));
Line 664  sub getclasslist { Line 666  sub getclasslist {
     #      #
     my %sections;      my %sections;
     my %fullnames;      my %fullnames;
       my %passback;
     my ($cdom,$cnum,$partlist);      my ($cdom,$cnum,$partlist);
     if (($filterbysubmstatus) && ($submitonly ne 'all') && ($symb ne '')) {      if (($filterbysubmstatus) && ($submitonly ne 'all') && ($symb ne '')) {
         $cdom = $env{"course.$env{'request.course.id'}.domain"};          $cdom = $env{"course.$env{'request.course.id'}.domain"};
         $cnum = $env{"course.$env{'request.course.id'}.num"};          $cnum = $env{"course.$env{'request.course.id'}.num"};
         my $res_error;          my $res_error;
         ($partlist) = &response_type($symb,\$res_error);          ($partlist) = &response_type($symb,\$res_error);
       } elsif ($filterbypbid) {
           $cdom = $env{"course.$env{'request.course.id'}.domain"};
           $cnum = $env{"course.$env{'request.course.id'}.num"};
     }      }
     foreach my $student (keys(%$classlist)) {      foreach my $student (keys(%$classlist)) {
         my $end      =           my $end      = 
Line 756  sub getclasslist { Line 762  sub getclasslist {
                 }                  }
             }              }
         }          }
           if ($filterbypbid) {
               if (ref($possibles) eq 'HASH') {
                   unless (exists($possibles->{$student})) {
                       delete($classlist->{$student});
                       next;
                   }
               }
               my $udom =
                   $classlist->{$student}->[&Apache::loncoursedata::CL_SDOM()];
               my $uname =
                   $classlist->{$student}->[&Apache::loncoursedata::CL_SNAME()];
               if (($udom ne '') && ($uname ne '')) {
                   my %pbinfo = &Apache::lonnet::get('nohist_'.$cdom.'_'.$cnum.'_linkprot_pb',[$filterbypbid],$udom,$uname);
                   if (ref($pbinfo{$filterbypbid}) eq 'ARRAY') {
                       $passback{$student} = $pbinfo{$filterbypbid};
                   } else {
                       delete($classlist->{$student});
                       next;
                   }
               }
           }
  $section = ($section ne '' ? $section : 'none');   $section = ($section ne '' ? $section : 'none');
  if (&canview($section)) {   if (&canview($section)) {
     if (!@getsec || grep(/^\Q$section\E$/,@getsec)) {      if (!@getsec || grep(/^\Q$section\E$/,@getsec)) {
Line 771  sub getclasslist { Line 798  sub getclasslist {
  }   }
     }      }
     my @sections = sort(keys(%sections));      my @sections = sort(keys(%sections));
     return ($classlist,\@sections,\%fullnames);      return ($classlist,\@sections,\%fullnames,\%passback);
 }  }
   
 sub canmodify {  sub canmodify {
Line 854  sub jscriptNform { Line 881  sub jscriptNform {
   
   
   
 # Given the score (as a number [0-1] and the weight) what is the final  # Given the score (as a number [0-1], the weight, and a posible 
 # point value? This function will round to the nearest tenth, third,  # reduction for submission between duedate and overduedate)
 # or quarter if one of those is within the tolerance of .00001.  # what is the final point value? This function will round to 
   # the nearest  tenth, third, or quarter if one of those is 
   # within the tolerance of .00001.
 sub compute_points {  sub compute_points {
     my ($score, $weight) = @_;      my ($score, $weight, $latefrac) = @_;
           
     my $tolerance = .00001;      my $tolerance = .00001;
     my $points = $score * $weight;      my $points = $score * $weight;
       if (($latefrac ne '') && 
           ($latefrac < 1) && ($latefrac >= 0))  {
           $points = $points * $latefrac;
       }
   
     # Check for nearness to 1/x.      # Check for nearness to 1/x.
     my $check_for_nearness = sub {      my $check_for_nearness = sub {
Line 1034  sub verifyreceipt { Line 1067  sub verifyreceipt {
     return $string;      return $string;
 }  }
   
   #-------------------------------------------------------------------
   
   #------------------------------------------- Grade Passback Routines
   #
   
   sub initialpassback {
       my ($request,$symb) = @_;
       my $cdom = $env{"course.$env{'request.course.id'}.domain"};
       my $cnum = $env{"course.$env{'request.course.id'}.num"};
       my $crstype = &Apache::loncommon::course_type();
       my %passback = &Apache::lonnet::dump('nohist_linkprot_passback',$cdom,$cnum);
       my $readonly;
       unless ($perm{'mgr'}) {
           $readonly = 1;
       }
       my $formname = 'initialpassback';
       my $navmap = Apache::lonnavmaps::navmap->new();
       my $output;
       if (!defined($navmap)) {
           if ($crstype eq 'Community') {
               $output = &mt('Unable to retrieve information about community contents');
           } else {
               $output = &mt('Unable to retrieve information about course contents');
           }
           return '<p>'.$output.'</p>';
       }
       return &Apache::loncourserespicker::create_picker($navmap,'passback',$formname,$crstype,undef,
                                                         undef,undef,undef,undef,undef,undef,
                                                         \%passback,$readonly);
   }
   
   sub passback_filters {
       my ($request,$symb) = @_;
       my $cdom = $env{"course.$env{'request.course.id'}.domain"};
       my $cnum = $env{"course.$env{'request.course.id'}.num"};
       my $crstype = &Apache::loncommon::course_type();
       my ($launcher,$appname,$setter,$linkuri,$linkprotector,$scope,$chosen);
       if ($env{'form.passback'} ne '') {
           $chosen = &unescape($env{'form.passback'});
           ($linkuri,$linkprotector,$scope) = split("\0",$chosen);
           ($launcher,$appname,$setter) = &get_passback_launcher($cdom,$cnum,$chosen);
       }
       my $result;
       if ($launcher ne '') {
           $result = &launcher_info_box($launcher,$appname,$setter,$linkuri,$scope).
                     '<p><br />'.&mt('Set criteria to use to list students for possible passback of scores, then push Next [_1]',
                                     '&rarr;').
                     '</p>';
       }
       $result .= '<form action="/adm/grades" method="post" name="gradingMenu">'."\n".
                  '<input type="hidden" name="passback" value="'.&escape($chosen).'" />'."\n".
                  '<input type="hidden" name="symb" value="'.&Apache::lonenc::check_encrypt($symb).'" />'."\n";
       my ($submittext,$newcommand);
       if ($launcher ne '') {
           $submittext = &mt('Next').' &rarr;';
           $newcommand = 'passbacknames';
           $result .=  &selectfield(0)."\n";
       } else {
           $submittext = '&larr; '.&mt('Previous');
           $newcommand = 'initialpassback';
           if ($env{'form.passback'}) {
               $result .= '<span class="LC_warning">'.&mt('Invalid launcher').'</span>'."\n";
           } else {
               $result .= '<span class="LC_warning">'.&mt('No launcher selected').'</span>'."\n";
           }
       }
       $result .=  '<input type="hidden" name="command" value="'.$newcommand.'" />'."\n".
                   '<div>'."\n".
                   '<input type="submit" value="'.$submittext.'" />'."\n".
                   '</div>'."\n".
                   '</form>'."\n";
       return $result;
   }
   
   sub names_for_passback {
       my ($request,$symb) = @_;
       my $cdom = $env{"course.$env{'request.course.id'}.domain"};
       my $cnum = $env{"course.$env{'request.course.id'}.num"};
       my $crstype = &Apache::loncommon::course_type();
       my ($launcher,$appname,$setter,$linkuri,$linkprotector,$scope,$chosen);
       if ($env{'form.passback'} ne '') {
           $chosen = &unescape($env{'form.passback'});
           ($linkuri,$linkprotector,$scope) = split("\0",$chosen);
           ($launcher,$appname,$setter) = &get_passback_launcher($cdom,$cnum,$chosen);
       }
       my ($result,$ctr,$newcommand,$submittext);
       if ($launcher ne '') {
           $result = &launcher_info_box($launcher,$appname,$setter,$linkuri,$scope);
       }
       $ctr = 0;
       my @statuses = &Apache::loncommon::get_env_multiple('form.Status');
       my $stu_status = join(':',@statuses);
       $result .= '<form action="/adm/grades" method="post" name="passbackusers">'."\n".
                  '<input type="hidden" name="symb" value="'.&Apache::lonenc::check_encrypt($symb).'" />'."\n";
       if ($launcher ne '') {
           $result .= '<input type="hidden" name="passback" value="'.&escape($chosen).'" />'."\n".
                      '<input type="hidden" name="Status" value="'.$stu_status.'" />'."\n";
           my ($sections,$groups,$group_display,$disabled) = &sections_and_groups();
           my $section_display = join(' ',@{$sections});
           my $status_display;
           if ((grep(/^Any$/,@statuses)) ||
               (@statuses == 3)) {
               $status_display = &mt('Any');
           } else {
               $status_display = join(' '.&mt('or').' ',map { &mt($_); } @statuses);
           }
           $result .= '<p>'.&mt('Student(s) with stored passback credentials for [_1], and also satisfy:',
                                '<span class="LC_cusr_emph">'.$linkuri.'</span>').
                      '<ul>'.
                      '<li>'.&mt('Section(s)').": $section_display</li>\n".
                      '<li>'.&mt('Group(s)').": $group_display</li>\n".
                      '<li>'.&mt('Status').": $status_display</li>\n".
                      '</ul>';
           my ($classlist,undef,$fullname) = &getclasslist($sections,'1',$groups,'','','',$chosen);
           if (keys(%$fullname)) {
               $newcommand = 'passbackscores';
               $result .= &build_section_inputs().
                          &checkselect_js('passbackusers').
                          '<p><br />'.
                          &mt("To send scores, check box(es) next to the student's name(s), then push 'Send Scores'.").
                          '</p>'.
                          &check_script('passbackusers', 'stuinfo')."\n".
                          '<input type="button" '."\n".
                          'onclick="javascript:checkSelect(this.form.stuinfo);" '."\n".
                          'value="'.&mt('Send Scores').'" /> <br />'."\n".
                          &check_buttons()."\n".
                          &Apache::loncommon::start_data_table().
                          &Apache::loncommon::start_data_table_header_row();
               my $loop = 0;
               while ($loop < 2) {
                   $result .= '<th>'.&mt('No.').'</th><th>'.&mt('Select').'</th>'.
                              '<th>'.&nameUserString('header').'&nbsp;'.&mt('Section/Group').'</th>';
                   $loop++;
               }
               $result .= &Apache::loncommon::end_data_table_header_row()."\n";
               foreach my $student (sort
                                    {
                                        if (lc($$fullname{$a}) ne lc($$fullname{$b})) {
                                            return (lc($$fullname{$a}) cmp lc($$fullname{$b}));
                                        }
                                        return $a cmp $b;
                                    }
                                    (keys(%$fullname))) {
                   $ctr++;
                   my $section = $classlist->{$student}->[&Apache::loncoursedata::CL_SECTION()];
                   my $group = $classlist->{$student}->[&Apache::loncoursedata::CL_GROUP()];
                   my $udom = $classlist->{$student}->[&Apache::loncoursedata::CL_SDOM()];
                   my $uname = $classlist->{$student}->[&Apache::loncoursedata::CL_SNAME()];
                   if ( $perm{'vgr'} eq 'F' ) {
                       if ($ctr%2 ==1) {
                           $result.= &Apache::loncommon::start_data_table_row();
                       }
                       $result .= '<td align="right">'.$ctr.'&nbsp;</td>'.
                                  '<td align="center"><label><input type="checkbox" name="stuinfo" value="'.
                                  $student.':'.$$fullname{$student}.':::SECTION'.$section.
                                  ')&nbsp;" />&nbsp;&nbsp;</label></td>'."\n".'<td>'.
                                  &nameUserString(undef,$$fullname{$student},$uname,$udom).
                                  '&nbsp;'.$section.($group ne '' ?'/'.$group:'').'</td>'."\n";
   
                       if ($ctr%2 ==0) {
                           $result .= &Apache::loncommon::end_data_table_row()."\n";
                       }
                   }
               }
               if ($ctr%2 ==1) {
                   $result .= &Apache::loncommon::end_data_table_row();
               }
               $result .= &Apache::loncommon::end_data_table()."\n";
               if ($ctr) {
                   $result .= '<input type="button" '.
                              'onclick="javascript:checkSelect(this.form.stuinfo);" '.
                              'value="'.&mt('Send Scores').'" />'."\n";
               }
           } else {
               $submittext = '&larr; '.&mt('Previous');
               $newcommand = 'passback';
               $result .= '<span class="LC_warning">'.&mt('No students match the selection criteria').'</p>';
           }
       } else {
           $newcommand = 'initialpassback';
           $submittext = &mt('Start over');
           if ($env{'form.passback'}) {
               $result .= '<span class="LC_warning">'.&mt('Invalid launcher').'</span>'."\n";
           } else {
               $result .= '<span class="LC_warning">'.&mt('No launcher selected').'</span>'."\n";
           }
       }
       $result .=  '<input type="hidden" name="command" value="'.$newcommand.'" />'."\n";
       if (!$ctr) {
           $result .= '<div>'."\n".
                      '<input type="submit" value="'.$submittext.'" />'."\n".
                      '</div>'."\n";
       }
       $result .= '</form>'."\n";
       return $result;
   }
   
   sub do_passback {
       my ($request,$symb) = @_;
       my $cdom = $env{"course.$env{'request.course.id'}.domain"};
       my $cnum = $env{"course.$env{'request.course.id'}.num"};
       my $crstype = &Apache::loncommon::course_type();
       my ($launchsymb,$appname,$setter,$linkuri,$linkprotector,$scope,$chosen);
       if ($env{'form.passback'} ne '') {
           $chosen = &unescape($env{'form.passback'});
           ($linkuri,$linkprotector,$scope) = split("\0",$chosen);
           ($launchsymb,$appname,$setter) = &get_passback_launcher($cdom,$cnum,$chosen);
       }
       if ($launchsymb ne '') {
           $request->print(&launcher_info_box($launchsymb,$appname,$setter,$linkuri,$scope));
       }
       my $error;
       if ($perm{'mgr'}) {
           if ($launchsymb ne '') {
               my @poss_students = &Apache::loncommon::get_env_multiple('form.stuinfo');
               if (@poss_students) {
                   my %possibles;
                   foreach my $item (@poss_students) {
                       my ($stuname,$studom) = split(/:/,$item,3);
                       $possibles{$stuname.':'.$studom} = 1;
                   }
                   my ($sections,$groups,$group_display,$disabled) = &sections_and_groups();
                   my ($classlist,undef,$fullname,$pbinfo) =
                       &getclasslist($sections,'1',$groups,'','','',$chosen,\%possibles);
                   if ((ref($classlist) eq 'HASH') && (ref($pbinfo) eq 'HASH')) {
                       my %passback = %{$pbinfo};
                       my (%tosend,%remotenotok,%scorenotok,%zeroposs,%nopbinfo);
                       foreach my $possible (keys(%possibles)) {
                           if ((exists($classlist->{$possible})) &&
                               (exists($passback{$possible})) && (ref($passback{$possible}) eq 'ARRAY')) {
                               $tosend{$possible} = 1;
                           }
                       }
                       if (keys(%tosend)) {
                           my ($lti_in_use,$crsdef);
                           my ($ltinum,$ltitype) = ($linkprotector =~ /^(\d+)(c|d)$/);
                           if ($ltitype eq 'c') {
                               my %crslti = &Apache::lonnet::get_course_lti($cnum,$cdom,'provider');
                               $lti_in_use = $crslti{$ltinum};
                               $crsdef = 1;
                           } else {
                               my %domlti = &Apache::lonnet::get_domain_lti($cdom,'linkprot');
                               $lti_in_use = $domlti{$ltinum};
                           }
                           if (ref($lti_in_use) eq 'HASH') {
                               my $msgformat = $lti_in_use->{'passbackformat'};
                               my $keynum = $lti_in_use->{'cipher'};
                               my $scoretype = 'decimal';
                               if ($lti_in_use->{'scoreformat'} =~ /^(decimal|ratio|percentage)$/) {
                                   $scoretype = $1;
                               }
                               my $pbmap;
                               if ($launchsymb =~ /\.(page|sequence)$/) {
                                   $pbmap = &Apache::lonnet::deversion((&Apache::lonnet::decode_symb($launchsymb))[2]);
                               } else {
                                   $pbmap = &Apache::lonnet::deversion((&Apache::lonnet::decode_symb($launchsymb))[0]);
                               }
                               $pbmap = &Apache::lonnet::clutter($pbmap);
                               my $pbscope;
                               if ($scope eq 'res') {
                                   $pbscope = 'resource';
                               } elsif ($scope eq 'map') {
                                   $pbscope = 'nonrec';
                               } elsif ($scope eq 'rec') {
                                   $pbscope = 'map';
                               }
                               my %pb = &common_passback_info();
                               my $numstudents = scalar(keys(%tosend));
                               my %prog_state = &Apache::lonhtmlcommon::Create_PrgWin($request,$numstudents);
                               my $outcome = &Apache::loncommon::start_data_table().
                                             &Apache::loncommon::start_data_table_header_row();
                               my $loop = 0;
                               while ($loop < 2) {
                                   $outcome .= '<th>'.&mt('No.').'</th>'.
                                               '<th>'.&nameUserString('header').'&nbsp;'.&mt('Section/Group').'</th>'.
                                               '<th>'.&mt('Score').'</th>';
                                   $loop++;
                               }
                               $outcome .= &Apache::loncommon::end_data_table_header_row()."\n";
                               my $ctr=0;
                               foreach my $student (sort
                                   {
                                        if (lc($$fullname{$a}) ne lc($$fullname{$b})) {
                                            return (lc($$fullname{$a}) cmp lc($$fullname{$b}));
                                        }
                                        return $a cmp $b;
                                   } (keys(%$fullname))) {
                                   next unless ($tosend{$student});
                                   my ($uname,$udom) = split(/:/,$student);
                                   &Apache::lonhtmlcommon::Increment_PrgWin($request,\%prog_state,'last student');
                                   my ($uname,$udom) = split(/:/,$student);
                                   my $uhome = &Apache::lonnet::homeserver($uname,$udom),
                                   my $id = $passback{$student}[0],
                                   my $url = $passback{$student}[1],
                                   my ($total,$possible,$usec);
                                   if (ref($classlist->{$student}) eq 'ARRAY') {
                                       $usec = $classlist->{$student}->[&Apache::loncoursedata::CL_SECTION];
                                   }
                                   if ($pbscope eq 'resource') {
                                       $total = 0;
                                       $possible = 0;
                                       my $navmap = Apache::lonnavmaps::navmap->new($uname,$udom);
                                       if (ref($navmap)) {
                                           my $res = $navmap->getBySymb($launchsymb);
                                           if (ref($res)) {
                                               my $partlist = $res->parts();
                                               if (ref($partlist) eq 'ARRAY') {
                                                   my %record = &Apache::lonnet::restore($launchsymb,$env{'request.course.id'},$udom,$uname);
                                                   foreach my $part (@{$partlist}) {
                                                       next if ($record{"resource.$part.solved"} =~/^excused/);
                                                       my $weight = &Apache::lonnet::EXT("resource.$part.weight",$launchsymb,$udom,$uname,$usec);
                                                       $possible += $weight;
                                                       if (($record{'version'}) && (exists($record{"resource.$part.awarded"}))) {
                                                           my $awarded = $record{"resource.$part.awarded"};
                                                           if ($awarded) {
                                                               $total += $weight * $awarded;
                                                           }
                                                       }
                                                   }
                                               }
                                           }
                                       }
                                   } elsif (($pbscope eq 'map') || ($pbscope eq 'nonrec')) {
                                       ($total,$possible) =
                                           &Apache::lonhomework::get_lti_score($uname,$udom,$usec,$pbmap,$pbscope);
                                   }
                                   if (($id ne '') && ($url ne '') && ($possible)) {
                                       my ($sent,$score,$code,$result) =
                                           &LONCAPA::ltiutils::send_grade($cdom,$cnum,$crsdef,$pb{'type'},$ltinum,$keynum,$id,
                                                                          $url,$scoretype,$pb{'sigmethod'},$msgformat,$total,$possible);
                                       my $no_passback;
                                       if ($sent) {
                                           if ($code == 200) {
                                               delete($tosend{$student});
                                               my $namespace = $cdom.'_'.$cnum.'_lp_passback';
                                               my $store = {
                                                    'score' => $score,
                                                    'ip' => $pb{'ip'},
                                                    'host' => $pb{'lonhost'},
                                                    'protector' => $linkprotector,
                                                    'deeplink' => $linkuri,
                                                    'scope' => $scope,
                                                    'url' => $url,
                                                    'id' => $id,
                                                    'clientip' => $pb{'clientip'},
                                                    'whodoneit' => $env{'user.name'}.':'.$env{'user.domain'},
                                               };
                                               my $value='';
                                               foreach my $key (keys(%{$store})) {
                                                   $value.=&escape($key).'='.&Apache::lonnet::freeze_escape($store->{$key}).'&';
                                               }
                                               $value=~s/\&$//;
                                               &Apache::lonnet::courselog(&escape($linkuri).':'.$uname.':'.$udom.':EXPORT:'.$value);
                                               &Apache::lonnet::store_userdata({'score' => $score},$chosen,$namespace,$udom,$uname,$pb{'ip'});
                                               $ctr++;
                                               if ($ctr%2 ==1) {
                                                   $outcome .= &Apache::loncommon::start_data_table_row();
                                               }
                                               my $group = $classlist->{$student}->[&Apache::loncoursedata::CL_GROUP()];
                                               $outcome .= '<td align="right">'.$ctr.'&nbsp;</td>'.
                                                           '<td>'.&nameUserString(undef,$$fullname{$student},$uname,$udom).
                                                           '&nbsp;'.$usec.($group ne '' ?'/'.$group:'').'</td>'.
                                                           '<td>'.$score.'</td>'."\n";
                                               if ($ctr%2 ==0) {
                                                   $outcome .= &Apache::loncommon::end_data_table_row()."\n";
                                               }
                                           } else {
                                               $remotenotok{$student} = 1;
                                               $no_passback = "Passback response for ".$linkprotector." was $code ($result)";
                                               &Apache::lonnet::logthis($no_passback." for $uname:$udom in ${cdom}_${cnum}");
                                           }
                                       } else {
                                           $scorenotok{$student} = 1;
                                           $no_passback = "Passback of grades not sent for ".$linkprotector;
                                           &Apache::lonnet::logthis($no_passback." for $uname:$udom in ${cdom}_${cnum}");
                                       }
                                       if ($no_passback) {
                                           &Apache::lonnet::log($udom,$uname,$uhome,$no_passback." score: $score; total: $total; possible: $possible");
                                           my $key = &Time::HiRes::time().':'.$uname.':'.$udom.':'.
                                                     "$linkuri\0$linkprotector\0$scope"; 
                                           my $ltigrade = {
                                                            $key => {
                                                                      'ltinum'   => $ltinum,
                                                                      'lti'      => $lti_in_use,
                                                                      'crsdef'   => $crsdef,
                                                                      'cid'      => $cdom.'_'.$cnum,
                                                                      'uname'    => $uname,
                                                                      'udom'     => $udom,
                                                                      'uhome'    => $uhome,
                                                                      'pbid'     => $id,
                                                                      'pburl'    => $url,
                                                                      'pbtype'   => $pb{'type'},
                                                                      'pbscope'  => $pbscope,
                                                                      'pbmap'    => $pbmap,
                                                                      'pbsymb'   => $launchsymb,
                                                                      'format'   => $scoretype,
                                                                      'scope'    => $scope,
                                                                      'clientip' => $pb{'clientip'},
                                                                      'linkprot' => $linkprotector.':'.$linkuri,
                                                                      'total'    => $total,
                                                                      'possible' => $possible,
                                                                      'score'    => $score,
                                                                    },
                                           };
                                           &Apache::lonnet::put('linkprot_passback_pending',$ltigrade,$cdom,$cnum);
                                       }
                                   } else {
                                       if (($id ne '') && ($url ne '')) {
                                           $zeroposs{$student} = 1;
                                       } else {
                                           $nopbinfo{$student} = 1;
                                       }
                                   }
                               }
                               &Apache::lonhtmlcommon::Close_PrgWin($request,\%prog_state);
                               if ($ctr%2 ==1) {
                                   $outcome .= &Apache::loncommon::end_data_table_row();
                               }
                               $outcome .= &Apache::loncommon::end_data_table();
                               if ($ctr) {
                                   $request->print('<p><br />'.&mt('Scores sent to launcher CMS').'</p>'.
                                                   '<p>'.$outcome.'</p>');
                               } else {
                                   $request->print('<p>'.&mt('No scores sent to launcher CMS').'</p>');
                               }
                               if (keys(%tosend)) {
                                   $request->print('<p>'.&mt('No scores sent for following'));
                                   my ($zeros,$nopbcreds,$noconfirm,$noscore);
                                   foreach my $student (sort
                                   {
                                        if (lc($$fullname{$a}) ne lc($$fullname{$b})) {
                                            return (lc($$fullname{$a}) cmp lc($$fullname{$b}));
                                        }
                                        return $a cmp $b;
                                   } (keys(%$fullname))) {
                                       next unless ($tosend{$student});
                                       my ($uname,$udom) = split(/:/,$student);
                                       my $line = '<li>'.&nameUserString(undef,$$fullname{$student},$uname,$udom).'</li>'."\n";
                                       if ($zeroposs{$student}) {
                                           $zeros .= $line;
                                       } elsif ($nopbinfo{$student}) {
                                           $nopbcreds .= $line;
                                       } elsif ($remotenotok{$student}) {
                                           $noconfirm .= $line;
                                       } elsif ($scorenotok{$student}) {
                                           $noscore .= $line;
                                       }
                                   }
                                   if ($zeros) {
                                       $request->print('<br />'.&mt('Total points possible was 0').':'.
                                                       '<ul>'.$zeros.'</ul><br />');
                                   }
                                   if ($nopbcreds) {
                                       $request->print('<br />'.&mt('Missing unique identifier and/or passback location').':'.
                                                       '<ul>'.$nopbcreds.'</ul><br />');
                                   }
                                   if ($noconfirm) {
                                       $request->print('<br />'.&mt('Score receipt not confirmed by receiving CMS').':'.
                                                       '<ul>'.$noconfirm.'</ul><br />');
                                   }
                                   if ($noscore) {
                                       $request->print('<br />'.&mt('Score computation or transmission failed').':'.
                                                       '<ul>'.$noscore.'</ul><br />');
                                   }
                                   $request->print('</p>');
                               }
                           } else {
                               $error = &mt('Settings for deep-link launch target unavailable, so no scores were sent');
                           }
                       } else {
                           $error = &mt('No available students for whom scores can be sent.');
                       }
                   } else {
                       $error = &mt('Classlist could not be retrieved so no scores were sent.');
                   }
               } else {
                   $error = &mt('No students selected to receive scores so none were sent.');
               }
           } else {
               if ($env{'form.passback'}) {
                   $error = &mt('Deep-link launch target was invalid so no scores were sent.');
               } else {
                   $error = &mt('Deep-link launch target was missing so no scores were sent.');
               }
           }
       } else {
           $error = &mt('You do not have permission to manage grades, so no scores were sent');
       }
       if ($error) {
           $request->print('<p class="LC_info">'.$error.'</p>');
       }
       return;
   }
   
   sub get_passback_launcher {
       my ($cdom,$cnum,$chosen) = @_;
       my ($linkuri,$linkprotector,$scope) = split("\0",$chosen);
       my ($ltinum,$ltitype) = ($linkprotector =~ /^(\d+)(c|d)$/);
       my ($appname,$setter);
       if ($ltitype eq 'c') {
           my %lti = &Apache::lonnet::get_course_lti($cnum,$cdom,'provider');
           if (ref($lti{$ltinum}) eq 'HASH') {
               $appname = $lti{$ltinum}{'name'};
               if ($appname) {
                   $setter = ' (defined in course)';
               }
           }
       } elsif ($ltitype eq 'd') {
           my %lti = &Apache::lonnet::get_domain_lti($cdom,'linkprot');
           if (ref($lti{$ltinum}) eq 'HASH') {
               $appname = $lti{$ltinum}{'name'};
               if ($appname) {
                   $setter = ' (defined in domain)';
               }
           }
       }
       my $launchsymb = &Apache::loncommon::symb_from_tinyurl($linkuri,$cnum,$cdom);
       if ($launchsymb eq '') {
           my %passback = &Apache::lonnet::dump('nohist_linkprot_passback',$cdom,$cnum);
           foreach my $poss_symb (keys(%passback)) {
               if (ref($passback{$poss_symb}) eq 'HASH') {
                   if (exists($passback{$poss_symb}{$chosen})) {
                       $launchsymb = $poss_symb;
                       last;
                   }
               }
           }
           if ($launchsymb ne '') {
               return ($launchsymb,$appname,$setter);
           }
       } else {
           my %passback = &Apache::lonnet::get('nohist_linkprot_passback',[$launchsymb],$cdom,$cnum);
           if (ref($passback{$launchsymb}) eq 'HASH') {
               if (exists($passback{$launchsymb}{$chosen})) {
                   return ($launchsymb,$appname,$setter);
               }
           }
       }
       return ();
   }
   
   sub sections_and_groups {
       my (@sections,@groups,$group_display);
       @groups = &Apache::loncommon::get_env_multiple('form.group');
       if (grep(/^all$/,@groups)) {
            @groups = ('all');
            $group_display = 'all';
       } elsif (grep(/^none$/,@groups)) {
            @groups = ('none');
            $group_display = 'none';
       } elsif (@groups > 0) {
            $group_display = join(', ',@groups);
       }
       if ($env{'request.course.sec'} ne '') {
           @sections = ($env{'request.course.sec'});
       } else {
           @sections = &Apache::loncommon::get_env_multiple('form.section');
       }
       my $disabled = ' disabled="disabled"';
       if ($perm{'mgr'}) {
           if (grep(/^all$/,@sections)) {
               undef($disabled);
           } else {
               foreach my $sec (@sections) {
                   if (&canmodify($sec)) {
                       undef($disabled);
                       last;
                   }
               }
           }
       }
       if (grep(/^all$/,@sections)) {
           @sections = ('all');
       }
       return(\@sections,\@groups,$group_display,$disabled);
   }
   
   sub launcher_info_box {
       my ($launcher,$appname,$setter,$linkuri,$scope) = @_;
       my $shownscope;
       if ($scope eq 'res') {
           $shownscope = &mt('Resource');
       } elsif ($scope eq 'map') {
           $shownscope = &mt('Folder');
       }  elsif ($scope eq 'rec') {
           $shownscope = &mt('Folder + sub-folders');
       }
       return '<p>'.
              &Apache::lonhtmlcommon::start_pick_box().
              &Apache::lonhtmlcommon::row_title(&mt('Launch Item Title')).
              &Apache::lonnet::gettitle($launcher).
              &Apache::lonhtmlcommon::row_closure().
              &Apache::lonhtmlcommon::row_title(&mt('Deep-link')).
              $linkuri.
              &Apache::lonhtmlcommon::row_closure().
              &Apache::lonhtmlcommon::row_title(&mt('Launcher')).
              $appname.' '.$setter.
              &Apache::lonhtmlcommon::row_closure().
              &Apache::lonhtmlcommon::row_title(&mt('Score Type')).
              $shownscope.      
              &Apache::lonhtmlcommon::row_closure(1).
              &Apache::lonhtmlcommon::end_pick_box().'</p>'."\n";
   }
   
   sub passbacks_for_symb {
       my ($cdom,$cnum,$symb) = @_;
       my %passback = &Apache::lonnet::dump('nohist_linkprot_passback',$cdom,$cnum);
       my %needpb;
       if (keys(%passback)) {
           my $checkpb = 1;
           if (exists($passback{$symb})) {
               if (keys(%passback) == 1) {
                   undef($checkpb);
               }
               if (ref($passback{$symb}) eq 'HASH') {
                   foreach my $launcher (keys(%{$passback{$symb}})) {
                       $needpb{$launcher} = $symb;
                   }
               }
           }
           if ($checkpb) {
               my ($map,$id,$url) = &Apache::lonnet::decode_symb($symb);
               my $navmap = Apache::lonnavmaps::navmap->new();
               if (ref($navmap)) {
                   my $mapres = $navmap->getResourceByUrl($map);
                   if (ref($mapres)) {
                       my $mapsymb = $mapres->symb();
                       if (exists($passback{$mapsymb})) {
                           if (keys(%passback) == 1) {
                               undef($checkpb);
                           }
                           if (ref($passback{$mapsymb}) eq 'HASH') {
                               foreach my $launcher (keys(%{$passback{$mapsymb}})) {
                                   $needpb{$launcher} = $mapsymb;
                               }
                           }
                       }
                       my %posspb;
                       if ($checkpb) {
                           my @recurseup = $navmap->recurseup_maps($map,1);
                           if (@recurseup) {
                               map { $posspb{$_} = 1; } @recurseup;
                           }
                       }
                       foreach my $key (keys(%passback)) {
                           if (exists($posspb{$key})) {
                               if (ref($passback{$key}) eq 'HASH') {
                                   foreach my $launcher (keys(%{$passback{$key}})) {
                                       my ($linkuri,$linkprotector,$scope) = split("\0",$launcher);
                                       next unless ($scope eq 'rec');
                                       $needpb{$launcher} = $key;
                                   }
                               }
                           }
                       }
                   }
               }
           }
       }
       return %needpb;
   }
   
   sub process_passbacks {
       my ($context,$symbs,$cdom,$cnum,$udom,$uname,$usec,$weights,$awardeds,$excuseds,$needpb,
           $skip_passback,$pbsave,$pbids) = @_;
       if ((ref($needpb) eq 'HASH') && (ref($skip_passback) eq 'HASH') && (ref($pbsave) eq 'HASH')) {
           my (%weight,%awarded,%excused);
           if ((ref($symbs) eq 'ARRAY') && (ref($weights) eq 'HASH') && (ref($awardeds) eq 'HASH') &&
               (ref($excuseds) eq 'HASH')) {
               %weight = %{$weights};
               %awarded = %{$awardeds};
               %excused = %{$excuseds};
           }
           my $uhome = &Apache::lonnet::homeserver($uname,$udom);
           my @launchers = keys(%{$needpb});
           my %pbinfo;
           if (ref($pbids) eq 'HASH') {
               %pbinfo = %{$pbids};
           } else {
               %pbinfo = &Apache::lonnet::get('nohist_'.$cdom.'_'.$cnum.'_linkprot_pb',\@launchers,$udom,$uname);
           }
           my %pbc = &common_passback_info();
           foreach my $launcher (@launchers) {
               if (ref($pbinfo{$launcher}) eq 'ARRAY') {
                   my $pbid = $pbinfo{$launcher}[0];
                   my $pburl = $pbinfo{$launcher}[1];
                   my (%total_by_symb,%possible_by_symb);
                   if (($pbid ne '') && ($pburl ne '')) {
                       next if ($skip_passback->{$launcher});
                       my %pb = %pbc;
                       if ((exists($pbsave->{$launcher})) &&
                           (ref($pbsave->{$launcher}) eq 'HASH')) {
                           foreach my $item ('lti_in_use','crsdef','ltinum','keynum','scoretype','msgformat',
                                             'symb','map','pbscope','linkuri','linkprotector','scope') {
                               $pb{$item} = $pbsave->{$launcher}{$item};
                           }
                       } else {
                           my $ltitype;
                           ($pb{'linkuri'},$pb{'linkprotector'},$pb{'scope'}) = split("\0",$launcher);
                           ($pb{'ltinum'},$ltitype) = ($pb{'linkprotector'} =~ /^(\d+)(c|d)$/);
                           if ($ltitype eq 'c') {
                               my %crslti = &Apache::lonnet::get_course_lti($cnum,$cdom,'provider');
                               $pb{'lti_in_use'} = $crslti{$pb{'ltinum'}};
                               $pb{'crsdef'} = 1;
                           } else {
                               my %domlti = &Apache::lonnet::get_domain_lti($cdom,'linkprot');
                               $pb{'lti_in_use'} = $domlti{$pb{'ltinum'}};
                           }
                           if (ref($pb{'lti_in_use'}) eq 'HASH') {
                               $pb{'msgformat'} = $pb{'lti_in_use'}->{'passbackformat'};
                               $pb{'keynum'} = $pb{'lti_in_use'}->{'cipher'};
                               $pb{'scoretype'} = 'decimal';
                               if ($pb{'lti_in_use'}->{'scoreformat'} =~ /^(decimal|ratio|percentage)$/) {
                                   $pb{'scoretype'} = $1;
                               }
                               $pb{'symb'} = $needpb->{$launcher};
                               if ($pb{'symb'} =~ /\.(page|sequence)$/) {
                                   $pb{'map'} = &Apache::lonnet::deversion((&Apache::lonnet::decode_symb($pb{'symb'}))[2]);
                               } else {
                                   $pb{'map'} = &Apache::lonnet::deversion((&Apache::lonnet::decode_symb($pb{'symb'}))[0]);
                               }
                               $pb{'map'} = &Apache::lonnet::clutter($pb{'map'});
                               if ($pb{'scope'} eq 'res') {
                                   $pb{'pbscope'} = 'resource';
                               } elsif ($pb{'scope'} eq 'map') {
                                   $pb{'pbscope'} = 'nonrec';
                               } elsif ($pb{'scope'} eq 'rec') {
                                   $pb{'pbscope'} = 'map';
                               }
                               foreach my $item ('lti_in_use','crsdef','ltinum','keynum','scoretype','msgformat',
                                                 'symb','map','pbscope','linkuri','linkprotector','scope') {
                                   $pbsave->{$launcher}{$item} = $pb{$item};
                               }
                           } else {
                               $skip_passback->{$launcher} = 1;
                           }
                       }
                       if (ref($symbs) eq 'ARRAY') {
                           foreach my $symb (@{$symbs}) {
                               if ((ref($weight{$symb}) eq 'HASH') && (ref($awarded{$symb}) eq 'HASH') &&
                                   (ref($excused{$symb}) eq 'HASH')) {
                                   foreach my $part (keys(%{$weight{$symb}})) {
                                       if ($excused{$symb}{$part}) {
                                           next;
                                       }
                                       my $partweight = $weight{$symb}{$part} eq '' ? 1 :
                                                        $weight{$symb}{$part};
                                       if ($awarded{$symb}{$part}) {
                                           $total_by_symb{$symb} += $partweight * $awarded{$symb}{$part};
                                       }
                                       $possible_by_symb{$symb} += $partweight;
                                   }
                               }
                           }
                       }
                       if ($context eq 'updatebypage') {
                           my $ltigrade = {
                                           'ltinum'     => $pb{'ltinum'},
                                           'lti'        => $pb{'lti_in_use'},
                                           'crsdef'     => $pb{'crsdef'},
                                           'cid'        => $cdom.'_'.$cnum,
                                           'uname'      => $uname,
                                           'udom'       => $udom,
                                           'uhome'      => $uhome,
                                           'usec'       => $usec,
                                           'pbid'       => $pbid,
                                           'pburl'      => $pburl,
                                           'pbtype'     => $pb{'type'},
                                           'pbscope'    => $pb{'pbscope'},
                                           'pbmap'      => $pb{'map'},
                                           'pbsymb'     => $pb{'symb'},
                                           'format'     => $pb{'scoretype'},
                                           'scope'      => $pb{'scope'},
                                           'clientip'   => $pb{'clientip'},
                                           'linkprot'   => $pb{'linkprotector'}.':'.$pb{'linkuri'},
                                           'total_s'    => \%total_by_symb,
                                           'possible_s' => \%possible_by_symb,
                           };
                           push(@Apache::grades::ltipassback,$ltigrade);
                           next;
                       }
                       my ($total,$possible);
                       if ($pb{'pbscope'} eq 'resource') {
                           $total = $total_by_symb{$pb{'symb'}};
                           $possible = $possible_by_symb{$pb{'symb'}};
                       } elsif (($pb{'pbscope'} eq 'map') || ($pb{'pbscope'} eq 'nonrec')) {
                           ($total,$possible) =
                               &Apache::lonhomework::get_lti_score($uname,$udom,$usec,$pb{'map'},$pb{'pbscope'},
                                                                   \%total_by_symb,\%possible_by_symb);
                       }
                       if (!$possible) {
                           $total = 0;
                           $possible = 1;
                       }
                       my ($sent,$score,$code,$result) =
                           &LONCAPA::ltiutils::send_grade($cdom,$cnum,$pb{'crsdef'},$pb{'type'},$pb{'ltinum'},
                                                          $pb{'keynum'},$pbid,$pburl,$pb{'scoretype'},$pb{'sigmethod'},
                                                          $pb{'msgformat'},$total,$possible);
                       my $no_passback;
                       if ($sent) {
                           if ($code == 200) {
                               my $namespace = $cdom.'_'.$cnum.'_lp_passback';
                               my $store = {
                                   'score' => $score,
                                   'ip' => $pb{'ip'},
                                   'host' => $pb{'lonhost'},
                                   'protector' => $pb{'linkprotector'},
                                   'deeplink' => $pb{'linkuri'},
                                   'scope' => $pb{'scope'},
                                   'url' => $pburl,
                                   'id' => $pbid,
                                   'clientip' => $pb{'clientip'},
                                   'whodoneit' => $env{'user.name'}.':'.$env{'user.domain'},
                               };
                               my $value='';
                               foreach my $key (keys(%{$store})) {
                                    $value.=&escape($key).'='.&Apache::lonnet::freeze_escape($store->{$key}).'&';
                               }
                               $value=~s/\&$//;
                               &Apache::lonnet::courselog(&escape($pb{'linkuri'}).':'.$uname.':'.$udom.':EXPORT:'.$value);
                               &Apache::lonnet::store_userdata({'score' => $score},$launcher,$namespace,$udom,$uname,$pb{'ip'});
                           } else {
                               $no_passback = 1;
                           }
                       } else {
                           $no_passback = 1;
                       }
                       if ($no_passback) {
                           &Apache::lonnet::log($udom,$uname,$uhome,$no_passback." score: $score; total: $total; possible: $possible");
                           my $ltigrade = {
                              'ltinum'   => $pb{'ltinum'},
                              'lti'      => $pb{'lti_in_use'},
                              'crsdef'   => $pb{'crsdef'},
                              'cid'      => $cdom.'_'.$cnum,
                              'uname'    => $uname,
                              'udom'     => $udom,
                              'uhome'    => $uhome,
                              'pbid'     => $pbid,
                              'pburl'    => $pburl,
                              'pbtype'   => $pb{'type'},
                              'pbscope'  => $pb{'pbscope'},
                              'pbmap'    => $pb{'map'},
                              'pbsymb'   => $pb{'symb'},
                              'format'   => $pb{'scoretype'},
                              'scope'    => $pb{'scope'},
                              'clientip' => $pb{'clientip'},
                              'linkprot' => $pb{'linkprotector'}.':'.$pb{'linkuri'},
                              'total'    => $total,
                              'possible' => $possible,
                              'score'    => $score,
                           };
                           &Apache::lonnet::put('linkprot_passback_pending',$ltigrade,$cdom,$cnum);
                       }
                   }
               }
           }
       }
       return;
   }
   
   sub common_passback_info {
       my %pbc = (
                  sigmethod => 'HMAC-SHA1',
                  type      => 'linkprot',
                  clientip  => &Apache::lonnet::get_requestor_ip(),
                  lonhost   => $Apache::lonnet::perlvar{'lonHostID'},
                  ip        => &Apache::lonnet::get_host_ip($Apache::lonnet::perlvar{'lonHostID'}),
                );
       return %pbc;
   }
   
 #--- This is called by a number of programs.  #--- This is called by a number of programs.
 #--- Called from the Grading Menu - View/Grade an individual student  #--- Called from the Grading Menu - View/Grade an individual student
 #--- Also called directly when one clicks on the subm button   #--- Also called directly when one clicks on the subm button 
Line 1065  sub listStudents { Line 1969  sub listStudents {
         }          }
     }      }
   
     my %js_lt = &Apache::lonlocal::texthash (      $request->print(&checkselect_js());
  'multiple' => 'Please select a student or group of students before clicking on the Next button.',  
  'single'   => 'Please select the student before clicking on the Next button.',  
      );  
     &js_escape(\%js_lt);  
     $request->print(&Apache::lonhtmlcommon::scripttag(<<LISTJAVASCRIPT));      $request->print(&Apache::lonhtmlcommon::scripttag(<<LISTJAVASCRIPT));
     function checkSelect(checkBox) {  
  var ctr=0;  
  var sense="";  
  if (checkBox.length > 1) {  
     for (var i=0; i<checkBox.length; i++) {  
  if (checkBox[i].checked) {  
     ctr++;  
  }  
     }  
     sense = '$js_lt{'multiple'}';  
  } else {  
     if (checkBox.checked) {  
  ctr = 1;  
     }  
     sense = '$js_lt{'single'}';  
  }  
  if (ctr == 0) {  
     alert(sense);  
     return false;  
  }  
  document.gradesub.submit();  
     }  
   
     function reLoadList(formname) {      function reLoadList(formname) {
  if (formname.saveStatusOld.value == pullDownSelection(formname.Status)) {return;}   if (formname.saveStatusOld.value == pullDownSelection(formname.Status)) {return;}
Line 1380  LISTJAVASCRIPT Line 2258  LISTJAVASCRIPT
     return '';      return '';
 }  }
   
 #---- Called from the listStudents routine  #---- Called from the listStudents and the names_for_passback routines.
   
   sub checkselect_js {
       my ($formname) = @_;
       if ($formname eq '') {
           $formname = 'gradesub';
       }
       my %js_lt;
       if ($formname eq 'passbackusers') {
           %js_lt = &Apache::lonlocal::texthash (
                        'multiple' => 'Please select a student or group of students before pushing the Save Scores button.',
                        'single'   => 'Please select the student before pushing the Save Scores button.',
                    );
       } else {
           %js_lt = &Apache::lonlocal::texthash (
                        'multiple' => 'Please select a student or group of students before clicking on the Next button.',
                        'single'   => 'Please select the student before clicking on the Next button.',
                    );
       }
       &js_escape(\%js_lt);
       return &Apache::lonhtmlcommon::scripttag(<<LISTJAVASCRIPT);
   
       function checkSelect(checkBox) {
           var ctr=0;
           var sense="";
           var len = checkBox.length;
           if (len == undefined) len = 1;
           if (len > 1) {
               for (var i=0; i<len; i++) {
                   if (checkBox[i].checked) {
                       ctr++;
                   }
               }
               sense = '$js_lt{'multiple'}';
           } else {
               if (checkBox.checked) {
                   ctr = 1;
               }
               sense = '$js_lt{'single'}';
           }
           if (ctr == 0) {
               alert(sense);
               return false;
           }
           document.$formname.submit();
       }
   LISTJAVASCRIPT
   
   }
   
 sub check_script {  sub check_script {
     my ($form,$type) = @_;      my ($form,$type) = @_;
Line 2031  sub gradeBox { Line 2957  sub gradeBox {
                            : '<span class="LC_info">'.&mt('problem weight assigned by computer').'</span>';                             : '<span class="LC_info">'.&mt('problem weight assigned by computer').'</span>';
     $wgt       = ($wgt > 0 ? $wgt : '1');      $wgt       = ($wgt > 0 ? $wgt : '1');
     my $score  = ($$record{'resource.'.$partid.'.awarded'} eq '' ?      my $score  = ($$record{'resource.'.$partid.'.awarded'} eq '' ?
   '' : &compute_points($$record{'resource.'.$partid.'.awarded'},$wgt));    '' : &compute_points($$record{'resource.'.$partid.'.awarded'},$wgt,
                          $$record{'resource.'.$partid.'.latefrac'}));
     my $data_WGT='<input type="hidden" name="WGT'.$counter.'_'.$partid.'" value="'.$wgt.'" />'."\n";      my $data_WGT='<input type="hidden" name="WGT'.$counter.'_'.$partid.'" value="'.$wgt.'" />'."\n";
     my $display_part= &get_display_part($partid,$symb);      my $display_part= &get_display_part($partid,$symb);
     my %last_resets = &get_last_resets($symb,$env{'request.course.id'},      my %last_resets = &get_last_resets($symb,$env{'request.course.id'},
Line 2206  sub files_exist { Line 3133  sub files_exist {
         my ($uname,$udom,$fullname) = split(/:/,$student);          my ($uname,$udom,$fullname) = split(/:/,$student);
         my %record = &Apache::lonnet::restore($symb,$env{'request.course.id'},          my %record = &Apache::lonnet::restore($symb,$env{'request.course.id'},
       $udom,$uname);        $udom,$uname);
         my ($string,$timestamp)= &get_last_submission(\%record);          my ($string)= &get_last_submission(\%record);
         foreach my $submission (@$string) {          foreach my $submission (@$string) {
             my ($partid,$respid) =              my ($partid,$respid) =
  ($submission =~ /^resource\.([^\.]*)\.([^\.]*)\.submission/);   ($submission =~ /^resource\.([^\.]*)\.([^\.]*)\.submission/);
Line 2558  sub submission { Line 3485  sub submission {
     #             (3) All transactions (by date)      #             (3) All transactions (by date)
     #             (4) The whole record (with detailed information for all transactions)      #             (4) The whole record (with detailed information for all transactions)
   
     my ($string,$timestamp)= &get_last_submission(\%record,$is_tool);      my ($lastsubonly,$partinfo) =
           &show_last_submission($uname,$udom,$symb,$essayurl,$responseType,$env{'form.lastSub'},
     my $lastsubonly;                                $is_tool,$fullname,\%record,\%coursedesc_by_cid);
       $request->print($partinfo);
     if ($$timestamp eq '') {  
         $lastsubonly.='<div class="LC_grade_submissions_body">'.$$string[0].'</div>';   
     } elsif ($is_tool) {  
         $lastsubonly =  
             '<div class="LC_grade_submissions_body">'  
            .'<b>'.&mt('Date Grade Passed Back:').'</b> '.$$timestamp."</div>\n";  
     } else {  
         $lastsubonly =  
             '<div class="LC_grade_submissions_body">'  
            .'<b>'.&mt('Date Submitted:').'</b> '.$$timestamp."\n";  
   
  my %seenparts;  
  my @part_response_id = &flatten_responseType($responseType);  
  foreach my $part (@part_response_id) {  
     my ($partid,$respid) = @{ $part };  
     my $display_part=&get_display_part($partid,$symb);  
     if ($env{"form.$uname:$udom:$partid:submitted_by"}) {  
  if (exists($seenparts{$partid})) { next; }  
  $seenparts{$partid}=1;  
                 $request->print(  
                     '<b>'.&mt('Part: [_1]',$display_part).'</b>'.  
                     ' <b>'.&mt('Collaborative submission by: [_1]',  
                                '<a href="javascript:viewSubmitter(\''.  
                                $env{"form.$uname:$udom:$partid:submitted_by"}.  
                                '\');" target="_self">'.  
                                $$fullname{$env{"form.$uname:$udom:$partid:submitted_by"}}.'</a>').  
                     '<br />');  
  next;  
     }  
     my $responsetype = $responseType->{$partid}->{$respid};  
     if (!exists($record{"resource.$partid.$respid.submission"})) {  
                 $lastsubonly.="\n".'<div class="LC_grade_submission_part">'.  
                     '<b>'.&mt('Part: [_1]',$display_part).'</b>'.  
                     ' <span class="LC_internal_info">'.  
                     '('.&mt('Response ID: [_1]',$respid).')'.  
                     '</span>&nbsp; &nbsp;'.  
           '<span class="LC_warning">'.&mt('Nothing submitted - no attempts.').'</span><br /><br /></div>';  
  next;  
     }  
     foreach my $submission (@$string) {  
  my ($partid,$respid) = ($submission =~ /^resource\.([^\.]*)\.([^\.]*)\.submission/);  
  if (join('_',@{$part}) ne ($partid.'_'.$respid)) { next; }  
  my ($ressub,$hide,$draft,$subval) = split(/:/,$submission,4);  
  # Similarity check  
                 my $similar='';  
                 my ($type,$trial,$rndseed);  
                 if ($hide eq 'rand') {  
                     $type = 'randomizetry';  
                     $trial = $record{"resource.$partid.tries"};  
                     $rndseed = $record{"resource.$partid.rndseed"};  
                 }  
         if ($env{'form.checkPlag'}) {  
     my ($oname,$odom,$ocrsid,$oessay,$osim)=  
     &most_similar($uname,$udom,$symb,$subval);  
     if ($osim) {  
  $osim=int($osim*100.0);  
                         if ($hide eq 'anon') {  
                             $similar='<hr /><span class="LC_warning">'.&mt("Essay was found to be similar to another essay submitted for this assignment.").'<br />'.  
                                      &mt('As the current submission is for an anonymous survey, no other details are available.').'</span><hr />';  
                         } else {  
     $similar='<hr />';  
                             if ($essayurl eq 'lib/templates/simpleproblem.problem') {  
                                 $similar .= '<h3><span class="LC_warning">'.  
                                             &mt('Essay is [_1]% similar to an essay by [_2]',  
                                                 $osim,  
                                                 &Apache::loncommon::plainname($oname,$odom).' ('.$oname.':'.$odom.')').  
                                             '</span></h3>';  
                             } else {  
                                 my %old_course_desc;  
                                 if ($ocrsid ne '') {  
                                     if (ref($coursedesc_by_cid{$ocrsid}) eq 'HASH') {  
                                         %old_course_desc = %{$coursedesc_by_cid{$ocrsid}};  
                                     } else {  
                                         my $args;  
                                         if ($ocrsid ne $env{'request.course.id'}) {  
                                             $args = {'one_time' => 1};  
                                         }  
                                         %old_course_desc =  
                                             &Apache::lonnet::coursedescription($ocrsid,$args);  
                                         $coursedesc_by_cid{$ocrsid} = \%old_course_desc;  
                                     }  
                                     $similar .=  
                                         '<h3><span class="LC_warning">'.  
                                         &mt('Essay is [_1]% similar to an essay by [_2] in course [_3] (course id [_4]:[_5])',  
                                             $osim,  
                                             &Apache::loncommon::plainname($oname,$odom).' ('.$oname.':'.$odom.')',  
                                             $old_course_desc{'description'},  
                                             $old_course_desc{'num'},  
                                             $old_course_desc{'domain'}).  
                                         '</span></h3>';  
                                 } else {  
                                     $similar .=  
                                         '<h3><span class="LC_warning">'.  
                                         &mt('Essay is [_1]% similar to an essay by [_2] in an unknown course',  
                                             $osim,  
                                             &Apache::loncommon::plainname($oname,$odom).' ('.$oname.':'.$odom.')').  
                                         '</span></h3>';  
                                 }  
                             }  
                             $similar .= '<blockquote><i>'.  
                                         &keywords_highlight($oessay).  
                                         '</i></blockquote><hr />';  
                         }  
             }  
  }  
  my $order=&get_order($partid,$respid,$symb,$uname,$udom,  
                                      undef,$type,$trial,$rndseed);  
                 if (($env{'form.lastSub'} eq 'lastonly') ||  
                     ($env{'form.lastSub'} eq 'datesub')  ||  
                     ($env{'form.lastSub'} =~ /^(last|all)$/)) {  
     my $display_part=&get_display_part($partid,$symb);  
                     $lastsubonly.='<div class="LC_grade_submission_part">'.  
                         '<b>'.&mt('Part: [_1]',$display_part).'</b>'.  
                         ' <span class="LC_internal_info">'.  
                         '('.&mt('Response ID: [_1]',$respid).')'.  
                         '</span>&nbsp; &nbsp;';  
     my $files=&get_submitted_files($udom,$uname,$partid,$respid,\%record);  
     if (@$files) {  
                         if ($hide eq 'anon') {  
                             $lastsubonly.='<br />'.&mt('[quant,_1,file] uploaded to this anonymous survey',scalar(@{$files}));  
                         } else {  
                             $lastsubonly.='<br /><br />'.'<b>'.&mt('Submitted Files:').'</b>'  
                                         .'<br /><span class="LC_warning">';  
                             if(@$files == 1) {  
                                 $lastsubonly .= &mt('Like all files provided by users, this file may contain viruses!');  
                             } else {  
                                 $lastsubonly .= &mt('Like all files provided by users, these files may contain viruses!');  
                             }  
                             $lastsubonly .= '</span>';  
                             foreach my $file (@$files) {  
                                 &Apache::lonnet::allowuploaded('/adm/grades',$file);  
                                 $lastsubonly.='<br /><a href="'.$file.'?rawmode=1" target="lonGRDs"><img src="'.&Apache::loncommon::icon($file).'" border="0" alt="" /> '.$file.'</a>';  
                             }  
                         }  
  $lastsubonly.='<br />';  
                     }  
                     if ($hide eq 'anon') {  
                         $lastsubonly.='<br /><b>'.&mt('Anonymous Survey').'</b>';   
                     } else {  
                         $lastsubonly.='<br /><b>'.&mt('Submitted Answer:').' </b>';  
                         if ($draft) {  
                             $lastsubonly.= ' <span class="LC_warning">'.&mt('Draft Copy').'</span>';  
                         }  
                         $subval =  
     &cleanRecord($subval,$responsetype,$symb,$partid,  
  $respid,\%record,$order,undef,$uname,$udom,$type,$trial,$rndseed);  
                         if ($responsetype eq 'essay') {  
                             $subval =~ s{\n}{<br />}g;  
                         }  
                         $lastsubonly.=$subval."\n";  
                     }  
                     if ($similar) {$lastsubonly.="<br /><br />$similar\n";}  
     $lastsubonly.='</div>';  
  }  
             }  
  }  
  $lastsubonly.='</div>'."\n"; # End: LC_grade_submissions_body  
     }  
     $request->print($lastsubonly);      $request->print($lastsubonly);
   
     if ($env{'form.lastSub'} eq 'datesub') {      if ($env{'form.lastSub'} eq 'datesub') {
         my ($parts,$handgrade,$responseType) = &response_type($symb,\$res_error);          my ($parts,$handgrade,$responseType) = &response_type($symb,\$res_error);
  $request->print(&displaySubByDates($symb,\%record,$parts,$responseType,$checkIcon,$uname,$udom));   $request->print(&displaySubByDates($symb,\%record,$parts,$responseType,$checkIcon,$uname,$udom));
Line 2844  sub submission { Line 3614  sub submission {
     return '';      return '';
 }  }
   
   sub show_last_submission {
       my ($uname,$udom,$symb,$essayurl,$responseType,$viewtype,$is_tool,$fullname,
           $record,$coursedesc_by_cid) = @_;
       my ($string,$timestamp,$lastgradetime,$lastsubmittime) =
           &get_last_submission($record,$is_tool);
   
       my ($lastsubonly,$partinfo);
       if ($timestamp eq '') {
           $lastsubonly.='<div class="LC_grade_submissions_body">'.$string->[0].'</div>';
       } elsif ($is_tool) {
           $lastsubonly =
               '<div class="LC_grade_submissions_body">'
              .'<b>'.&mt('Date Grade Passed Back:').'</b> '.$timestamp."</div>\n";
       } else {
           my ($shownsubmdate,$showngradedate);
           if ($lastsubmittime && $lastgradetime) {
               $shownsubmdate = &Apache::lonlocal::locallocaltime($lastsubmittime);
               if ($lastgradetime > $lastsubmittime) {
                    $showngradedate = &Apache::lonlocal::locallocaltime($lastgradetime);
                }
           } else {
               $shownsubmdate = $timestamp;
           }
           $lastsubonly =
               '<div class="LC_grade_submissions_body">'
              .'<b>'.&mt('Date Submitted:').'</b> '.$shownsubmdate."\n";
           if ($showngradedate) {
               $lastsubonly .= '<br /><b>'.&mt('Date Graded:').'</b> '.$showngradedate."\n";
           }
   
           my %seenparts;
           my @part_response_id = &flatten_responseType($responseType);
           foreach my $part (@part_response_id) {
               my ($partid,$respid) = @{ $part };
               my $display_part=&get_display_part($partid,$symb);
               if ($env{"form.$uname:$udom:$partid:submitted_by"}) {
                   if (exists($seenparts{$partid})) { next; }
                   $seenparts{$partid}=1;
                   $partinfo .=
                       '<b>'.&mt('Part: [_1]',$display_part).'</b>'.
                       ' <b>'.&mt('Collaborative submission by: [_1]',
                                  '<a href="javascript:viewSubmitter(\''.
                                  $env{"form.$uname:$udom:$partid:submitted_by"}.
                                  '\');" target="_self">'.
                                  $$fullname{$env{"form.$uname:$udom:$partid:submitted_by"}}.'</a>').
                       '<br />';
                   next;
               }
               my $responsetype = $responseType->{$partid}->{$respid};
               if (!exists($record->{"resource.$partid.$respid.submission"})) {
                   $lastsubonly.="\n".'<div class="LC_grade_submission_part">'.
                       '<b>'.&mt('Part: [_1]',$display_part).'</b>'.
                       ' <span class="LC_internal_info">'.
                       '('.&mt('Response ID: [_1]',$respid).')'.
                       '</span>&nbsp; &nbsp;'.
                       '<span class="LC_warning">'.&mt('Nothing submitted - no attempts.').'</span><br /><br /></div>';
                   next;
               }
               foreach my $submission (@$string) {
                   my ($partid,$respid) = ($submission =~ /^resource\.([^\.]*)\.([^\.]*)\.submission/);
                   if (join('_',@{$part}) ne ($partid.'_'.$respid)) { next; }
                   my ($ressub,$hide,$draft,$subval) = split(/:/,$submission,4);
                   # Similarity check
                   my $similar='';
                   my ($type,$trial,$rndseed);
                   if ($hide eq 'rand') {
                       $type = 'randomizetry';
                       $trial = $record->{"resource.$partid.tries"};
                       $rndseed = $record->{"resource.$partid.rndseed"};
                   }
                   if ($env{'form.checkPlag'}) {
                       my ($oname,$odom,$ocrsid,$oessay,$osim)=
                       &most_similar($uname,$udom,$symb,$subval);
                       if ($osim) {
                           $osim=int($osim*100.0);
                           if ($hide eq 'anon') {
                               $similar='<hr /><span class="LC_warning">'.&mt("Essay was found to be similar to another essay submitted for this assignment.").'<br />'.
                                        &mt('As the current submission is for an anonymous survey, no other details are available.').'</span><hr />';
                           } else {
                               $similar='<hr />';
                               if ($essayurl eq 'lib/templates/simpleproblem.problem') {
                                   $similar .= '<h3><span class="LC_warning">'.
                                               &mt('Essay is [_1]% similar to an essay by [_2]',
                                                   $osim,
                                                   &Apache::loncommon::plainname($oname,$odom).' ('.$oname.':'.$odom.')').
                                               '</span></h3>';
                               } else {
                                   my %old_course_desc;
                                   if ($ocrsid ne '') {
                                       if (ref($coursedesc_by_cid->{$ocrsid}) eq 'HASH') {
                                           %old_course_desc = %{$coursedesc_by_cid->{$ocrsid}};
                                       } else {
                                           my $args;
                                           if ($ocrsid ne $env{'request.course.id'}) {
                                               $args = {'one_time' => 1};
                                           }
                                           %old_course_desc =
                                               &Apache::lonnet::coursedescription($ocrsid,$args);
                                           $coursedesc_by_cid->{$ocrsid} = \%old_course_desc;
                                       }
                                       $similar .=
                                           '<h3><span class="LC_warning">'.
                                           &mt('Essay is [_1]% similar to an essay by [_2] in course [_3] (course id [_4]:[_5])',
                                               $osim,
                                               &Apache::loncommon::plainname($oname,$odom).' ('.$oname.':'.$odom.')',
                                               $old_course_desc{'description'},
                                               $old_course_desc{'num'},
                                               $old_course_desc{'domain'}).
                                           '</span></h3>';
                                   } else {
                                       $similar .=
                                           '<h3><span class="LC_warning">'.
                                           &mt('Essay is [_1]% similar to an essay by [_2] in an unknown course',
                                               $osim,
                                               &Apache::loncommon::plainname($oname,$odom).' ('.$oname.':'.$odom.')').
                                           '</span></h3>';
                                   }
                               }
                               $similar .= '<blockquote><i>'.
                                           &keywords_highlight($oessay).
                                           '</i></blockquote><hr />';
                           }
                       }
                   }
                   my $order=&get_order($partid,$respid,$symb,$uname,$udom,
                                        undef,$type,$trial,$rndseed);
                   if (($viewtype eq 'lastonly') ||
                       ($viewtype eq 'datesub')  ||
                       ($viewtype =~ /^(last|all)$/)) {
                       my $display_part=&get_display_part($partid,$symb);
                       $lastsubonly.='<div class="LC_grade_submission_part">'.
                           '<b>'.&mt('Part: [_1]',$display_part).'</b>'.
                           ' <span class="LC_internal_info">'.
                           '('.&mt('Response ID: [_1]',$respid).')'.
                           '</span>&nbsp; &nbsp;';
                       my $files=&get_submitted_files($udom,$uname,$partid,$respid,$record);
                       if (@$files) {
                           if ($hide eq 'anon') {
                               $lastsubonly.='<br />'.&mt('[quant,_1,file] uploaded to this anonymous survey',scalar(@{$files}));
                           } else {
                               $lastsubonly.='<br /><br />'.'<b>'.&mt('Submitted Files:').'</b>'
                                           .'<br /><span class="LC_warning">';
                               if(@$files == 1) {
                                   $lastsubonly .= &mt('Like all files provided by users, this file may contain viruses!');
                               } else {
                                   $lastsubonly .= &mt('Like all files provided by users, these files may contain viruses!');
                               }
                               $lastsubonly .= '</span>';
                               foreach my $file (@$files) {
                                   &Apache::lonnet::allowuploaded('/adm/grades',$file);
                                   $lastsubonly.='<br /><a href="'.$file.'?rawmode=1" target="lonGRDs"><img src="'.&Apache::loncommon::icon($file).'" border="0" alt="" /> '.$file.'</a>';
                               }
                           }
                           $lastsubonly.='<br />';
                       }
                       if ($hide eq 'anon') {
                           $lastsubonly.='<br /><b>'.&mt('Anonymous Survey').'</b>';
                       } else {
                           $lastsubonly.='<br /><b>'.&mt('Submitted Answer:').' </b>';
                           if ($draft) {
                               $lastsubonly.= ' <span class="LC_warning">'.&mt('Draft Copy').'</span>';
                           }
                           $subval =
                               &cleanRecord($subval,$responsetype,$symb,$partid,
                                            $respid,$record,$order,undef,$uname,$udom,$type,$trial,$rndseed);
                           if ($responsetype eq 'essay') {
                               $subval =~ s{\n}{<br />}g;
                           }
                           $lastsubonly.=$subval."\n";
                       }
                       if ($similar) {$lastsubonly.="<br /><br />$similar\n";}
                       $lastsubonly.='</div>';
                   }
               }
           }
           $lastsubonly.='</div>'."\n"; # End: LC_grade_submissions_body
       }
       return ($lastsubonly,$partinfo);
   }
   
 sub check_collaborators {  sub check_collaborators {
     my ($symb,$uname,$udom,$record,$handgrade,$counter) = @_;      my ($symb,$uname,$udom,$record,$handgrade,$counter) = @_;
     my ($result,@col_fullnames);      my ($result,@col_fullnames);
Line 2903  sub check_collaborators { Line 3853  sub check_collaborators {
 #--- Retrieve the last submission for all the parts  #--- Retrieve the last submission for all the parts
 sub get_last_submission {  sub get_last_submission {
     my ($returnhash,$is_tool)=@_;      my ($returnhash,$is_tool)=@_;
     my (@string,$timestamp,%lasthidden);      my (@string,$timestamp,$lastgradetime,$lastsubmittime);
     if ($$returnhash{'version'}) {      if ($$returnhash{'version'}) {
  my %lasthash=();   my %lasthash=();
  my ($version);          my %prevsolved=();
           my %solved=();
    my $version;
  for ($version=1;$version<=$$returnhash{'version'};$version++) {   for ($version=1;$version<=$$returnhash{'version'};$version++) {
               my %handgraded = ();
     foreach my $key (sort(split(/\:/,      foreach my $key (sort(split(/\:/,
  $$returnhash{$version.':keys'}))) {   $$returnhash{$version.':keys'}))) {
  $lasthash{$key}=$$returnhash{$version.':'.$key};   $lasthash{$key}=$$returnhash{$version.':'.$key};
  $timestamp =                   if ($key =~ /\.([^.]+)\.regrader$/) {
     &Apache::lonlocal::locallocaltime($$returnhash{$version.':timestamp'});                      $handgraded{$1} = 1;
                   } elsif ($key =~ /\.portfiles$/) {
                       if (($$returnhash{$version.':'.$key} ne '') &&
                           ($$returnhash{$version.':'.$key} !~ /\.\d+\.\w+$/)) {
                           $lastsubmittime = $$returnhash{$version.':timestamp'};
                       }
                   } elsif ($key =~ /\.submission$/) {
                       if ($$returnhash{$version.':'.$key} ne '') {
                           $lastsubmittime = $$returnhash{$version.':timestamp'};
                       }
                   } elsif ($key =~ /\.([^.]+)\.solved$/) {
                       $prevsolved{$1} = $solved{$1};
                       $solved{$1} = $lasthash{$key};
                   }
               }
               foreach my $partid (keys(%handgraded)) {
                   if (($prevsolved{$partid} eq 'ungraded_attempted') &&
                       (($solved{$partid} eq 'incorrect_by_override') ||
                        ($solved{$partid} eq 'correct_by_override'))) {
                       $lastgradetime = $$returnhash{$version.':timestamp'};
                   }
                   if ($solved{$partid} ne '') {
                       $prevsolved{$partid} = $solved{$partid};
                   }
     }      }
  }   }
   #
   # Timestamp is for last transaction for this resource, which does not
   # necessarily correspond to the time of last submission for problem (or part).
   #
           if ($lasthash{'timestamp'} ne '') {
               $timestamp = &Apache::lonlocal::locallocaltime($lasthash{'timestamp'});
           }
         my (%typeparts,%randombytry);          my (%typeparts,%randombytry);
         my $showsurv =           my $showsurv = 
             &Apache::lonnet::allowed('vas',$env{'request.course.id'});              &Apache::lonnet::allowed('vas',$env{'request.course.id'});
Line 2977  sub get_last_submission { Line 3960  sub get_last_submission {
  $string[0] =   $string[0] =
     '<span class="LC_warning">'.$msg.'</span>';      '<span class="LC_warning">'.$msg.'</span>';
     }      }
     return (\@string,\$timestamp);      return (\@string,$timestamp,$lastgradetime,$lastsubmittime);
 }  }
   
 #--- High light keywords, with style choosen by user.  #--- High light keywords, with style choosen by user.
Line 3184  sub processHandGrade { Line 4167  sub processHandGrade {
     my $ntstu  = $env{'form.NTSTU'};      my $ntstu  = $env{'form.NTSTU'};
     my $cdom   = $env{'course.'.$env{'request.course.id'}.'.domain'};      my $cdom   = $env{'course.'.$env{'request.course.id'}.'.domain'};
     my $cnum   = $env{'course.'.$env{'request.course.id'}.'.num'};      my $cnum   = $env{'course.'.$env{'request.course.id'}.'.num'};
       my ($res_error,%queueable);
       my ($partlist,$handgrade,$responseType,$numresp,$numessay) = &response_type($symb,\$res_error);
       if ($res_error) {
           $request->print(&navmap_errormsg());
           return;
       } else {
           foreach my $part (@{$partlist}) {
               if (ref($responseType->{$part}) eq 'HASH') {
                   foreach my $id (keys(%{$responseType->{$part}})) {
                       if (($responseType->{$part}->{$id} eq 'essay') ||
                           (lc($handgrade->{$part.'_'.$id}) eq 'yes')) {
                           $queueable{$part} = 1;
                           last;
                       }
                   }
               }
           }
       }
   
     if ($button eq 'Save & Next') {      if ($button eq 'Save & Next') {
           my %needpb = &passbacks_for_symb($cdom,$cnum,$symb);
           my (%skip_passback,%pbsave,%pbcollab);
  my $ctr = 0;   my $ctr = 0;
  while ($ctr < $ngrade) {   while ($ctr < $ngrade) {
     my ($uname,$udom) = split(/:/,$env{'form.unamedom'.$ctr});      my ($uname,$udom) = split(/:/,$env{'form.unamedom'.$ctr});
     my ($errorflag,$pts,$wgt,$numhidden) =       my ($errorflag,$pts,$wgt,$numhidden) = 
                 &saveHandGrade($request,$symb,$uname,$udom,$ctr);                  &saveHandGrade($request,$symb,$uname,$udom,$ctr,undef,undef,\%queueable,\%needpb,\%skip_passback,\%pbsave);
     if ($errorflag eq 'no_score') {      if ($errorflag eq 'no_score') {
  $ctr++;   $ctr++;
  next;   next;
Line 3243  sub processHandGrade { Line 4246  sub processHandGrade {
  foreach my $collabstr (@collabstrs) {   foreach my $collabstr (@collabstrs) {
     my ($part,@collaborators) = split(/:/,$collabstr);      my ($part,@collaborators) = split(/:/,$collabstr);
     foreach my $collaborator (@collaborators) {      foreach my $collaborator (@collaborators) {
  my ($errorflag,$pts,$wgt) =    my ($errorflag,$pts,$wgt,$numchg,$numupdate) = 
     &saveHandGrade($request,$symb,$collaborator,$udom,$ctr,      &saveHandGrade($request,$symb,$collaborator,$udom,$ctr,
    $env{'form.unamedom'.$ctr},$part);     $env{'form.unamedom'.$ctr},$part,\%queueable);
  if ($errorflag eq 'not_allowed') {   if ($errorflag eq 'not_allowed') {
     $request->print("<span class=\"LC_error\">".&mt('Not allowed to modify grades for [_1]',"$collaborator:$udom")."</span>");      $request->print("<span class=\"LC_error\">".&mt('Not allowed to modify grades for [_1]',"$collaborator:$udom")."</span>");
     next;      next;
  } elsif ($message ne '') {   } else {
     my ($baseurl,$showsymb) =                               if ($numchg || $numupdate) { 
  &get_feedurl_and_symb($symb,$collaborator,                                  $pbcollab{$collaborator}{$part} = [$pts,$wgt];
       $udom);                              }
     if ($env{'form.withgrades'.$ctr}) {                              if ($message ne '') {
  $messagetail = " for <a href=\"".          my ($baseurl,$showsymb) = 
                                     $baseurl."?symb=$showsymb\">$restitle</a>";      &get_feedurl_and_symb($symb,$collaborator,
             $udom);
           if ($env{'form.withgrades'.$ctr}) {
       $messagetail = " for <a href=\"".
                                           $baseurl."?symb=$showsymb\">$restitle</a>";
           }
           $msgstatus =
       &Apache::lonmsg::user_normal_msg($collaborator,$udom,$subject,$message.$messagetail,undef,$baseurl,undef,undef,undef,$showsymb,$restitle);
     }      }
     $msgstatus =           }
  &Apache::lonmsg::user_normal_msg($collaborator,$udom,$subject,$message.$messagetail,undef,$baseurl,undef,undef,undef,$showsymb,$restitle);  
  }  
     }      }
  }   }
     }      }
     $ctr++;      $ctr++;
  }   }
     }          if ((keys(%pbcollab)) && (keys(%needpb))) {
               foreach my $user (keys(%pbcollab)) {
     my $res_error;                  my ($clbuname,$clbudom) = split(/:/,$user);
     my ($partlist,$handgrade,$responseType,$numresp,$numessay) = &response_type($symb,\$res_error);                  my $clbusec = &Apache::lonnet::getsection($clbudom,$clbuname,$cdom.'_'.$cnum); 
     if ($res_error) {                  if (ref($pbcollab{$user}) eq 'HASH') {
         $request->print(&navmap_errormsg());                      my @clparts = keys(%{$pbcollab{$user}});
         return;                      if (@clparts) {
                           my $navmap = Apache::lonnavmaps::navmap->new($clbuname,$clbudom,$clbusec);
                           if (ref($navmap)) {
                               my $res = $navmap->getBySymb($symb);
                               if (ref($res)) {
                                   my $partlist = $res->parts();
                                   if (ref($partlist) eq 'ARRAY') {
                                       my (%weights,%awardeds,%excuseds);
                                       foreach my $part (@{$partlist}) {
                                           if ($res->status($part) eq $res->EXCUSED) {
                                               $excuseds{$symb}{$part} = 1;
                                           } else { 
                                               $excuseds{$symb}{$part} = '';
                                           }
                                           if ((exists($pbcollab{$user}{$part})) && (ref($pbcollab{$user}{$part}) eq 'ARRAY')) {
                                               my $pts = $pbcollab{$user}{$part}[0];
                                               my $wt = $pbcollab{$user}{$part}[1];
                                               if ($wt) {
                                                   $awardeds{$symb}{$part} = $pts/$wt;
                                                   $weights{$symb}{$part} = $wt;
                                               } else {
                                                   $awardeds{$symb}{$part} = 0;
                                                   $weights{$symb}{$part} = 0;
                                               }
                                           } else {
                                               $awardeds{$symb}{$part} = $res->awarded($part);
                                               $weights{$symb}{$part} = $res->weight($part);
                                           }
                                       }
                                       &process_passbacks('handgrade',[$symb],$cdom,$cnum,$clbudom,$clbuname,$clbusec,\%weights,
                                                          \%awardeds,\%excuseds,\%needpb,\%skip_passback,\%pbsave);
                                   }
                               }
                           }
                       }
                   }
               }
           }
     }      }
   
     my %keyhash = ();      my %keyhash = ();
Line 3425  sub processHandGrade { Line 4470  sub processHandGrade {
   
 #---- Save the score and award for each student, if changed  #---- Save the score and award for each student, if changed
 sub saveHandGrade {  sub saveHandGrade {
     my ($request,$symb,$stuname,$domain,$newflg,$submitter,$part) = @_;      my ($request,$symb,$stuname,$domain,$newflg,$submitter,
           $part,$queueable,$needpb,$skip_passback,$pbsave) = @_;
     my @version_parts;      my @version_parts;
     my $usec = &Apache::lonnet::getsection($domain,$stuname,      my $usec = &Apache::lonnet::getsection($domain,$stuname,
    $env{'request.course.id'});     $env{'request.course.id'});
Line 3433  sub saveHandGrade { Line 4479  sub saveHandGrade {
     my %record = &Apache::lonnet::restore($symb,$env{'request.course.id'},$domain,$stuname);      my %record = &Apache::lonnet::restore($symb,$env{'request.course.id'},$domain,$stuname);
     my @parts_graded;      my @parts_graded;
     my %newrecord  = ();      my %newrecord  = ();
     my ($pts,$wgt,$totchg) = ('','',0);      my ($pts,$wgt,$totchg,$sendupdate,$poss_pb) = ('','',0,0,0);
     my %aggregate = ();      my %aggregate = ();
     my $aggregateflag = 0;      my $aggregateflag = 0;
     if ($env{'form.HIDE'.$newflg}) {      if ($env{'form.HIDE'.$newflg}) {
Line 3441  sub saveHandGrade { Line 4487  sub saveHandGrade {
         my $numchgs = &makehidden($version,$parts,\%record,$symb,$domain,$stuname,1);          my $numchgs = &makehidden($version,$parts,\%record,$symb,$domain,$stuname,1);
         $totchg += $numchgs;          $totchg += $numchgs;
     }      }
       if ((ref($needpb) eq 'HASH') && (keys(%{$needpb}))) {
           $poss_pb = 1;
       }
       my (%weights,%awardeds,%excuseds);
     my @parts = split(/:/,$env{'form.partlist'.$newflg});      my @parts = split(/:/,$env{'form.partlist'.$newflg});
     foreach my $new_part (@parts) {      foreach my $new_part (@parts) {
  #collaborator ($submi may vary for different parts   #collaborator ($submitter may vary for different parts)
  if ($submitter && $new_part ne $part) { next; }   if ($submitter && $new_part ne $part) { next; }
  my $dropMenu = $env{'form.GD_SEL'.$newflg.'_'.$new_part};   my $dropMenu = $env{'form.GD_SEL'.$newflg.'_'.$new_part};
           if ($poss_pb) {
               $weights{$symb}{$new_part} =
                   &Apache::lonnet::EXT('resource.'.$new_part.'.weight',$symb,$domain,$stuname);
           } elsif ($env{'form.WGT'.$newflg.'_'.$new_part} eq '') {
               $weights{$symb}{$new_part} = 1;
           } else {
               $weights{$symb}{$new_part} = $env{'form.WGT'.$newflg.'_'.$new_part};
           }
  if ($dropMenu eq 'excused') {   if ($dropMenu eq 'excused') {
               $excuseds{$symb}{$new_part} = 1;
               $awardeds{$symb}{$new_part} = '';
     if ($record{'resource.'.$new_part.'.solved'} ne 'excused') {      if ($record{'resource.'.$new_part.'.solved'} ne 'excused') {
  $newrecord{'resource.'.$new_part.'.solved'} = 'excused';   $newrecord{'resource.'.$new_part.'.solved'} = 'excused';
  if (exists($record{'resource.'.$new_part.'.awarded'})) {   if (exists($record{'resource.'.$new_part.'.awarded'})) {
     $newrecord{'resource.'.$new_part.'.awarded'} = '';      $newrecord{'resource.'.$new_part.'.awarded'} = '';
  }   }
         $newrecord{'resource.'.$new_part.'.regrader'}="$env{'user.name'}:$env{'user.domain'}";          $newrecord{'resource.'.$new_part.'.regrader'}="$env{'user.name'}:$env{'user.domain'}";
                   $sendupdate ++;
     }      }
  } elsif ($dropMenu eq 'reset status'   } elsif ($dropMenu eq 'reset status'
  && exists($record{'resource.'.$new_part.'.solved'})) { #don't bother if no old records -> no attempts   && exists($record{'resource.'.$new_part.'.solved'})) { #don't bother if no old records -> no attempts
Line 3476  sub saveHandGrade { Line 4537  sub saveHandGrade {
                 &decrement_aggs($symb,$new_part,\%aggregate,$aggtries,$totaltries,$solvedstatus);                  &decrement_aggs($symb,$new_part,\%aggregate,$aggtries,$totaltries,$solvedstatus);
                 $aggregateflag = 1;                  $aggregateflag = 1;
             }              }
               $sendupdate ++;
               $excuseds{$symb}{$new_part} = '';
               $awardeds{$symb}{$new_part} = '';
  } elsif ($dropMenu eq '') {   } elsif ($dropMenu eq '') {
     $pts = ($env{'form.GD_BOX'.$newflg.'_'.$new_part} ne '' ?       $pts = ($env{'form.GD_BOX'.$newflg.'_'.$new_part} ne '' ? 
     $env{'form.GD_BOX'.$newflg.'_'.$new_part} :       $env{'form.GD_BOX'.$newflg.'_'.$new_part} : 
Line 3486  sub saveHandGrade { Line 4550  sub saveHandGrade {
     $wgt = $env{'form.WGT'.$newflg.'_'.$new_part} eq '' ? 1 :       $wgt = $env{'form.WGT'.$newflg.'_'.$new_part} eq '' ? 1 : 
  $env{'form.WGT'.$newflg.'_'.$new_part};   $env{'form.WGT'.$newflg.'_'.$new_part};
     my $partial= $pts/$wgt;      my $partial= $pts/$wgt;
               $awardeds{$symb}{$new_part} = $partial;
               $excuseds{$symb}{$new_part} = '';
     if ($partial eq $record{'resource.'.$new_part.'.awarded'}) {      if ($partial eq $record{'resource.'.$new_part.'.awarded'}) {
  #do not update score for part if not changed.   #do not update score for part if not changed.
                 &handback_files($request,$symb,$stuname,$domain,$newflg,$new_part,\%newrecord);                  &handback_files($request,$symb,$stuname,$domain,$newflg,$new_part,\%newrecord);
  next;   next;
     } else {      } else {
         push(@parts_graded,$new_part);          push(@parts_graded,$new_part);
                   $sendupdate ++;
     }      }
     if ($record{'resource.'.$new_part.'.awarded'} ne $partial) {      if ($record{'resource.'.$new_part.'.awarded'} ne $partial) {
  $newrecord{'resource.'.$new_part.'.awarded'}  = $partial;   $newrecord{'resource.'.$new_part.'.awarded'}  = $partial;
Line 3537  sub saveHandGrade { Line 4604  sub saveHandGrade {
  &Apache::lonnet::cstore(\%newrecord,$symb,   &Apache::lonnet::cstore(\%newrecord,$symb,
  $env{'request.course.id'},$domain,$stuname);   $env{'request.course.id'},$domain,$stuname);
  &check_and_remove_from_queue(\@parts,\%record,\%newrecord,$symb,   &check_and_remove_from_queue(\@parts,\%record,\%newrecord,$symb,
      $cdom,$cnum,$domain,$stuname);       $cdom,$cnum,$domain,$stuname,$queueable);
     }      }
     if ($aggregateflag) {      if ($aggregateflag) {
         &Apache::lonnet::cinc('nohist_resourcetracker',\%aggregate,          &Apache::lonnet::cinc('nohist_resourcetracker',\%aggregate,
       $cdom,$cnum);        $cdom,$cnum);
     }      }
     return ('',$pts,$wgt,$totchg);      if (($sendupdate || $totchg) && (!$submitter) && ($poss_pb)) {
           &process_passbacks('handgrade',[$symb],$cdom,$cnum,$domain,$stuname,$usec,\%weights,
                              \%awardeds,\%excuseds,$needpb,$skip_passback,$pbsave);
       }
       return ('',$pts,$wgt,$totchg,$sendupdate);
 }  }
   
 sub makehidden {  sub makehidden {
Line 3577  sub makehidden { Line 4648  sub makehidden {
 }  }
   
 sub check_and_remove_from_queue {  sub check_and_remove_from_queue {
     my ($parts,$record,$newrecord,$symb,$cdom,$cnum,$domain,$stuname) = @_;      my ($parts,$record,$newrecord,$symb,$cdom,$cnum,$domain,$stuname,$queueable) = @_;
     my @ungraded_parts;      my @ungraded_parts;
     foreach my $part (@{$parts}) {      foreach my $part (@{$parts}) {
  if (    $record->{   'resource.'.$part.'.awarded'} eq ''   if (    $record->{   'resource.'.$part.'.awarded'} eq ''
Line 3585  sub check_and_remove_from_queue { Line 4656  sub check_and_remove_from_queue {
      && $newrecord->{'resource.'.$part.'.awarded'} eq ''       && $newrecord->{'resource.'.$part.'.awarded'} eq ''
      && $newrecord->{'resource.'.$part.'.solved' } ne 'excused'       && $newrecord->{'resource.'.$part.'.solved' } ne 'excused'
  ) {   ) {
     push(@ungraded_parts, $part);              if ($queueable->{$part}) {
           push(@ungraded_parts, $part);
               }
  }   }
     }      }
     if ( !@ungraded_parts ) {      if ( !@ungraded_parts ) {
Line 3784  sub version_portfiles { Line 4857  sub version_portfiles {
             $$record{$key} = join(',',@versioned_portfiles);              $$record{$key} = join(',',@versioned_portfiles);
             push(@returned_keys,$key);              push(@returned_keys,$key);
         }          }
     }       }
     return (@returned_keys);         return (@returned_keys);
 }  }
   
 #--------------------------------------------------------------------------------------  #--------------------------------------------------------------------------------------
Line 4353  sub viewstudentgrade { Line 5426  sub viewstudentgrade {
     foreach my $apart (@$parts) {      foreach my $apart (@$parts) {
  my ($part,$type) = &split_part_type($apart);   my ($part,$type) = &split_part_type($apart);
  my $score=$record{"resource.$part.$type"};   my $score=$record{"resource.$part.$type"};
           my $latefrac=$record{"resource.$part.latefrac"};
         $result.='<td align="center">';          $result.='<td align="center">';
         my ($aggtries,$totaltries);          my ($aggtries,$totaltries);
         unless (exists($aggregates{$part})) {          unless (exists($aggregates{$part})) {
Line 4369  sub viewstudentgrade { Line 5443  sub viewstudentgrade {
             $aggregates{$part} = 1;              $aggregates{$part} = 1;
         }          }
  if ($type eq 'awarded') {   if ($type eq 'awarded') {
     my $pts = $score eq '' ? '' : &compute_points($score,$$weight{$part});      my $pts = $score eq '' ? '' : &compute_points($score,$$weight{$part},$latefrac);
     $result.='<input type="hidden" name="'.      $result.='<input type="hidden" name="'.
  'GD_'.$student.'_'.$part.'_awarded_s" value="'.$pts.'" />'."\n";   'GD_'.$student.'_'.$part.'_awarded_s" value="'.$pts.'" />'."\n";
     $result.='<input type="text" name="'.      $result.='<input type="text" name="'.
Line 4428  sub editgrades { Line 5502  sub editgrades {
     );      );
     my ($classlist,undef,$fullname) = &getclasslist($env{'form.section'},'0');      my ($classlist,undef,$fullname) = &getclasslist($env{'form.section'},'0');
   
       my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
       my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
       my %needpb = &passbacks_for_symb($cdom,$cnum,$symb);
   
     my (@partid);      my (@partid);
     my %weight = ();      my %weight = ();
     my %columns = ();      my %columns = ();
Line 4478  sub editgrades { Line 5556  sub editgrades {
  &Apache::loncommon::end_data_table_header_row();   &Apache::loncommon::end_data_table_header_row();
     my @noupdate;      my @noupdate;
     my ($updateCtr,$noupdateCtr) = (1,1);      my ($updateCtr,$noupdateCtr) = (1,1);
       my ($got_types,%queueable,%pbsave,%skip_passback);
     for ($i=0; $i<$env{'form.total'}; $i++) {      for ($i=0; $i<$env{'form.total'}; $i++) {
  my $user = $env{'form.ctr'.$i};   my $user = $env{'form.ctr'.$i};
  my ($uname,$udom)=split(/:/,$user);   my ($uname,$udom)=split(/:/,$user);
Line 4496  sub editgrades { Line 5575  sub editgrades {
         my %aggregate = ();          my %aggregate = ();
         my $aggregateflag = 0;          my $aggregateflag = 0;
  $user=~s/:/_/; # colon doen't work in javascript for names   $user=~s/:/_/; # colon doen't work in javascript for names
           my (%weights,%awardeds,%excuseds);
  foreach (@partid) {   foreach (@partid) {
     my $old_aw    = $env{'form.GD_'.$user.'_'.$_.'_awarded_s'};      my $old_aw    = $env{'form.GD_'.$user.'_'.$_.'_awarded_s'};
     my $old_part_pcr = $old_aw/($weight{$_} ne '0' ? $weight{$_}:1);      my $old_part_pcr = $old_aw/($weight{$_} ne '0' ? $weight{$_}:1);
Line 4504  sub editgrades { Line 5584  sub editgrades {
     my $awarded   = $env{'form.GD_'.$user.'_'.$_.'_awarded'};      my $awarded   = $env{'form.GD_'.$user.'_'.$_.'_awarded'};
     my $pcr       = $awarded/($weight{$_} ne '0' ? $weight{$_} : 1);      my $pcr       = $awarded/($weight{$_} ne '0' ? $weight{$_} : 1);
     my $partial   = $awarded eq '' ? '' : $pcr;      my $partial   = $awarded eq '' ? '' : $pcr;
               $awardeds{$symb}{$_} = $partial;
     my $score;      my $score;
     if ($partial eq '') {      if ($partial eq '') {
  $score = $scoreptr{$env{'form.GD_'.$user.'_'.$_.'_solved_s'}};   $score = $scoreptr{$env{'form.GD_'.$user.'_'.$_.'_solved_s'}};
Line 4544  sub editgrades { Line 5625  sub editgrades {
   
   
     my $partid=$_;      my $partid=$_;
               if ($score eq 'excused') {
                   $excuseds{$symb}{$partid} = 1;
               } else {
                   $excuseds{$symb}{$partid} = '';
               }
     foreach my $stores (@parts) {      foreach my $stores (@parts) {
  my ($part,$type) = &split_part_type($stores);   my ($part,$type) = &split_part_type($stores);
  if ($part !~ m/^\Q$partid\E/) { next;}   if ($part !~ m/^\Q$partid\E/) { next;}
Line 4561  sub editgrades { Line 5647  sub editgrades {
  }   }
  $line.="\n";   $line.="\n";
   
  my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};  
  my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};  
   
  if ($updateflag) {   if ($updateflag) {
     $count++;      $count++;
     &Apache::lonnet::cstore(\%newrecord,$symb,$env{'request.course.id'},      &Apache::lonnet::cstore(\%newrecord,$symb,$env{'request.course.id'},
Line 4577  sub editgrades { Line 5660  sub editgrades {
      $udom,$uname);       $udom,$uname);
  my $all_graded = 1;   my $all_graded = 1;
  my $none_graded = 1;   my $none_graded = 1;
                   unless ($got_types) {
                       my $error;
                       my ($plist,$handgrd,$resptype) = &response_type($symb,\$error);
                       unless ($error) {
                           foreach my $part (@parts) {
                               if (ref($resptype->{$part}) eq 'HASH') {
                                   foreach my $id (keys(%{$resptype->{$part}})) {
                                       if (($resptype->{$part}->{$id} eq 'essay') ||
                                           (lc($handgrd->{$part.'_'.$id}) eq 'yes')) {
                                           $queueable{$part} = 1;
                                           last;
                                       }
                                   }
                               }
                           }
                       }
                       $got_types = 1;
                   }
  foreach my $part (@parts) {   foreach my $part (@parts) {
     if ( $record{'resource.'.$part.'.awarded'} eq '' ) {                      if ($queueable{$part}) {
  $all_graded = 0;          if ( $record{'resource.'.$part.'.awarded'} eq '' ) {
     } else {      $all_graded = 0;
  $none_graded = 0;          } else {
       $none_graded = 0;
           }
     }      }
  }                  }
   
  if ($all_graded || $none_graded) {   if ($all_graded || $none_graded) {
     &Apache::bridgetask::remove_from_queue('gradingqueue',      &Apache::bridgetask::remove_from_queue('gradingqueue',
    $symb,$cdom,$cnum,     $symb,$cdom,$cnum,
Line 4596  sub editgrades { Line 5698  sub editgrades {
  '<td align="right">&nbsp;'.$updateCtr.'&nbsp;</td>'.$line.   '<td align="right">&nbsp;'.$updateCtr.'&nbsp;</td>'.$line.
  &Apache::loncommon::end_data_table_row();   &Apache::loncommon::end_data_table_row();
     $updateCtr++;      $updateCtr++;
               if (keys(%needpb)) {
                   $weights{$symb} = \%weight;
                   &process_passbacks('editgrades',[$symb],$cdom,$cnum,$udom,$uname,$usec,\%weights,
                                      \%awardeds,\%excuseds,\%needpb,\%skip_passback,\%pbsave);
               }
  } else {   } else {
     push(@noupdate,      push(@noupdate,
  '<td align="right">&nbsp;'.$noupdateCtr.'&nbsp;</td>'.$line);   '<td align="right">&nbsp;'.$noupdateCtr.'&nbsp;</td>'.$line);
Line 4961  sub csvuploadassign { Line 6068  sub csvuploadassign {
     my @gradedata = &Apache::loncommon::upfile_record_sep();      my @gradedata = &Apache::loncommon::upfile_record_sep();
     my %fields=&get_fields();      my %fields=&get_fields();
     my $courseid=$env{'request.course.id'};      my $courseid=$env{'request.course.id'};
       my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
       my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
     my ($classlist) = &getclasslist('all',0);      my ($classlist) = &getclasslist('all',0);
     my @notallowed;      my @notallowed;
     my @skipped;      my @skipped;
     my @warnings;      my @warnings;
     my $countdone=0;      my $countdone=0;
       my @parts;
       my %needpb = &passbacks_for_symb($cdom,$cnum,$symb);
       my $passback;
       if (keys(%needpb)) {
           $passback = 1;
           my $navmap = Apache::lonnavmaps::navmap->new();
           if (ref($navmap)) {
               my $res = $navmap->getBySymb($symb);
               if (ref($res)) {
                   my $partlist = $res->parts();
                   if (ref($partlist) eq 'ARRAY') {
                       @parts = sort(@{$partlist});
                   }
               }
           } else {
               return &navmap_errormsg();
           }
       }
       my (%skip_passback,%pbsave,%weights,%awardeds,%excuseds);
   
     foreach my $grade (@gradedata) {      foreach my $grade (@gradedata) {
  my %entries=&Apache::loncommon::record_sep($grade);   my %entries=&Apache::loncommon::record_sep($grade);
  my $domain;   my $domain;
Line 5040  sub csvuploadassign { Line 6169  sub csvuploadassign {
  my $part=$1;   my $part=$1;
  my $wgt =&Apache::lonnet::EXT('resource.'.$part.'.weight',   my $wgt =&Apache::lonnet::EXT('resource.'.$part.'.weight',
       $symb,$domain,$username);        $symb,$domain,$username);
                   $weights{$symb}{$part} = $wgt;
                 if ($wgt) {                  if ($wgt) {
                     $entries{$fields{$dest}}=~s/\s//g;                      $entries{$fields{$dest}}=~s/\s//g;
                     my $pcr=$entries{$fields{$dest}} / $wgt;                      my $pcr=$entries{$fields{$dest}} / $wgt;
                       if ($passback) {
                           $awardeds{$symb}{$part} = $pcr;
                           $excuseds{$symb}{$part} = '';
                       }
                     my $award=($pcr == 0) ? 'incorrect_by_override'                      my $award=($pcr == 0) ? 'incorrect_by_override'
                                           : 'correct_by_override';                                            : 'correct_by_override';
                     if ($pcr>1) {                      if ($pcr>1) {
Line 5062  sub csvuploadassign { Line 6196  sub csvuploadassign {
  if ($dest=~/stores_(.*)_awarded/) { if ($points{$1}) {next;} }   if ($dest=~/stores_(.*)_awarded/) { if ($points{$1}) {next;} }
  if ($dest=~/stores_(.*)_solved/)  { if ($points{$1}) {next;} }   if ($dest=~/stores_(.*)_solved/)  { if ($points{$1}) {next;} }
  my $store_key=$dest;   my $store_key=$dest;
                   if ($passback) {
                       if ($store_key=~/stores_(.*)_(awarded|solved)/) {
                           my ($part,$key) = ($1,$2);
                           unless ((ref($weights{$symb}) eq 'HASH') && (exists($weights{$symb}{$part}))) {
                               $weights{$symb}{$part} = &Apache::lonnet::EXT('resource.'.$part.'.weight',
                                                                             $symb,$domain,$username);
                           }
                           if ($key eq 'awarded') {
                               $awardeds{$symb}{$part} = $entries{$fields{$dest}};
                           } elsif ($key eq 'solved') {
                               if ($entries{$fields{$dest}} =~ /^excused/) {
                                   $excuseds{$symb}{$part} = 1;
                               }
                           }
                       }
                   }
  $store_key=~s/^stores/resource/;   $store_key=~s/^stores/resource/;
  $store_key=~s/_/\./g;   $store_key=~s/_/\./g;
  $grades{$store_key}=$entries{$fields{$dest}};   $grades{$store_key}=$entries{$fields{$dest}};
Line 5078  sub csvuploadassign { Line 6228  sub csvuploadassign {
 # Successfully stored  # Successfully stored
       $request->print('.');        $request->print('.');
 # Remove from grading queue  # Remove from grading queue
               &Apache::bridgetask::remove_from_queue('gradingqueue',$symb,                &Apache::bridgetask::remove_from_queue('gradingqueue',$symb,$cdom,$cnum,
                                              $env{'course.'.$env{'request.course.id'}.'.domain'},       $domain,$username);
                                              $env{'course.'.$env{'request.course.id'}.'.num'},  
                                              $domain,$username);  
               $countdone++;                $countdone++;
                 if ($passback) {
                     my @parts_in_upload;
                     if (ref($weights{$symb}) eq 'HASH') {
                         @parts_in_upload = sort(keys(%{$weights{$symb}}));
                     }
                     my @diffs = &Apache::loncommon::compare_arrays(\@parts_in_upload,\@parts);
                     if (@diffs > 0) {
                         my %record = &Apache::lonnet::restore($symb,$env{'request.course.id'},$domain,$username);
                         foreach my $part (@parts) {
                             next if (grep(/^\Q$part\E$/,@parts_in_upload));
                             $weights{$symb}{$part} = &Apache::lonnet::EXT('resource.'.$part.'.weight',
                                                                           $symb,$domain,$username);
                             if ($record{"resource.$part.solved"} =~/^excused/) {
                                 $excuseds{$symb}{$part} = 1;
                             } else {
                                 $excuseds{$symb}{$part} = '';
                             }
                             $awardeds{$symb}{$part} = $record{"resource.$part.awarded"};
                         }
                     }
                     &process_passbacks('csvupload',[$symb],$cdom,$cnum,$domain,$username,$usec,\%weights,
                                        \%awardeds,\%excuseds,\%needpb,\%skip_passback,\%pbsave);
                 }
            } else {             } else {
       $request->print("<p><span class=\"LC_error\">".        $request->print("<p><span class=\"LC_error\">".
                               &mt("Failed to save data for student [_1]. Message when trying to save was: [_2]",                                &mt("Failed to save data for student [_1]. Message when trying to save was: [_2]",
Line 5678  sub updateGradeByPage { Line 6849  sub updateGradeByPage {
     $iterator->next(); # skip the first BEGIN_MAP      $iterator->next(); # skip the first BEGIN_MAP
     my $curRes = $iterator->next(); # for "current resource"      my $curRes = $iterator->next(); # for "current resource"
     my ($depth,$question,$prob,$changeflag,$hideflag)= (1,1,1,0,0);      my ($depth,$question,$prob,$changeflag,$hideflag)= (1,1,1,0,0);
       my (@updates,%weights,%excuseds,%awardeds,@symbs_in_map);
     while ($depth > 0) {      while ($depth > 0) {
         if($curRes == $iterator->BEGIN_MAP) { $depth++; }          if($curRes == $iterator->BEGIN_MAP) { $depth++; }
         if($curRes == $iterator->END_MAP) { $depth--; }          if($curRes == $iterator->END_MAP) { $depth--; }
Line 5686  sub updateGradeByPage { Line 6858  sub updateGradeByPage {
     my $parts = $curRes->parts();      my $parts = $curRes->parts();
             my $title = $curRes->compTitle();              my $title = $curRes->compTitle();
     my $symbx = $curRes->symb();      my $symbx = $curRes->symb();
               push(@symbs_in_map,$symbx);
     $studentTable.=      $studentTable.=
  &Apache::loncommon::start_data_table_row().   &Apache::loncommon::start_data_table_row().
  '<td align="center" valign="top" >'.$prob.   '<td align="center" valign="top" >'.$prob.
Line 5698  sub updateGradeByPage { Line 6871  sub updateGradeByPage {
     my @displayPts=();      my @displayPts=();
             my %aggregate = ();              my %aggregate = ();
             my $aggregateflag = 0;              my $aggregateflag = 0;
               my %queueable;
             if ($env{'form.HIDE'.$prob}) {              if ($env{'form.HIDE'.$prob}) {
                 my %record = &Apache::lonnet::restore($symbx,$env{'request.course.id'},$udom,$uname);                  my %record = &Apache::lonnet::restore($symbx,$env{'request.course.id'},$udom,$uname);
                 my ($version,$parts) = split(/:/,$env{'form.HIDE'.$prob},2);                  my ($version,$parts) = split(/:/,$env{'form.HIDE'.$prob},2);
                 my $numchgs = &makehidden($version,$parts,\%record,$symbx,$udom,$uname,1);                  my $numchgs = &makehidden($version,$parts,\%record,$symbx,$udom,$uname,1);
                   if ($numchgs) {
                       push(@updates,$symbx);
                   }
                 $hideflag += $numchgs;                  $hideflag += $numchgs;
             }              }
     foreach my $partid (@{$parts}) {      foreach my $partid (@{$parts}) {
  my $newpts = $env{'form.GD_BOX'.$question.'_'.$partid};   my $newpts = $env{'form.GD_BOX'.$question.'_'.$partid};
  my $oldpts = $env{'form.oldpts'.$question.'_'.$partid};   my $oldpts = $env{'form.oldpts'.$question.'_'.$partid};
                   my @types = $curRes->responseType($partid);
                   if (grep(/^essay$/,@types)) {
                       $queueable{$partid} = 1;
                   } else {
                       my @ids = $curRes->responseIds($partid);
                       for (my $i=0; $i < scalar(@ids); $i++) {
                           my $hndgrd = &Apache::lonnet::EXT('resource.'.$partid.'_'.$ids[$i].
                                                             '.handgrade',$symb);
                           if (lc($hndgrd) eq 'yes') {
                               $queueable{$partid} = 1;
                               last;
                           }
                       }
                   }
  my $wgt = $env{'form.WGT'.$question.'_'.$partid} != 0 ?    my $wgt = $env{'form.WGT'.$question.'_'.$partid} != 0 ? 
     $env{'form.WGT'.$question.'_'.$partid} : 1;      $env{'form.WGT'.$question.'_'.$partid} : 1;
                   $weights{$symbx}{$partid} = $wgt;
                   $excuseds{$symbx}{$partid} = '';
  my $partial = $newpts/$wgt;   my $partial = $newpts/$wgt;
  my $score;   my $score;
  if ($partial > 0) {   if ($partial > 0) {
Line 5721  sub updateGradeByPage { Line 6913  sub updateGradeByPage {
  if ($dropMenu eq 'excused') {   if ($dropMenu eq 'excused') {
     $partial = '';      $partial = '';
     $score = 'excused';      $score = 'excused';
                       $excuseds{$symbx}{$partid} = 1;
  } elsif ($dropMenu eq 'reset status'   } elsif ($dropMenu eq 'reset status'
  && $env{'form.solved'.$question.'_'.$partid} ne '') { #update only if previous record exists   && $env{'form.solved'.$question.'_'.$partid} ne '') { #update only if previous record exists
     $newrecord{'resource.'.$partid.'.tries'} = 0;      $newrecord{'resource.'.$partid.'.tries'} = 0;
Line 5748  sub updateGradeByPage { Line 6941  sub updateGradeByPage {
      (($score eq 'excused') ? 'excused' : $newpts).       (($score eq 'excused') ? 'excused' : $newpts).
     '&nbsp;<br />';      '&nbsp;<br />';
  $question++;   $question++;
                   if (($newpts eq '') || ($partial eq '')) {
                       $awardeds{$symbx}{$partid} = 0;
                   } else {
                       $awardeds{$symbx}{$partid} = $partial;
                   }
  next if ($dropMenu eq 'reset status' || ($newpts eq $oldpts && $score ne 'excused'));   next if ($dropMenu eq 'reset status' || ($newpts eq $oldpts && $score ne 'excused'));
   
  $newrecord{'resource.'.$partid.'.awarded'}  = $partial if $partial ne '';   $newrecord{'resource.'.$partid.'.awarded'}  = $partial if $partial ne '';
Line 5773  sub updateGradeByPage { Line 6971  sub updateGradeByPage {
    $env{'request.course.id'},     $env{'request.course.id'},
    $udom,$uname);     $udom,$uname);
  &check_and_remove_from_queue($parts,\%record,undef,$symbx,   &check_and_remove_from_queue($parts,\%record,undef,$symbx,
      $cdom,$cnum,$udom,$uname);       $cdom,$cnum,$udom,$uname,\%queueable);
     }      }
           
             if ($aggregateflag) {              if ($aggregateflag) {
Line 5787  sub updateGradeByPage { Line 6985  sub updateGradeByPage {
  &Apache::loncommon::end_data_table_row();   &Apache::loncommon::end_data_table_row();
   
     $prob++;      $prob++;
               if ($changeflag) {
                   push(@updates,$symbx);
               }
  }   }
         $curRes = $iterator->next();          $curRes = $iterator->next();
     }      }
Line 5800  sub updateGradeByPage { Line 7001  sub updateGradeByPage {
                      $hideflag).'<br />');                       $hideflag).'<br />');
     $request->print($hidemsg.$grademsg.$studentTable);      $request->print($hidemsg.$grademsg.$studentTable);
   
       if (@updates) {
           my (@allsymbs,$mapsymb,@recurseup,%parentmapsymbs,%possmappb,%possrespb);
           @allsymbs = @updates;
           if (ref($map)) {
               $mapsymb = $map->symb();
               push(@allsymbs,$mapsymb);
               @recurseup = $navmap->recurseup_maps($map->src,1);
           }
           if (@recurseup) {
               push(@allsymbs,@recurseup);
               map { $parentmapsymbs{$_} = 1; } @recurseup;
           }
           my %passback = &Apache::lonnet::get('nohist_linkprot_passback',\@allsymbs,$cdom,$cnum);
           my (%uniqsymbs,$use_symbs_in_map,%launch_to_symb);
           if (keys(%passback)) {
               foreach my $possible (keys(%passback)) {
                   if (ref($passback{$possible}) eq 'HASH') {
                       if ($possible eq $mapsymb) {
                           foreach my $launcher (keys(%{$passback{$possible}})) {
                               $possmappb{$launcher} = 1;
                               $launch_to_symb{$launcher} = $possible;
                           }
                           $use_symbs_in_map = 1;
                       } elsif (exists($parentmapsymbs{$possible})) {
                           foreach my $launcher (keys(%{$passback{$possible}})) {
                               my ($linkuri,$linkprotector,$scope) = split(/\0/,$launcher);
                               if ($scope eq 'rec') {
                                   $possmappb{$launcher} = 1;
                                   $use_symbs_in_map = 1;
                                   $launch_to_symb{$launcher} = $possible;
                               }
                           }
                       } elsif (grep(/^\Q$possible$\E$/,@updates)) {
                           foreach my $launcher (keys(%{$passback{$possible}})) {
                               $possrespb{$launcher} = 1;
                               $launch_to_symb{$launcher} = $possible;
                           }
                           $uniqsymbs{$possible} = 1;
                       }
                   }
               }
           }
           if ($use_symbs_in_map) {
               map { $uniqsymbs{$_} = 1; } @symbs_in_map;
           }
           my @posslaunchers;
           if (keys(%possmappb)) {
               push(@posslaunchers,keys(%possmappb));
           }
           if (keys(%possrespb)) {
               push(@posslaunchers,keys(%possrespb));
           }
           if (@posslaunchers) {
               my (%pbsave,%skip_passback,%needpb);
               my %pbids = &Apache::lonnet::get('nohist_'.$cdom.'_'.$cnum.'_linkprot_pb',\@posslaunchers,$udom,$uname);
               foreach my $key (keys(%pbids)) {
                   if (ref($pbids{$key}) eq 'ARRAY') {
                       if ($launch_to_symb{$key}) {
                           $needpb{$key} = $launch_to_symb{$key};
                       }
                   }
               }
               my @symbs = keys(%uniqsymbs);
               &process_passbacks('updatebypage',\@symbs,$cdom,$cnum,$udom,$uname,$usec,\%weights,
                                  \%awardeds,\%excuseds,\%needpb,\%skip_passback,\%pbsave,\%pbids);
               if (@Apache::grades::ltipassback) {
                   unless ($registered_cleanup) {
                       my $handlers = $request->get_handlers('PerlCleanupHandler');
                       $request->set_handlers('PerlCleanupHandler' =>
                                              [\&Apache::grades::make_passback,@{$handlers}]);
                       $registered_cleanup=1;
                   }
               }
           }
       }
     return '';      return '';
 }  }
   
   sub make_passback {
       if (@Apache::grades::ltipassback) {
           my $lonhost = $Apache::lonnet::perlvar{'lonHostID'};
           my $ip = &Apache::lonnet::get_host_ip($lonhost);
           foreach my $item (@Apache::grades::ltipassback) {
               &Apache::lonhomework::run_passback($item,$lonhost,$ip);
           }
           undef(@Apache::grades::ltipassback);
       }
   }
   
 #-------- end of section for handling grading by page/sequence ---------  #-------- end of section for handling grading by page/sequence ---------
 #  #
 #-------------------------------------------------------------------  #-------------------------------------------------------------------
Line 6685  sub scantron_parse_scanline { Line 7972  sub scantron_parse_scanline {
 }  }
   
 sub get_master_seq {  sub get_master_seq {
     my ($resources,$master_seq,$symb_to_resource) = @_;      my ($resources,$master_seq,$symb_to_resource,$need_symb_in_map,$symb_for_examcode) = @_;
     return unless ((ref($resources) eq 'ARRAY') && (ref($master_seq) eq 'ARRAY') &&       return unless ((ref($resources) eq 'ARRAY') && (ref($master_seq) eq 'ARRAY') && 
                    (ref($symb_to_resource) eq 'HASH'));                     (ref($symb_to_resource) eq 'HASH'));
       if ($need_symb_in_map) {
           return unless (ref($symb_for_examcode) eq 'HASH');
       }
     my $resource_error;      my $resource_error;
     foreach my $resource (@{$resources}) {      foreach my $resource (@{$resources}) {
         my $ressymb;          my $ressymb;
Line 6695  sub get_master_seq { Line 7985  sub get_master_seq {
             $ressymb = $resource->symb();              $ressymb = $resource->symb();
             push(@{$master_seq},$ressymb);              push(@{$master_seq},$ressymb);
             $symb_to_resource->{$ressymb} = $resource;              $symb_to_resource->{$ressymb} = $resource;
               if ($need_symb_in_map) {
                   unless ($resource->is_map()) {
                       my $map=(&Apache::lonnet::decode_symb($ressymb))[0];
                       unless (exists($symb_for_examcode->{$map})) {
                           $symb_for_examcode->{$map} = $ressymb;
                       }
                   }
               }
         } else {          } else {
             $resource_error = 1;              $resource_error = 1;
             last;              last;
Line 8706  sub scantron_validate_doublebubble { Line 10004  sub scantron_validate_doublebubble {
     if (ref($map)) {      if (ref($map)) {
         $randomorder = $map->randomorder();          $randomorder = $map->randomorder();
         $randompick = $map->randompick();          $randompick = $map->randompick();
           unless ($randomorder || $randompick) {
               foreach my $res ($navmap->retrieveResources($map,sub { $_[0]->is_map() },1,0,1)) {
                   if ($res->randomorder()) {
                       $randomorder = 1;
                   }
                   if ($res->randompick()) {
                       $randompick = 1;
                   }
                   last if ($randomorder || $randompick);
               }
           }
         if ($randomorder || $randompick) {          if ($randomorder || $randompick) {
             $nav_error = &get_master_seq(\@resources,\@master_seq,\%symb_to_resource);              $nav_error = &get_master_seq(\@resources,\@master_seq,\%symb_to_resource);
             if ($nav_error) {              if ($nav_error) {
Line 8889  sub scantron_validate_missingbubbles { Line 10198  sub scantron_validate_missingbubbles {
     if (ref($map)) {      if (ref($map)) {
         $randomorder = $map->randomorder();          $randomorder = $map->randomorder();
         $randompick = $map->randompick();          $randompick = $map->randompick();
           unless ($randomorder || $randompick) {
               foreach my $res ($navmap->retrieveResources($map,sub { $_[0]->is_map() },1,0,1)) {
                   if ($res->randomorder()) {
                       $randomorder = 1;
                   }
                   if ($res->randompick()) {
                       $randompick = 1;
                   }
                   last if ($randomorder || $randompick);
               }
           }
         if ($randomorder || $randompick) {          if ($randomorder || $randompick) {
             $nav_error = &get_master_seq(\@resources,\@master_seq,\%symb_to_resource);              $nav_error = &get_master_seq(\@resources,\@master_seq,\%symb_to_resource);
             if ($nav_error) {              if ($nav_error) {
Line 9030  sub scantron_process_students { Line 10350  sub scantron_process_students {
     }      }
     my $map=$navmap->getResourceByUrl($sequence);      my $map=$navmap->getResourceByUrl($sequence);
     my ($randomorder,$randompick,@master_seq,%symb_to_resource,%grader_partids_by_symb,      my ($randomorder,$randompick,@master_seq,%symb_to_resource,%grader_partids_by_symb,
         %grader_randomlists_by_symb);          %grader_randomlists_by_symb,%symb_for_examcode);
     if (ref($map)) {      if (ref($map)) {
         $randomorder = $map->randomorder();          $randomorder = $map->randomorder();
         $randompick = $map->randompick();          $randompick = $map->randompick();
           unless ($randomorder || $randompick) {
               foreach my $res ($navmap->retrieveResources($map,sub { $_[0]->is_map() },1,0,1)) {
                   if ($res->randomorder()) {
                       $randomorder = 1;
                   }
                   if ($res->randompick()) {
                       $randompick = 1;
                   }
                   last if ($randomorder || $randompick);
               }
           }
     } else {      } else {
         $r->print(&navmap_errormsg());          $r->print(&navmap_errormsg());
         return '';          return '';
Line 9041  sub scantron_process_students { Line 10372  sub scantron_process_students {
     my $nav_error;      my $nav_error;
     my @resources=$navmap->retrieveResources($map,\&scantron_filter,1,0);      my @resources=$navmap->retrieveResources($map,\&scantron_filter,1,0);
     if ($randomorder || $randompick) {      if ($randomorder || $randompick) {
         $nav_error = &get_master_seq(\@resources,\@master_seq,\%symb_to_resource);          $nav_error = &get_master_seq(\@resources,\@master_seq,\%symb_to_resource,1,\%symb_for_examcode);
         if ($nav_error) {          if ($nav_error) {
             $r->print(&navmap_errormsg());              $r->print(&navmap_errormsg());
             return '';              return '';
Line 9196  SCANTRONFORM Line 10527  SCANTRONFORM
         }          }
   
         if (($scancode) && ($randomorder || $randompick)) {          if (($scancode) && ($randomorder || $randompick)) {
             my $parmresult =              foreach my $key (keys(%symb_for_examcode)) {
                 &Apache::lonparmset::storeparm_by_symb($symb,                  my $symb_in_map = $symb_for_examcode{$key};
                                                        '0_examcode',2,$scancode,                  if ($symb_in_map ne '') {
                                                        'string_examcode',$uname,                      my $parmresult =
                                                        $udom);                          &Apache::lonparmset::storeparm_by_symb($symb_in_map,
                                                                  '0_examcode',2,$scancode,
                                                                  'string_examcode',$uname,
                                                                  $udom);
                   }
               }
         }          }
  $completedstudents{$uname}={'line'=>$line};   $completedstudents{$uname}={'line'=>$line};
         if ($env{'form.verifyrecord'}) {          if ($env{'form.verifyrecord'}) {
Line 9515  END Line 10851  END
                             my @lines = &Apache::lonnet::get_scantronformat_file();                              my @lines = &Apache::lonnet::get_scantronformat_file();
                             my $count = 0;                              my $count = 0;
                             foreach my $line (@lines) {                              foreach my $line (@lines) {
                                 next if ($line =~ /^#/);                                  next if (($line =~ /^\#/) || ($line eq ''));
                                 $singleline = $line;                                  $singleline = $line;
                                 $count ++;                                  $count ++;
                             }                              }
Line 9709  sub validate_uploaded_scantron_file { Line 11045  sub validate_uploaded_scantron_file {
         my %unique_formats;          my %unique_formats;
         my @formatlines = &Apache::lonnet::get_scantronformat_file();          my @formatlines = &Apache::lonnet::get_scantronformat_file();
         foreach my $line (@formatlines) {          foreach my $line (@formatlines) {
             chomp($line);              next if (($line =~ /^\#/) || ($line eq ''));
             my @config = split(/:/,$line);              my @config = split(/:/,$line);
             my $idstart = $config[5];              my $idstart = $config[5];
             my $idlength = $config[6];              my $idlength = $config[6];
Line 10079  sub checkscantron_results { Line 11415  sub checkscantron_results {
     if (ref($map)) {       if (ref($map)) { 
         $randomorder=$map->randomorder();          $randomorder=$map->randomorder();
         $randompick=$map->randompick();          $randompick=$map->randompick();
           unless ($randomorder || $randompick) {
               foreach my $res ($navmap->retrieveResources($map,sub { $_[0]->is_map() },1,0,1)) {
                   if ($res->randomorder()) {
                       $randomorder = 1;
                   }
                   if ($res->randompick()) {
                       $randompick = 1;
                   }
                   last if ($randomorder || $randompick);
               }
           }
     }      }
     my @resources=$navmap->retrieveResources($map,\&scantron_filter,1,0);      my @resources=$navmap->retrieveResources($map,\&scantron_filter,1,0);
     my $nav_error = &get_master_seq(\@resources,\@master_seq,\%symb_to_resource);      my $nav_error = &get_master_seq(\@resources,\@master_seq,\%symb_to_resource);
Line 10397  sub verify_scantron_grading { Line 11744  sub verify_scantron_grading {
   
 sub href_symb_cmd {  sub href_symb_cmd {
     my ($symb,$cmd)=@_;      my ($symb,$cmd)=@_;
     return '/adm/grades?symb='.&HTML::Entities::encode(&Apache::lonenc::check_encrypt($symb),'<>&"').'&amp;command='.$cmd;      return '/adm/grades?symb='.&HTML::Entities::encode(&Apache::lonenc::check_encrypt($symb),'<>&"').'&amp;command='.
              &HTML::Entities::encode($cmd,'<>&"');
 }  }
   
 sub grading_menu {  sub grading_menu {
Line 10506  sub grading_menu { Line 11854  sub grading_menu {
   
                     ]                      ]
             });              });
       my $cdom = $env{"course.$env{'request.course.id'}.domain"};
       my $cnum = $env{"course.$env{'request.course.id'}.num"};
       my %passback = &Apache::lonnet::dump('nohist_linkprot_passback',$cdom,$cnum);
       if (keys(%passback)) {
           $fields{'command'} = 'initialpassback';
           my $url6 = &Apache::lonhtmlcommon::build_url('grades/',\%fields);
           push (@{$menu[1]{items}},
                     { linktext => 'Passback of Scores',
                       url => $url6,
                       permission => $permissions{'either'},
                       icon => 'passback.png',
                       linktitle => 'Passback scores to launcher CMS for resources accessed via LTI-mediated deep-linking',
                     });
       }
     # Create the menu      # Create the menu
     my $Str;      my $Str;
     $Str .= '<form method="post" action="" name="gradingMenu">';      $Str .= '<form method="post" action="" name="gradingMenu">';
Line 11245  sub assign_clicker_grades { Line 12606  sub assign_clicker_grades {
     if ($res_error) {      if ($res_error) {
         return &navmap_errormsg();          return &navmap_errormsg();
     }      }
       my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
       my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
       my %needpb = &passbacks_for_symb($cdom,$cnum,$symb);
       my (%skip_passback,%pbsave); 
 # FIXME: This should probably look for the first handgradeable part  # FIXME: This should probably look for the first handgradeable part
     my $part=$$partlist[0];      my $part=$$partlist[0];
 # Start screen output  # Start screen output
Line 11354  sub assign_clicker_grades { Line 12719  sub assign_clicker_grades {
              $result.="<br /><span class=\"LC_error\">Failed to save student $username:$domain. Message when trying to save was ($returncode)</span>";               $result.="<br /><span class=\"LC_error\">Failed to save student $username:$domain. Message when trying to save was ($returncode)</span>";
           } else {            } else {
              $storecount++;               $storecount++;
                if (keys(%needpb)) {
                    my (%weights,%awardeds,%excuseds);
                    my $usec = &Apache::lonnet::getsection($domain,$username,$env{'request.course.id'});
                    $weights{$symb}{$part} = &Apache::lonnet::EXT("resource.$part.weight",$symb,$domain,$username,$usec);
                    $awardeds{$symb}{$part} = $ave;
                    $excuseds{$symb}{$part} = '';
                    &process_passbacks('clickergrade',[$symb],$cdom,$cnum,$domain,$username,$usec,\%weights,
                                       \%awardeds,\%excuseds,\%needpb,\%skip_passback,\%pbsave);
                }
           }            }
        }         }
     }      }
Line 11385  sub startpage { Line 12759  sub startpage {
         $args{'only_body'} = 1;           $args{'only_body'} = 1; 
         $r->print(&Apache::loncommon::start_page("Student's Version",$head_extra,\%args));          $r->print(&Apache::loncommon::start_page("Student's Version",$head_extra,\%args));
     } else {      } else {
         unshift(@$crumbs,{href=>&href_symb_cmd($symb,'gradingmenu'),text=>"Grading"});          if ($env{'request.course.id'}) { 
               unshift(@$crumbs,{href=>&href_symb_cmd($symb,'gradingmenu'),text=>"Grading"});
           }
         $args{'bread_crumbs'} = $crumbs;          $args{'bread_crumbs'} = $crumbs;
         $r->print(&Apache::loncommon::start_page('Grading',$head_extra,\%args));          $r->print(&Apache::loncommon::start_page('Grading',$head_extra,\%args));
         if ($env{'request.course.id'}) {          if ($env{'request.course.id'}) {
Line 11405  sub select_problem { Line 12781  sub select_problem {
     $r->print('<input type="submit" value="'.&mt('Next').' &rarr;" /></form>');      $r->print('<input type="submit" value="'.&mt('Next').' &rarr;" /></form>');
 }  }
   
   #----- display problem, answer, and submissions for a single student (no grading)
   
   sub view_as_user {
       my ($symb,$vuname,$vudom,$hasperm) = @_;
       my $plainname = &Apache::loncommon::plainname($vuname,$vudom,'lastname');
       my $displayname = &nameUserString('',$plainname,$vuname,$vudom);
       my $output = &Apache::loncommon::get_student_view($symb,$vuname,$vudom,
                                                         $env{'request.course.id'},
                                                         undef,{'disable_submit' => 1}).
                    "\n\n".
                    '<div class="LC_grade_show_user">'.
                    '<h2>'.$displayname.'</h2>'.
                    "\n".
                    &Apache::loncommon::track_student_link('View recent activity',
                                                           $vuname,$vudom,'check').' '.
                    "\n";
       if (&Apache::lonnet::allowed('opa',$env{'request.course.id'}) ||
           (($env{'request.course.sec'} ne '') &&
            &Apache::lonnet::allowed('opa',$env{'request.course.id'}.'/'.$env{'request.course.sec'}))) {
           $output .= &Apache::loncommon::pprmlink(&mt('Set/Change parameters'),
                                                  $vuname,$vudom,$symb,'check');
       }
       $output .= "\n";
       my $companswer = &Apache::loncommon::get_student_answers($symb,$vuname,$vudom,
                                                                $env{'request.course.id'});
       $companswer=~s|<form(.*?)>||g;
       $companswer=~s|</form>||g;
       $companswer=~s|name="submit"|name="would_have_been_submit"|g;
       $output .= '<div class="LC_Box">'.
                  '<h3 class="LC_hcell">'.&mt('Correct answer for[_1]',$displayname).'</h3>'.
                  $companswer.
                  '</div>'."\n";
       my $is_tool = ($symb =~ /ext\.tool$/);
       my ($essayurl,%coursedesc_by_cid);
       (undef,undef,$essayurl) = &Apache::lonnet::decode_symb($symb);
       my %record = &Apache::lonnet::restore($symb,$env{'request.course.id'},$vudom,$vuname);
       my $res_error;
       my ($partlist,$handgrade,$responseType,$numresp,$numessay) =
           &response_type($symb,\$res_error);
       my $fullname;
       my $collabinfo;
       if ($numessay) {
           unless ($hasperm) {
               &init_perm();
           }
           ($collabinfo,$fullname)=
               &check_collaborators($symb,$vuname,$vudom,\%record,$handgrade,0);
           unless ($hasperm) {
               &reset_perm();
           }
       }
       my $checkIcon = '<img alt="'.&mt('Check Mark').
                       '" src="'.$Apache::lonnet::perlvar{'lonIconsURL'}.
                       '/check.gif" height="16" border="0" />';
       my ($lastsubonly,$partinfo) =
           &show_last_submission($vuname,$vudom,$symb,$essayurl,$responseType,'datesub',
                                 '',$fullname,\%record,\%coursedesc_by_cid);
       $output .= '<div class="LC_Box">'.
                  '<h3 class="LC_hcell">'.&mt('Submissions').'</h3>'."\n".$collabinfo."\n";
       if (($numresp > $numessay) & !$is_tool) {
           $output .='<p class="LC_info">'.
                     &mt('Part(s) graded correct by the computer is marked with a [_1] symbol.',$checkIcon).
                     "</p>\n";
       }
       $output .= $partinfo;
       $output .= $lastsubonly;
       $output .= &displaySubByDates($symb,\%record,$partlist,$responseType,$checkIcon,$vuname,$vudom);
       $output .= '</div></div>'."\n";
       return $output;
   }
   
 sub handler {  sub handler {
     my $request=$_[0];      my $request=$_[0];
     &reset_caches();      &reset_caches();
Line 11439  sub handler { Line 12886  sub handler {
  &Apache::lonnet::logthis("grades got multiple commands ".join(':',@commands));   &Apache::lonnet::logthis("grades got multiple commands ".join(':',@commands));
     }      }
   
   # -------------------------------------- Flag and buffer for registered cleanup
       $registered_cleanup=0;
       undef(@Apache::grades::ltipassback);
   
 # see what the symb is  # see what the symb is
   
     my $symb=$env{'form.symb'};      my $symb=$env{'form.symb'};
Line 11653  sub handler { Line 13104  sub handler {
                undef,undef,undef,undef,undef,undef,undef,1);                 undef,undef,undef,undef,undef,undef,undef,1);
             $request->print('<div style="padding:0;clear:both;margin:0;border:0"></div>');              $request->print('<div style="padding:0;clear:both;margin:0;border:0"></div>');
             &submit_download_link($request,$symb);              &submit_download_link($request,$symb);
           } elsif ($command eq 'initialpassback') {
               &startpage($request,$symb,[{href=>'', text=>'Choose Launcher'}],undef,1);
               $request->print(&initialpassback($request,$symb));
           } elsif ($command eq 'passback') {
               &startpage($request,$symb,
                          [{href=>&href_symb_cmd($symb,'initialpassback'), text=>'Choose Launcher'},
                           {href=>'', text=>'Types of User'}],undef,1);
               $request->print(&passback_filters($request,$symb));
           } elsif ($command eq 'passbacknames') {
               my $chosen;
               if ($env{'form.passback'} ne '') {
                   if ($env{'form.passback'} eq &unescape($env{'form.passback'})) {
                       $env{'form.passback'} = &escape($env{'form.passback'} );
                   }
                   $chosen = &HTML::Entities::encode($env{'form.passback'},'<>"&');
               }
               &startpage($request,$symb,
                          [{href=>&href_symb_cmd($symb,'initialpassback'), text=>'Choose Launcher'},
                           {href=>&href_symb_cmd($symb,'passback').'&amp;passback='.$chosen, text=>'Types of User'},
                           {href=>'', text=>'Select Users'}],undef,1);
               $request->print(&names_for_passback($request,$symb));
           } elsif ($command eq 'passbackscores') {
               my ($chosen,$stu_status);
               if ($env{'form.passback'} ne '') {
                   if ($env{'form.passback'} eq &unescape($env{'form.passback'})) {
                       $env{'form.passback'} = &escape($env{'form.passback'} );
                   }
                   $chosen = &HTML::Entities::encode($env{'form.passback'},'<>"&');
               }
               if ($env{'form.Status'}) {
                   $stu_status = &HTML::Entities::encode($env{'form.Status'});
               }
               &startpage($request,$symb,
                          [{href=>&href_symb_cmd($symb,'initialpassback'), text=>'Choose Launcher'},
                           {href=>&href_symb_cmd($symb,'passback').'&amp;passback='.$chosen, text=>'Types of User'},
                           {href=>&href_symb_cmd($symb,'passbacknames').'&amp;Status='.$stu_status.'&amp;passback='.$chosen, text=>'Select Users'},
                           {href=>'', text=>'Execute Passback'}],undef,1);
               $request->print(&do_passback($request,$symb));
  } elsif ($command) {   } elsif ($command) {
             &startpage($request,$symb,[{href=>'', text=>'Access denied'}]);              &startpage($request,$symb,[{href=>'', text=>'Access denied'}]);
     $request->print('<p class="LC_error">'.&mt('Access Denied ([_1])',$command).'</p>');      $request->print('<p class="LC_error">'.&mt('Access Denied ([_1])',$command).'</p>');
Line 11831  Side Effects: None. Line 13320  Side Effects: None.
          - missingbubble - array ref of the bubble lines that have missing           - missingbubble - array ref of the bubble lines that have missing
                            bubble errors                             bubble errors
   
    $randomorder - True if exam folder has randomorder set     $randomorder - True if exam folder (or a sub-folder) has randomorder set
    $randompick  - True if exam folder has randompick set     $randompick  - True if exam folder (or a sub-folder) has randompick set
    $respnumlookup - Reference to HASH mapping question numbers in bubble lines     $respnumlookup - Reference to HASH mapping question numbers in bubble lines
                      for current line to question number used for same question                       for current line to question number used for same question
                      in "Master Seqence" (as seen by Course Coordinator).                       in "Master Seqence" (as seen by Course Coordinator).

Removed from v.1.784  
changed lines
  Added in v.1.811


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