[BACK]Return to grades.pm CVS log [TXT] [DIR] Up to [LON-CAPA] / loncom / homework

Diff for /loncom/homework/grades.pm between versions 1.596.2.12.2.40.2.1 and 1.596.2.12.2.47

version 1.596.2.12.2.40.2.1, 2018/10/09 15:45:43 version 1.596.2.12.2.47, 2019/02/23 15:50:44
Line 45  use Apache::lonlocal; Line 45  use Apache::lonlocal;
 use Apache::lonenc;  use Apache::lonenc;
 use Apache::bridgetask();  use Apache::bridgetask();
 use Apache::lontexconvert();  use Apache::lontexconvert();
   use HTML::Parser();
   use File::MMagic;
 use String::Similarity;  use String::Similarity;
 use LONCAPA;  use LONCAPA;
   
Line 355  sub reset_caches { Line 357  sub reset_caches {
     }      }
   
     sub scantron_partids_tograde {      sub scantron_partids_tograde {
         my ($resource,$cid,$uname,$udom,$check_for_randomlist,$bubbles_per_row) = @_;          my ($resource,$cid,$uname,$udom,$check_for_randomlist,$bubbles_per_row,$scancode) = @_;
         my (%analysis,@parts);          my (%analysis,@parts);
         if (ref($resource)) {          if (ref($resource)) {
             my $symb = $resource->symb();              my $symb = $resource->symb();
Line 363  sub reset_caches { Line 365  sub reset_caches {
             if ($check_for_randomlist) {              if ($check_for_randomlist) {
                 $add_to_form = { 'check_parts_withrandomlist' => 1,};                  $add_to_form = { 'check_parts_withrandomlist' => 1,};
             }              }
               if ($scancode) {
                   if (ref($add_to_form) eq 'HASH') {
                       $add_to_form->{'code_for_randomlist'} = $scancode;
                   } else {
                       $add_to_form = { 'code_for_randomlist' => $scancode,};
                   }
               }
             my $analyze =              my $analyze =
                 &get_analyze($symb,$uname,$udom,undef,$add_to_form,                  &get_analyze($symb,$uname,$udom,undef,$add_to_form,
                              undef,undef,undef,$bubbles_per_row);                               undef,undef,undef,$bubbles_per_row);
Line 2046  sub submission { Line 2055  sub submission {
     $env{'form.fullname'} = &Apache::loncommon::plainname($uname,$udom,'lastname') if $env{'form.fullname'} eq '';      $env{'form.fullname'} = &Apache::loncommon::plainname($uname,$udom,'lastname') if $env{'form.fullname'} eq '';
     my ($symb) = &get_symb($request);       my ($symb) = &get_symb($request); 
     if ($symb eq '') { $request->print("Unable to handle ambiguous references:."); return ''; }      if ($symb eq '') { $request->print("Unable to handle ambiguous references:."); return ''; }
       my ($essayurl,%coursedesc_by_cid);
   
     if (!&canview($usec)) {      if (!&canview($usec)) {
         $request->print(          $request->print(
Line 2183  sub submission { Line 2193  sub submission {
 #  #
 # Load the other essays for similarity check  # Load the other essays for similarity check
 #  #
             my (undef,undef,$essayurl) = &Apache::lonnet::decode_symb($symb);              (undef,undef,$essayurl) = &Apache::lonnet::decode_symb($symb);
     my ($adom,$aname,$apath)=($essayurl=~/^($LONCAPA::domain_re)\/($LONCAPA::username_re)\/(.*)$/);              if ($essayurl eq 'lib/templates/simpleproblem.problem') {
     $apath=&escape($apath);                  my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
     $apath=~s/\W/\_/gs;                  my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
             &init_old_essays($symb,$apath,$adom,$aname);                  if ($cdom ne '' && $cnum ne '') {
                       my ($map,$id,$res) = &Apache::lonnet::decode_symb($symb);
                       if ($map =~ m{^\Quploaded/$cdom/$cnum/\E(default(?:|_\d+)\.(?:sequence|page))$}) {
                           my $apath = $1.'_'.$id;
                           $apath=~s/\W/\_/gs;
                           &init_old_essays($symb,$apath,$cdom,$cnum);
                       }
                   }
               } else {
           my ($adom,$aname,$apath)=($essayurl=~/^($LONCAPA::domain_re)\/($LONCAPA::username_re)\/(.*)$/);
           $apath=&escape($apath);
           $apath=~s/\W/\_/gs;
                   &init_old_essays($symb,$apath,$adom,$aname);
               }
         }          }
     }      }
   
Line 2328  sub submission { Line 2351  sub submission {
     &most_similar($uname,$udom,$symb,$subval);      &most_similar($uname,$udom,$symb,$subval);
  if ($osim) {   if ($osim) {
     $osim=int($osim*100.0);      $osim=int($osim*100.0);
     my %old_course_desc =   
  &Apache::lonnet::coursedescription($ocrsid,  
    {'one_time' => 1});  
   
                             if ($hide eq 'anon') {                              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 />'.                                  $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 />';                                           &mt('As the current submission is for an anonymous survey, no other details are available.').'</span><hr />';
                             } else {                              } else {
         $similar="<hr /><h3><span class=\"LC_warning\">".          $similar='<hr />';
     &mt('Essay is [_1]% similar to an essay by [_2] in course [_3] (course id [_4]:[_5])',                                  if ($essayurl eq 'lib/templates/simpleproblem.problem') {
         $osim,                                      $similar .= '<h3><span class="LC_warning">'.
         &Apache::loncommon::plainname($oname,$odom).' ('.$oname.':'.$odom.')',                                                  &mt('Essay is [_1]% similar to an essay by [_2]',
         $old_course_desc{'description'},                                                      $osim,
         $old_course_desc{'num'},                                                      &Apache::loncommon::plainname($oname,$odom).' ('.$oname.':'.$odom.')').
         $old_course_desc{'domain'}).                                                  '</span></h3>';
     '</span></h3><blockquote><i>'.                                  } elsif ($ocrsid ne '') {
     &keywords_highlight($oessay).                                      my %old_course_desc;
     '</i></blockquote><hr />';                                      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 .=
           &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,      my $order=&get_order($partid,$respid,$symb,$uname,$udom,
                                          undef,$type,$trial,$rndseed);                                           undef,$type,$trial,$rndseed);
                     if ($env{'form.lastSub'} eq 'lastonly' || $env{'form.lastSub'} eq 'datesub' || $env{'form.lastSub'} =~ /^(last|all)$/ || ($env{'form.lastSub'} eq 'hdgrade' &&                      if ($env{'form.lastSub'} eq 'lastonly' || $env{'form.lastSub'} eq 'datesub' || $env{'form.lastSub'} =~ /^(last|all)$/ || ($env{'form.lastSub'} eq 'hdgrade' &&
Line 4172  sub editgrades { Line 4220  sub editgrades {
  $ctr++;   $ctr++;
     }      }
     my (undef,undef,$url) = &Apache::lonnet::decode_symb($symb);      my (undef,undef,$url) = &Apache::lonnet::decode_symb($symb);
       my $totcolspan = 0;
     foreach my $partid (@partid) {      foreach my $partid (@partid) {
  $header .= '<th align="center">'.&mt('Old Score').'</th>'.   $header .= '<th align="center">'.&mt('Old Score').'</th>'.
     '<th align="center">'.&mt('New Score').'</th>';      '<th align="center">'.&mt('New Score').'</th>';
Line 4188  sub editgrades { Line 4237  sub editgrades {
  '<th align="center">'.&mt('New').' '.$display.'</th>';   '<th align="center">'.&mt('New').' '.$display.'</th>';
     $columns{$partid}+=2;      $columns{$partid}+=2;
  }   }
           $totcolspan += $columns{$partid};
     }      }
     foreach my $partid (@partid) {      foreach my $partid (@partid) {
  my $display_part=&get_display_part($partid,$symb);   my $display_part=&get_display_part($partid,$symb);
Line 4203  sub editgrades { Line 4253  sub editgrades {
     my @noupdate;      my @noupdate;
     my ($updateCtr,$noupdateCtr) = (1,1);      my ($updateCtr,$noupdateCtr) = (1,1);
     for ($i=0; $i<$env{'form.total'}; $i++) {      for ($i=0; $i<$env{'form.total'}; $i++) {
  my $line;  
  my $user = $env{'form.ctr'.$i};   my $user = $env{'form.ctr'.$i};
  my ($uname,$udom)=split(/:/,$user);   my ($uname,$udom)=split(/:/,$user);
  my %newrecord;   my %newrecord;
  my $updateflag = 0;   my $updateflag = 0;
  $line .= '<td>'.&nameUserString(undef,$$fullname{$user},$uname,$udom).'</td>';          my $usec=$classlist->{"$uname:$udom"}[5];
  my $usec=$classlist->{"$uname:$udom"}[5];          my $canmodify = &canmodify($usec);
  if (!&canmodify($usec)) {          my $line = '<td'.($canmodify?'':' colspan="2"').'>'.
     my $numcols=scalar(@partid)*4+2;                     &nameUserString(undef,$$fullname{$user},$uname,$udom).'</td>';
     push(@noupdate,          if (!$canmodify) {
  $line."<td colspan=\"$numcols\"><span class=\"LC_warning\">".              push(@noupdate,
  &mt('Not allowed to modify student')."</span></td></tr>");                   $line."<td colspan=\"$totcolspan\"><span class=\"LC_warning\">".
     next;                   &mt('Not allowed to modify student')."</span></td>");
  }              next;
           }
         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
Line 4331  sub editgrades { Line 4381  sub editgrades {
         }          }
     }      }
     if (@noupdate) {      if (@noupdate) {
 # my $numcols=(scalar(@partid)*(scalar(@parts)-1)*2)+3;          my $numcols=$totcolspan+2;
  my $numcols=scalar(@partid)*4+2;  
  $result .= &Apache::loncommon::start_data_table_row('LC_empty_row').   $result .= &Apache::loncommon::start_data_table_row('LC_empty_row').
     '<td align="center" colspan="'.$numcols.'">'.      '<td align="center" colspan="'.$numcols.'">'.
     &mt('No Changes Occurred For the Students Below').      &mt('No Changes Occurred For the Students Below').
Line 4600  sub csvuploadmap { Line 4649  sub csvuploadmap {
     if (!$env{'form.datatoken'}) {      if (!$env{'form.datatoken'}) {
  $datatoken=&Apache::loncommon::upfile_store($request);   $datatoken=&Apache::loncommon::upfile_store($request);
     } else {      } else {
  $datatoken=$env{'form.datatoken'};          $datatoken=&Apache::loncommon::valid_datatoken($env{'form.datatoken'});
  &Apache::loncommon::load_tmp_file($request);          if ($datatoken ne '') { 
       &Apache::loncommon::load_tmp_file($request,$datatoken);
           }
     }      }
     my @records=&Apache::loncommon::upfile_record_sep();      my @records=&Apache::loncommon::upfile_record_sep();
     if ($env{'form.noFirstLine'}) { shift(@records); }      if ($env{'form.noFirstLine'}) { shift(@records); }
Line 4705  sub csvuploadassign { Line 4756  sub csvuploadassign {
     my ($symb)=&get_symb($request);      my ($symb)=&get_symb($request);
     if (!$symb) {return '';}      if (!$symb) {return '';}
     my $error_msg = '';      my $error_msg = '';
     &Apache::loncommon::load_tmp_file($request);      my $datatoken = &Apache::loncommon::valid_datatoken($env{'form.datatoken'});
       if ($datatoken ne '') {
           &Apache::loncommon::load_tmp_file($request,$datatoken);
       }
     my @gradedata = &Apache::loncommon::upfile_record_sep();      my @gradedata = &Apache::loncommon::upfile_record_sep();
     if ($env{'form.noFirstLine'}) { shift(@gradedata); }      if ($env{'form.noFirstLine'}) { shift(@gradedata); }
     my %fields=&get_fields();      my %fields=&get_fields();
Line 8785  SCANTRONFORM Line 8839  SCANTRONFORM
             }              }
             if ((exists($grader_randomlists_by_symb{$ressymb})) ||              if ((exists($grader_randomlists_by_symb{$ressymb})) ||
                 (ref($grader_partids_by_symb{$ressymb}) ne 'ARRAY')) {                  (ref($grader_partids_by_symb{$ressymb}) ne 'ARRAY')) {
                   my $currcode;
                   if (exists($grader_randomlists_by_symb{$ressymb})) {
                       $currcode = $scancode;
                   }
                 my ($analysis,$parts) =                  my ($analysis,$parts) =
                     &scantron_partids_tograde($resource,$env{'request.course.id'},                      &scantron_partids_tograde($resource,$env{'request.course.id'},
                                               $uname,$udom,undef,$bubbles_per_row);                                                $uname,$udom,undef,$bubbles_per_row,
                                                 $currcode);
                 $partids_by_symb{$ressymb} = $parts;                  $partids_by_symb{$ressymb} = $parts;
             } else {              } else {
                 $partids_by_symb{$ressymb} = $grader_partids_by_symb{$ressymb};                  $partids_by_symb{$ressymb} = $grader_partids_by_symb{$ressymb};
Line 9457  sub checkscantron_results { Line 9516  sub checkscantron_results {
             my $ressymb = $resource->symb();              my $ressymb = $resource->symb();
             if ((exists($grader_randomlists_by_symb{$ressymb})) ||              if ((exists($grader_randomlists_by_symb{$ressymb})) ||
                 (ref($grader_partids_by_symb{$ressymb}) ne 'ARRAY')) {                  (ref($grader_partids_by_symb{$ressymb}) ne 'ARRAY')) {
                   my $currcode;
                   if (exists($grader_randomlists_by_symb{$ressymb})) {
                       $currcode = $scancode;
                   }
                 (my $analysis,$parts) =                  (my $analysis,$parts) =
                     &scantron_partids_tograde($resource,$env{'request.course.id'},                      &scantron_partids_tograde($resource,$env{'request.course.id'},
                                               $username,$domain,undef,                                                $username,$domain,undef,
                                               $bubbles_per_row);                                                $bubbles_per_row,$currcode);
             } else {              } else {
                 $parts = $grader_partids_by_symb{$ressymb};                  $parts = $grader_partids_by_symb{$ressymb};
             }              }
Line 10286  sub process_clicker_file { Line 10349  sub process_clicker_file {
             $result .=              $result .=
                  &Apache::lonhtmlcommon::confirm_success(                   &Apache::lonhtmlcommon::confirm_success(
                      &mt('No IDs found to determine correct answer'),1);                       &mt('No IDs found to determine correct answer'),1);
             return $result,.&show_grading_menu_form($symb);              return $result.&show_grading_menu_form($symb);
         }          }
     }      }
     if (length($env{'form.upfile'}) < 2) {      if (length($env{'form.upfile'}) < 2) {
Line 10296  sub process_clicker_file { Line 10359  sub process_clicker_file {
                         '<span class="LC_filename">'.&HTML::Entities::encode($env{'form.upfile.filename'},'<>&"').'</span>'),1);                          '<span class="LC_filename">'.&HTML::Entities::encode($env{'form.upfile.filename'},'<>&"').'</span>'),1);
         return $result.&show_grading_menu_form($symb);          return $result.&show_grading_menu_form($symb);
     }      }
       my $mimetype;
       if ($env{'form.upfiletype'} eq 'iclicker') {
           my $mm = new File::MMagic;
           $mimetype = $mm->checktype_contents($env{'form.upfile'});
           unless (($mimetype eq 'text/plain') || ($mimetype eq 'text/html')) {
               $result.= '<p>'.
                   &Apache::lonhtmlcommon::confirm_success(
                       &mt('File format is neither csv (iclicker 6) nor xml (iclicker 7)'),1).'</p>';
               return $result.&show_grading_menu_form($symb);
           }
       } elsif (($env{'form.upfiletype'} ne 'interwrite') && ($env{'form.upfiletype'} ne 'turning')) {
           $result .= '<p>'.
               &Apache::lonhtmlcommon::confirm_success(
                   &mt('Invalid clicker type: choose one of: i>clicker, Interwrite PRS, or Turning Technologies.'),1).'</p>';
           return $result.&show_grading_menu_form($symb);
       }
   
 # Were able to get all the info needed, now analyze the file  # Were able to get all the info needed, now analyze the file
   
Line 10323  ENDHEADER Line 10402  ENDHEADER
     my $errormsg='';      my $errormsg='';
     my $number=0;      my $number=0;
     if ($env{'form.upfiletype'} eq 'iclicker') {      if ($env{'form.upfiletype'} eq 'iclicker') {
  ($errormsg,$number)=&iclicker_eval(\@questiontitles,\%responses);          if ($mimetype eq 'text/plain') {
     }              ($errormsg,$number)=&iclicker_eval(\@questiontitles,\%responses);
     if ($env{'form.upfiletype'} eq 'interwrite') {          } elsif ($mimetype eq 'text/html') {
               ($errormsg,$number)=&iclickerxml_eval(\@questiontitles,\%responses);
           }
       } elsif ($env{'form.upfiletype'} eq 'interwrite') {
         ($errormsg,$number)=&interwrite_eval(\@questiontitles,\%responses);          ($errormsg,$number)=&interwrite_eval(\@questiontitles,\%responses);
     }      } elsif ($env{'form.upfiletype'} eq 'turning') {
     if ($env{'form.upfiletype'} eq 'turning') {  
         ($errormsg,$number)=&turning_eval(\@questiontitles,\%responses);          ($errormsg,$number)=&turning_eval(\@questiontitles,\%responses);
     }      }
     $result.='<br />'.&mt('Found [_1] question(s)',$number).'<br />'.      $result.='<br />'.&mt('Found [_1] question(s)',$number).'<br />'.
Line 10430  sub iclicker_eval { Line 10511  sub iclicker_eval {
     }      }
     return ($errormsg,$number);      return ($errormsg,$number);
 }  }
   
   sub iclickerxml_eval {
       my ($questiontitles,$responses)=@_;
       my $number=0;
       my $errormsg='';
       my @state;
       my %respbyid;
       my $p = HTML::Parser->new
       (
           xml_mode => 1,
           start_h =>
               [sub {
                    my ($tagname,$attr) = @_;
                    push(@state,$tagname);
                    if ("@state" eq "ssn p") {
                        my $title = $attr->{qn};
                        $title =~ s/(^\s+|\s+$)//g;
                        $questiontitles->[$number]=$title;
                    } elsif ("@state" eq "ssn p v") {
                        my $id = $attr->{id};
                        my $entry = $attr->{ans};
                        $id=~s/^[\#0]+//;
                        $entry =~s/[^a-zA-Z0-9\.\*\-\+]+//g;
                        $respbyid{$id}[$number] = $entry;
                    }
               }, "tagname, attr"],
            end_h =>
                  [sub {
                      my ($tagname) = @_;
                      if ("@state" eq "ssn p") {
                          $number++;
                      }
                      pop(@state);
                   }, "tagname"],
       );
   
       $p->parse($env{'form.upfile'});
       $p->eof;
       foreach my $id (keys(%respbyid)) {
           $responses->{$id}=join(',',@{$respbyid{$id}});
       }
       return ($errormsg,$number);
   }
   
 sub interwrite_eval {  sub interwrite_eval {
     my ($questiontitles,$responses)=@_;      my ($questiontitles,$responses)=@_;
Removed from v.1.596.2.12.2.40.2.1  
changed lines
  Added in v.1.596.2.12.2.47

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