--- loncom/homework/grades.pm 2016/08/04 18:47:52 1.596.2.12.2.36 +++ 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.36 2016/08/04 18:47:52 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]', @@ -1255,7 +1266,7 @@ sub processGroup { sub sub_page_js { my $request = shift; my $alertmsg = &mt('A number equal or greater than 0 is expected. Entered value = '); - &js_escape(\$alertmsg); + &js_escape(\$alertmsg); $request->print(< function updateRadio(formname,id,weight) { @@ -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' && @@ -3754,19 +3804,67 @@ sub viewgrades { ''."\n". ''."\n"; - my ($common_header,$specific_header); - if ($env{'form.section'} eq 'all') { - $common_header = &mt('Assign Common Grade to Class'); - $specific_header = &mt('Assign Grade to Specific Students in Class'); - } elsif ($env{'form.section'} eq 'none') { - $common_header = &mt('Assign Common Grade to Students in no Section'); - $specific_header = &mt('Assign Grade to Specific Students in no Section'); - } else { - my $section_display = join (", ",&Apache::loncommon::get_env_multiple('form.section')); - $common_header = &mt('Assign Common Grade to Students in Section(s) [_1]',$section_display); - $specific_header = &mt('Assign Grade to Specific Students in Section(s) [_1]',$section_display); + #retrieve selected groups + my (@groups,$group_display); + @groups = &Apache::loncommon::get_env_multiple('form.group'); + if (grep(/^all$/,@groups)) { + @groups = ('all'); + } elsif (grep(/^none$/,@groups)) { + @groups = ('none'); + } elsif (@groups > 0) { + $group_display = join(', ',@groups); + } + + my ($common_header,$specific_header,@sections,$section_display); + @sections = &Apache::loncommon::get_env_multiple('form.section'); + if (grep(/^all$/,@sections)) { + @sections = ('all'); + if ($group_display) { + $common_header = &mt('Assign Common Grade to Students in Group(s) [_1]',$group_display); + $specific_header = &mt('Assign Grade to Specific Students in Group(s) [_1]',$group_display); + } elsif (grep(/^none$/,@groups)) { + $common_header = &mt('Assign Common Grade to Students not assigned to any groups'); + $specific_header = &mt('Assign Grade to Specific Students not assigned to any groups'); + } else { + $common_header = &mt('Assign Common Grade to Class'); + $specific_header = &mt('Assign Grade to Specific Students in Class'); + } + } elsif (grep(/^none$/,@sections)) { + @sections = ('none'); + if ($group_display) { + $common_header = &mt('Assign Common Grade to Students in no Section and in Group(s) [_1]',$group_display); + $specific_header = &mt('Assign Grade to Specific Students in no Section and in Group(s)',$group_display); + } elsif (grep(/^none$/,@groups)) { + $common_header = &mt('Assign Common Grade to Students in no Section and in no Group'); + $specific_header = &mt('Assign Grade to Specific Students in no Section and in no Group'); + } else { + $common_header = &mt('Assign Common Grade to Students in no Section'); + $specific_header = &mt('Assign Grade to Specific Students in no Section'); + } + } else { + $section_display = join (", ",@sections); + if ($group_display) { + $common_header = &mt('Assign Common Grade to Students in Section(s) [_1], and in Group(s) [_2]', + $section_display,$group_display); + $specific_header = &mt('Assign Grade to Specific Students in Section(s) [_1], and in Group(s) [_2]', + $section_display,$group_display); + } elsif (grep(/^none$/,@groups)) { + $common_header = &mt('Assign Common Grade to Students in Section(s) [_1] and no Group',$section_display); + $specific_header = &mt('Assign Grade to Specific Students in Section(s) [_1] and no Group',$section_display); + } else { + $common_header = &mt('Assign Common Grade to Students in Section(s) [_1]',$section_display); + $specific_header = &mt('Assign Grade to Specific Students in Section(s) [_1]',$section_display); + } + } + my %submit_types = &substatus_options(); + my $submission_status = $submit_types{$env{'form.submitonly'}}; + + if ($env{'form.submitonly'} eq 'all') { + $result.= '

'.$common_header.'

'; + } else { + $result.= '

'.$common_header.' '.&mt('(submission status: "[_1]")',$submission_status).'

'; } - $result.= '

'.$common_header.'

'.&Apache::loncommon::start_data_table(); + $result .= &Apache::loncommon::start_data_table(); #radio buttons/text box for assigning points for a section or class. #handles different parts of a problem my $res_error; @@ -3829,8 +3927,12 @@ sub viewgrades { #table listing all the students in a section/class #header of table - $result.= '

'.$specific_header.'

'. - &Apache::loncommon::start_data_table(). + if ($env{'form.submitonly'} eq 'all') { + $result.= '

'.$specific_header.'

'; + } else { + $result.= '

'.$specific_header.' '.&mt('(submission status: "[_1]")',$submission_status).'

'; + } + $result.= &Apache::loncommon::start_data_table(). &Apache::loncommon::start_data_table_header_row(). ''.&mt('No.').''. ''.&nameUserString('header')."\n"; @@ -3873,7 +3975,7 @@ sub viewgrades { #get info for each student #list all the students - with points and grade status - my (undef,undef,$fullname) = &getclasslist($env{'form.section'},'1'); + my (undef,undef,$fullname) = &getclasslist(\@sections,'1',\@groups); my $ctr = 0; foreach (sort { @@ -3882,36 +3984,143 @@ sub viewgrades { } return $a cmp $b; } (keys(%$fullname))) { - $ctr++; $result.=&viewstudentgrade($symb,$env{'request.course.id'}, - $_,$$fullname{$_},\@parts,\%weight,$ctr,\%last_resets); + $_,$$fullname{$_},\@parts,\%weight,\$ctr,\%last_resets); } $result.=&Apache::loncommon::end_data_table(); $result.=''."\n"; $result.=''."\n"; - if (scalar(%$fullname) eq 0) { - my $colspan=3+scalar(@parts); - my $section_display = join (", ",&Apache::loncommon::get_env_multiple('form.section')); + if ($ctr == 0) { my $stu_status = join(' or ',&Apache::loncommon::get_env_multiple('form.Status')); - $result=''. - &mt('There are no students in section(s) [_1] with enrollment status [_2] to modify or grade.', - $section_display, $stu_status). - ''; + $result='

'.&mt('Manual Grading').'

'. + ''; + if ($env{'form.submitonly'} eq 'all') { + if (grep(/^all$/,@sections)) { + if (grep(/^all$/,@groups)) { + $result .= &mt('There are no students with enrollment status [_1] to modify or grade.', + $stu_status); + } elsif (grep(/^none$/,@groups)) { + $result .= &mt('There are no students with no group assigned and with enrollment status [_1] to modify or grade.', + $stu_status); + } else { + $result .= &mt('There are no students in group(s) [_1] with enrollment status [_2] to modify or grade.', + $group_display,$stu_status); + } + } elsif (grep(/^none$/,@sections)) { + if (grep(/^all$/,@groups)) { + $result .= &mt('There are no students in no section with enrollment status [_1] to modify or grade.', + $stu_status); + } elsif (grep(/^none$/,@groups)) { + $result .= &mt('There are no students in no section and no group with enrollment status [_1] to modify or grade.', + $stu_status); + } else { + $result .= &mt('There are no students in no section in group(s) [_1] with enrollment status [_2] to modify or grade.', + $group_display,$stu_status); + } + } else { + if (grep(/^all$/,@groups)) { + $result .= &mt('There are no students in section(s) [_1] with enrollment status [_2] to modify or grade.', + $section_display,$stu_status); + } elsif (grep(/^none$/,@groups)) { + $result .= &mt('There are no students in section(s) [_1] and no group with enrollment status [_2] to modify or grade.', + $section_display,$stu_status); + } else { + $result .= &mt('There are no students in section(s) [_1] and group(s) [_2] with enrollment status [_3] to modify or grade.', + $section_display,$group_display,$stu_status); + } + } + } else { + if (grep(/^all$/,@sections)) { + if (grep(/^all$/,@groups)) { + $result .= &mt('There are no students with enrollment status [_1] and submission status "[_2]" to modify or grade.', + $stu_status,$submission_status); + } elsif (grep(/^none$/,@groups)) { + $result .= &mt('There are no students with no group assigned with enrollment status [_1] and submission status "[_2]" to modify or grade.', + $stu_status,$submission_status); + } else { + $result .= &mt('There are no students in group(s) [_1] with enrollment status [_2] and submission status "[_3]" to modify or grade.', + $group_display,$stu_status,$submission_status); + } + } elsif (grep(/^none$/,@sections)) { + if (grep(/^all$/,@groups)) { + $result .= &mt('There are no students in no section with enrollment status [_1] and submission status "[_2]" to modify or grade.', + $stu_status,$submission_status); + } elsif (grep(/^none$/,@groups)) { + $result .= &mt('There are no students in no section and no group with enrollment status [_1] and submission status "[_2]" to modify or grade.', + $stu_status,$submission_status); + } else { + $result .= &mt('There are no students in no section in group(s) [_1] with enrollment status [_2] and submission status "[_3]" to modify or grade.', + $group_display,$stu_status,$submission_status); + } + } else { + if (grep(/^all$/,@groups)) { + $result .= &mt('There are no students in section(s) [_1] with enrollment status [_2] and submission status "[_3]" to modify or grade.', + $section_display,$stu_status,$submission_status); + } elsif (grep(/^none$/,@groups)) { + $result .= &mt('There are no students in section(s) [_1] and no group with enrollment status [_2] and submission status "[_3]" to modify or grade.', + $section_display,$stu_status,$submission_status); + } else { + $result .= &mt('There are no students in section(s) [_1] and group(s) [_2] with enrollment status [_3] and submission status "[_4]" to modify or grade.', + $section_display,$group_display,$stu_status,$submission_status); + } + } + } + $result .= '
'; } $result.=&show_grading_menu_form($symb); return $result; } -#--- call by previous routine to display each student +#--- call by previous routine to display each student who satisfies submission filter. sub viewstudentgrade { my ($symb,$courseid,$student,$fullname,$parts,$weight,$ctr,$last_resets) = @_; my ($uname,$udom) = split(/:/,$student); my %record=&Apache::lonnet::restore($symb,$courseid,$udom,$uname); - my %aggregates = (); + my $submitonly = $env{'form.submitonly'}; + unless (($submitonly eq 'all') || ($submitonly eq 'queued')) { + my %partstatus = (); + if (ref($parts) eq 'ARRAY') { + foreach my $apart (@{$parts}) { + my ($part,$type) = &split_part_type($apart); + my ($status,undef) = split(/_/,$record{"resource.$part.solved"},2); + $status = 'nothing' if ($status eq ''); + $partstatus{$part} = $status; + my $subkey = "resource.$part.submitted_by"; + $partstatus{$subkey} = $record{$subkey} if ($record{$subkey} ne ''); + } + my $submitted = 0; + my $graded = 0; + my $incorrect = 0; + foreach my $key (keys(%partstatus)) { + $submitted = 1 if ($partstatus{$key} ne 'nothing'); + $graded = 1 if ($partstatus{$key} =~ /^ungraded/); + $incorrect = 1 if ($partstatus{$key} =~ /^incorrect/); + + my $partid = (split(/\./,$key))[1]; + if ($partstatus{'resource.'.$partid.'.'.$key.'.submitted_by'} ne '') { + $submitted = 0; + } + } + return if (!$submitted && ($submitonly eq 'yes' || + $submitonly eq 'incorrect' || + $submitonly eq 'graded')); + return if (!$graded && ($submitonly eq 'graded')); + return if (!$incorrect && $submitonly eq 'incorrect'); + } + } + if ($submitonly eq 'queued') { + my ($cdom,$cnum) = split(/_/,$courseid); + my %queue_status = + &Apache::bridgetask::get_student_status($symb,$cdom,$cnum, + $udom,$uname); + return if (!defined($queue_status{'gradingqueue'})); + } + $$ctr++; + my %aggregates = (); my $result=&Apache::loncommon::start_data_table_row().''. - ''. - "\n".$ctr.'  '. + ''. + "\n".$$ctr.'  '. ''.$fullname.' '. '('.$uname.($env{'user.domain'} eq $udom ? '' : ':'.$udom).')'."\n"; @@ -4011,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').''; @@ -4027,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); @@ -4042,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 @@ -4170,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'). @@ -4439,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); } @@ -4544,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(); @@ -4697,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').'

'; @@ -4767,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 { @@ -8624,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}; @@ -8897,7 +9118,7 @@ sub scantron_upload_scantron_data { my ($symb) = &get_symb($r,1); my $default_form_data=&defaultFormData($symb); my $nofile_alert = &mt('Please use the browse button to select a file from your local directory.'); - &js_escape(\$nofile_alert); + &js_escape(\$nofile_alert); my $nocourseid_alert = &mt("Please use the 'Select Course' link to open a separate window where you can search for a course to which a file can be uploaded."); &js_escape(\$nocourseid_alert); $r->print(' @@ -9296,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}; } @@ -9843,6 +10068,16 @@ GRADINGMENUJS return $result; } +sub substatus_options { + return &Apache::lonlocal::texthash( + 'yes' => 'with submissions', + 'queued' => 'in grading queue', + 'graded' => 'with ungraded submissions', + 'incorrect' => 'with incorrect submissions', + 'all' => 'with any status', + ); +} + sub reset_perm { undef(%perm); } @@ -10115,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) { @@ -10125,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 @@ -10152,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).'
'. @@ -10259,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)=@_;