--- loncom/homework/grades.pm 2017/05/19 20:08:33 1.596.2.12.2.40 +++ loncom/homework/grades.pm 2019/07/07 15:31:52 1.596.2.12.2.48 @@ -1,7 +1,7 @@ # The LearningOnline Network with CAPA # The LON-CAPA Grading handler # -# $Id: grades.pm,v 1.596.2.12.2.40 2017/05/19 20:08:33 raeburn Exp $ +# $Id: grades.pm,v 1.596.2.12.2.48 2019/07/07 15:31:52 raeburn Exp $ # # Copyright Michigan State University Board of Trustees # @@ -44,6 +44,9 @@ use Apache::Constants qw(:common :http); use Apache::lonlocal; use Apache::lonenc; use Apache::bridgetask(); +use Apache::lontexconvert(); +use HTML::Parser(); +use File::MMagic; use String::Similarity; use LONCAPA; @@ -354,7 +357,7 @@ sub reset_caches { } 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); if (ref($resource)) { my $symb = $resource->symb(); @@ -362,6 +365,13 @@ sub reset_caches { if ($check_for_randomlist) { $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 = &get_analyze($symb,$uname,$udom,undef,$add_to_form, undef,undef,undef,$bubbles_per_row); @@ -465,6 +475,7 @@ sub cleanRecord { $env{'form.kwstyle'} = $keyhash{$loginuser.'_kwstyle'} ne '' ? $keyhash{$loginuser.'_kwstyle'} : ''; $env{'form.'.$symb} = 1; # so that we don't have to read it from disk for multiple sub of the same prob. } + $answer = &Apache::lontexconvert::msgtexconverted($answer); return '

'.&keywords_highlight($answer).'
'; } elsif ( $response eq 'organic') { my $result=&mt('Smile representation: [_1]', @@ -2044,6 +2055,7 @@ sub submission { $env{'form.fullname'} = &Apache::loncommon::plainname($uname,$udom,'lastname') if $env{'form.fullname'} eq ''; my ($symb) = &get_symb($request); if ($symb eq '') { $request->print("Unable to handle ambiguous references:."); return ''; } + my ($essayurl,%coursedesc_by_cid); if (!&canview($usec)) { $request->print( @@ -2181,11 +2193,24 @@ sub submission { # # Load the other essays for similarity check # - my (undef,undef,$essayurl) = &Apache::lonnet::decode_symb($symb); - 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); + (undef,undef,$essayurl) = &Apache::lonnet::decode_symb($symb); + if ($essayurl eq 'lib/templates/simpleproblem.problem') { + my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'}; + my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'}; + 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); + } } } @@ -2326,27 +2351,52 @@ sub submission { &most_similar($uname,$udom,$symb,$subval); if ($osim) { $osim=int($osim*100.0); - my %old_course_desc = - &Apache::lonnet::coursedescription($ocrsid, - {'one_time' => 1}); - if ($hide eq 'anon') { $similar='
'.&mt("Essay was found to be similar to another essay submitted for this assignment.").'
'. &mt('As the current submission is for an anonymous survey, no other details are available.').'
'; } else { - $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'}). - '

'. - &keywords_highlight($oessay). - '
'; - } - } - } + $similar='
'; + if ($essayurl eq 'lib/templates/simpleproblem.problem') { + $similar .= '

'. + &mt('Essay is [_1]% similar to an essay by [_2]', + $osim, + &Apache::loncommon::plainname($oname,$odom).' ('.$oname.':'.$odom.')'). + '

'; + } elsif ($ocrsid ne '') { + my %old_course_desc; + 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'}). + ''; + } else { + $similar .= + '

'. + &mt('Essay is [_1]% similar to an essay by [_2] in an unknown course', + $osim, + &Apache::loncommon::plainname($oname,$odom).' ('.$oname.':'.$odom.')'). + '

'; + } + $similar .= '
'. + &keywords_highlight($oessay). + '
'; + } + } + } 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)$/ || ($env{'form.lastSub'} eq 'hdgrade' && @@ -4170,6 +4220,7 @@ sub editgrades { $ctr++; } my (undef,undef,$url) = &Apache::lonnet::decode_symb($symb); + my $totcolspan = 0; foreach my $partid (@partid) { $header .= ''.&mt('Old Score').''. ''.&mt('New Score').''; @@ -4186,6 +4237,7 @@ sub editgrades { ''.&mt('New').' '.$display.''; $columns{$partid}+=2; } + $totcolspan += $columns{$partid}; } foreach my $partid (@partid) { my $display_part=&get_display_part($partid,$symb); @@ -4201,20 +4253,20 @@ sub editgrades { my @noupdate; my ($updateCtr,$noupdateCtr) = (1,1); for ($i=0; $i<$env{'form.total'}; $i++) { - my $line; my $user = $env{'form.ctr'.$i}; my ($uname,$udom)=split(/:/,$user); my %newrecord; my $updateflag = 0; - $line .= ''.&nameUserString(undef,$$fullname{$user},$uname,$udom).''; - my $usec=$classlist->{"$uname:$udom"}[5]; - if (!&canmodify($usec)) { - my $numcols=scalar(@partid)*4+2; - push(@noupdate, - $line."". - &mt('Not allowed to modify student').""); - next; - } + my $usec=$classlist->{"$uname:$udom"}[5]; + my $canmodify = &canmodify($usec); + my $line = ''. + &nameUserString(undef,$$fullname{$user},$uname,$udom).''; + if (!$canmodify) { + push(@noupdate, + $line."". + &mt('Not allowed to modify student').""); + next; + } my %aggregate = (); my $aggregateflag = 0; $user=~s/:/_/; # colon doen't work in javascript for names @@ -4329,8 +4381,7 @@ sub editgrades { } } if (@noupdate) { -# my $numcols=(scalar(@partid)*(scalar(@parts)-1)*2)+3; - my $numcols=scalar(@partid)*4+2; + my $numcols=$totcolspan+2; $result .= &Apache::loncommon::start_data_table_row('LC_empty_row'). ''. &mt('No Changes Occurred For the Students Below'). @@ -4598,8 +4649,10 @@ sub csvuploadmap { if (!$env{'form.datatoken'}) { $datatoken=&Apache::loncommon::upfile_store($request); } else { - $datatoken=$env{'form.datatoken'}; - &Apache::loncommon::load_tmp_file($request); + $datatoken=&Apache::loncommon::valid_datatoken($env{'form.datatoken'}); + if ($datatoken ne '') { + &Apache::loncommon::load_tmp_file($request,$datatoken); + } } my @records=&Apache::loncommon::upfile_record_sep(); if ($env{'form.noFirstLine'}) { shift(@records); } @@ -4703,7 +4756,10 @@ sub csvuploadassign { my ($symb)=&get_symb($request); if (!$symb) {return '';} 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(); if ($env{'form.noFirstLine'}) { shift(@gradedata); } my %fields=&get_fields(); @@ -4856,6 +4912,7 @@ LISTJAVASCRIPT my $cdom = $env{"course.$env{'request.course.id'}.domain"}; my $cnum = $env{"course.$env{'request.course.id'}.num"}; my $getsec = $env{'form.section'} eq '' ? 'all' : $env{'form.section'}; + my $getgroup = $env{'form.group'} eq '' ? 'all' : $env{'form.group'}; my $result='

 '. &mt('Manual Grading by Page or Sequence').'

'; @@ -4926,7 +4983,7 @@ LISTJAVASCRIPT ''.&nameUserString('header').''. &Apache::loncommon::end_data_table_header_row(); - my (undef,undef,$fullname) = &getclasslist($getsec,'1'); + my (undef,undef,$fullname) = &getclasslist($getsec,'1',$getgroup); my $ptr = 1; foreach my $student (sort { @@ -8783,9 +8840,14 @@ SCANTRONFORM } if ((exists($grader_randomlists_by_symb{$ressymb})) || (ref($grader_partids_by_symb{$ressymb}) ne 'ARRAY')) { + my $currcode; + if (exists($grader_randomlists_by_symb{$ressymb})) { + $currcode = $scancode; + } my ($analysis,$parts) = &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; } else { $partids_by_symb{$ressymb} = $grader_partids_by_symb{$ressymb}; @@ -9455,10 +9517,14 @@ sub checkscantron_results { my $ressymb = $resource->symb(); if ((exists($grader_randomlists_by_symb{$ressymb})) || (ref($grader_partids_by_symb{$ressymb}) ne 'ARRAY')) { + my $currcode; + if (exists($grader_randomlists_by_symb{$ressymb})) { + $currcode = $scancode; + } (my $analysis,$parts) = &scantron_partids_tograde($resource,$env{'request.course.id'}, $username,$domain,undef, - $bubbles_per_row); + $bubbles_per_row,$currcode); } else { $parts = $grader_partids_by_symb{$ressymb}; } @@ -10284,7 +10350,7 @@ sub process_clicker_file { $result .= &Apache::lonhtmlcommon::confirm_success( &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) { @@ -10294,6 +10360,22 @@ sub process_clicker_file { ''.&HTML::Entities::encode($env{'form.upfile.filename'},'<>&"').''),1); 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.= '

'. + &Apache::lonhtmlcommon::confirm_success( + &mt('File format is neither csv (iclicker 6) nor xml (iclicker 7)'),1).'

'; + return $result.&show_grading_menu_form($symb); + } + } elsif (($env{'form.upfiletype'} ne 'interwrite') && ($env{'form.upfiletype'} ne 'turning')) { + $result .= '

'. + &Apache::lonhtmlcommon::confirm_success( + &mt('Invalid clicker type: choose one of: i>clicker, Interwrite PRS, or Turning Technologies.'),1).'

'; + return $result.&show_grading_menu_form($symb); + } # Were able to get all the info needed, now analyze the file @@ -10321,12 +10403,14 @@ ENDHEADER my $errormsg=''; my $number=0; if ($env{'form.upfiletype'} eq 'iclicker') { - ($errormsg,$number)=&iclicker_eval(\@questiontitles,\%responses); - } - if ($env{'form.upfiletype'} eq 'interwrite') { + if ($mimetype eq 'text/plain') { + ($errormsg,$number)=&iclicker_eval(\@questiontitles,\%responses); + } elsif ($mimetype eq 'text/html') { + ($errormsg,$number)=&iclickerxml_eval(\@questiontitles,\%responses); + } + } elsif ($env{'form.upfiletype'} eq 'interwrite') { ($errormsg,$number)=&interwrite_eval(\@questiontitles,\%responses); - } - if ($env{'form.upfiletype'} eq 'turning') { + } elsif ($env{'form.upfiletype'} eq 'turning') { ($errormsg,$number)=&turning_eval(\@questiontitles,\%responses); } $result.='
'.&mt('Found [_1] question(s)',$number).'
'. @@ -10428,6 +10512,49 @@ sub iclicker_eval { } 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 { my ($questiontitles,$responses)=@_;