--- loncom/homework/grades.pm 2017/11/01 03:27:19 1.596.2.12.2.41.2.1 +++ loncom/homework/grades.pm 2020/02/12 17:33:53 1.596.2.12.2.50 @@ -1,7 +1,7 @@ # The LearningOnline Network with CAPA # The LON-CAPA Grading handler # -# $Id: grades.pm,v 1.596.2.12.2.41.2.1 2017/11/01 03:27:19 raeburn Exp $ +# $Id: grades.pm,v 1.596.2.12.2.50 2020/02/12 17:33:53 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; @@ -472,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]', @@ -2051,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( @@ -2188,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); + } } } @@ -2333,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' && @@ -4177,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').''; @@ -4193,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); @@ -4208,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 @@ -4336,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'). @@ -4606,8 +4650,8 @@ sub csvuploadmap { $datatoken=&Apache::loncommon::upfile_store($request); } else { $datatoken=&Apache::loncommon::valid_datatoken($env{'form.datatoken'}); - if ($datatoken ne '') { - &Apache::loncommon::load_tmp_file($request,$datatoken); + if ($datatoken ne '') { + &Apache::loncommon::load_tmp_file($request,$datatoken); } } my @records=&Apache::loncommon::upfile_record_sep(); @@ -4868,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').'

'; @@ -4938,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 { @@ -5715,7 +5760,7 @@ sub scantron_uploads { sub scantron_scantab { my $result=' - '.&mt('File to upload: [_1]','').' -
- - -'); + '.&Apache::loncommon::start_data_table('LC_scantron_action').' + '.&Apache::loncommon::start_data_table_header_row().' + +  '.&mt('Specify a bubblesheet data file to upload.').' + + '.&Apache::loncommon::end_data_table_header_row().' + '.&Apache::loncommon::start_data_table_row().' + + '.&mt('File to upload: [_1]','').'
'."\n"); + if ($formatoptions) { + $r->print(' + '.&Apache::loncommon::end_data_table_row().' + '.&Apache::loncommon::start_data_table_row().' + '.$formattitle.(' 'x2).$formatoptions.' + + '.&Apache::loncommon::end_data_table_row().' + '.&Apache::loncommon::start_data_table_row().' + ' + ); + } else { + $r->print('
'); + } + $r->print(' + + '.&Apache::loncommon::end_data_table_row().' + '.&Apache::loncommon::end_data_table().' + ' + ); - $r->print(' - - '.&Apache::loncommon::end_data_table_row().' - '.&Apache::loncommon::end_data_table().' -'); } # Chunk of form to prompt for a file to grade and how: @@ -6022,98 +6018,6 @@ sub scantron_selectphase { return; } -=pod - -=item get_scantron_config - - Parse and return the scantron configuration line selected as a - hash of configuration file fields. - - Arguments: - which - the name of the configuration to parse from the file. - - - Returns: - If the named configuration is not in the file, an empty - hash is returned. - a hash with the fields - name - internal name for the this configuration setup - description - text to display to operator that describes this config - CODElocation - if 0 or the string 'none' - - no CODE exists for this config - if -1 || the string 'letter' - - a CODE exists for this config and is - a string of letters - Unsupported value (but planned for future support) - if a positive integer - - The CODE exists as the first n items from - the question section of the form - if the string 'number' - - The CODE exists for this config and is - a string of numbers - CODEstart - (only matter if a CODE exists) column in the line where - the CODE starts - CODElength - length of the CODE - IDstart - column where the student/employee ID starts - IDlength - length of the student/employee ID info - Qstart - column where the information from the bubbled - 'questions' start - Qlength - number of columns comprising a single bubble line from - the sheet. (usually either 1 or 10) - Qon - either a single character representing the character used - to signal a bubble was chosen in the positional setup, or - the string 'letter' if the letter of the chosen bubble is - in the final, or 'number' if a number representing the - chosen bubble is in the file (1->A 0->J) - Qoff - the character used to represent that a bubble was - left blank - PaperID - if the scanning process generates a unique number for each - sheet scanned the column that this ID number starts in - PaperIDlength - number of columns that comprise the unique ID number - for the sheet of paper - FirstName - column that the first name starts in - FirstNameLength - number of columns that the first name spans - - LastName - column that the last name starts in - LastNameLength - number of columns that the last name spans - BubblesPerRow - number of bubbles available in each row used to - bubble an answer. (If not specified, 10 assumed). - -=cut - -sub get_scantron_config { - my ($which) = @_; - my @lines = &get_scantronformat_file(); - my %config; - #FIXME probably should move to XML it has already gotten a bit much now - foreach my $line (@lines) { - my ($name,$descrip)=split(/:/,$line); - if ($name ne $which ) { next; } - chomp($line); - my @config=split(/:/,$line); - $config{'name'}=$config[0]; - $config{'description'}=$config[1]; - $config{'CODElocation'}=$config[2]; - $config{'CODEstart'}=$config[3]; - $config{'CODElength'}=$config[4]; - $config{'IDstart'}=$config[5]; - $config{'IDlength'}=$config[6]; - $config{'Qstart'}=$config[7]; - $config{'Qlength'}=$config[8]; - $config{'Qoff'}=$config[9]; - $config{'Qon'}=$config[10]; - $config{'PaperID'}=$config[11]; - $config{'PaperIDlength'}=$config[12]; - $config{'FirstName'}=$config[13]; - $config{'FirstNamelength'}=$config[14]; - $config{'LastName'}=$config[15]; - $config{'LastNamelength'}=$config[16]; - $config{'BubblesPerRow'}=$config[17]; - last; - } - return %config; -} - =pod =item username_to_idmap @@ -6159,7 +6063,7 @@ sub username_to_idmap { Process a requested correction to a scanline. Arguments: - $scantron_config - hash from &get_scantron_config() + $scantron_config - hash from &Apache::lonnet::get_scantron_config() $scan_data - hash of correction information (see &scantron_getfile()) $line - existing scanline @@ -6842,7 +6746,7 @@ sub scantron_filter { sub scantron_process_corrections { my ($r) = @_; - my %scantron_config=&get_scantron_config($env{'form.scantron_format'}); + my %scantron_config=&Apache::lonnet::get_scantron_config($env{'form.scantron_format'}); my ($scanlines,$scan_data)=&scantron_getfile(); my $classlist=&Apache::loncoursedata::get_classlist(); my $which=$env{'form.scantron_line'}; @@ -7011,7 +6915,7 @@ sub check_for_error { sub scantron_warning_screen { my ($button_text)=@_; my $title=&Apache::lonnet::gettitle($env{'form.selectpage'}); - my %scantron_config=&get_scantron_config($env{'form.scantron_format'}); + my %scantron_config=&Apache::lonnet::get_scantron_config($env{'form.scantron_format'}); my $CODElist; if ($scantron_config{'CODElocation'} && $scantron_config{'CODEstart'} && @@ -7170,7 +7074,7 @@ sub scantron_validate_file { #get the student pick code ready $r->print(&Apache::loncommon::studentbrowser_javascript()); my $nav_error; - my %scantron_config=&get_scantron_config($env{'form.scantron_format'}); + my %scantron_config=&Apache::lonnet::get_scantron_config($env{'form.scantron_format'}); my $max_bubble=&scantron_get_maxbubble(\$nav_error,\%scantron_config); if ($nav_error) { $r->print(&navmap_errormsg()); @@ -7629,7 +7533,7 @@ sub scantron_validate_ID { my %idmap=&username_to_idmap($classlist); #get scantron line setup - my %scantron_config=&get_scantron_config($env{'form.scantron_format'}); + my %scantron_config=&Apache::lonnet::get_scantron_config($env{'form.scantron_format'}); my ($scanlines,$scan_data)=&scantron_getfile(); my $nav_error; @@ -8093,7 +7997,7 @@ sub prompt_for_corrections { Arguments: $r - Apache request object - $scan_config - hash from &get_scantron_config() + $scan_config - hash from &Apache::lonnet::get_scantron_config() $line - Number of the line being displayed. $questionnum - Question number (may include subquestion) $error - Type of error. @@ -8257,7 +8161,7 @@ sub get_codes { sub scantron_validate_CODE { my ($r,$currentphase) = @_; - my %scantron_config=&get_scantron_config($env{'form.scantron_format'}); + my %scantron_config=&Apache::lonnet::get_scantron_config($env{'form.scantron_format'}); if ($scantron_config{'CODElocation'} && $scantron_config{'CODEstart'} && $scantron_config{'CODElength'}) { @@ -8331,7 +8235,7 @@ sub scantron_validate_doublebubble { &Apache::lonnet::decode_symb($env{'form.selectpage'}); #get scantron line setup - my %scantron_config=&get_scantron_config($env{'form.scantron_format'}); + my %scantron_config=&Apache::lonnet::get_scantron_config($env{'form.scantron_format'}); my ($scanlines,$scan_data)=&scantron_getfile(); my $navmap = Apache::lonnavmaps::navmap->new(); @@ -8513,7 +8417,7 @@ sub scantron_validate_missingbubbles { &Apache::lonnet::decode_symb($env{'form.selectpage'}); #get scantron line setup - my %scantron_config=&get_scantron_config($env{'form.scantron_format'}); + my %scantron_config=&Apache::lonnet::get_scantron_config($env{'form.scantron_format'}); my ($scanlines,$scan_data)=&scantron_getfile(); my $navmap = Apache::lonnavmaps::navmap->new(); @@ -8642,7 +8546,7 @@ sub hand_bubble_option { } } if ($needs_hand_bubbles) { - my %scantron_config=&get_scantron_config($env{'form.scantron_format'}); + my %scantron_config=&Apache::lonnet::get_scantron_config($env{'form.scantron_format'}); my $bubbles_per_row = &bubblesheet_bubbles_per_row(\%scantron_config); return &mt('The sequence to be graded contains response types which are handgraded.').'

'. &mt('If you have already graded these by bubbling sheets to indicate points awarded, [_1]what point value is assigned to a filled last bubble in each row?','
'). @@ -8662,7 +8566,7 @@ sub scantron_process_students { } my $default_form_data=&defaultFormData($symb); - my %scantron_config=&get_scantron_config($env{'form.scantron_format'}); + my %scantron_config=&Apache::lonnet::get_scantron_config($env{'form.scantron_format'}); my $bubbles_per_row = &bubblesheet_bubbles_per_row(\%scantron_config); my ($scanlines,$scan_data)=&scantron_getfile(); my $classlist=&Apache::loncoursedata::get_classlist(); @@ -8732,7 +8636,7 @@ SCANTRONFORM return ''; # Dunno why the other returns return '' rather than just returning. } - my %lettdig = &letter_to_digits(); + my %lettdig = &Apache::lonnet::letter_to_digits(); my $numletts = scalar(keys(%lettdig)); my %orderedforcode; @@ -9063,6 +8967,7 @@ sub grade_student_bubbles { sub scantron_upload_scantron_data { my ($r)=@_; my $dom = $env{'request.role.domain'}; + my ($formatoptions,$formattitle,$formatjs) = &scantron_upload_dataformat($dom); my $domdesc = &Apache::lonnet::domain($dom,'description'); $r->print(&Apache::loncommon::coursebrowser_javascript($dom)); my $select_link=&Apache::loncommon::selectcourse_link('rules','courseid', @@ -9076,8 +8981,7 @@ sub scantron_upload_scantron_data { &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(' - - + '.$formatjs.' +')); + $r->print('

'.&mt('Send bubblesheet data to a course').'

@@ -9119,7 +9024,12 @@ sub scantron_upload_scantron_data { &Apache::lonhtmlcommon::row_closure(). &Apache::lonhtmlcommon::row_title(&mt('Domain')). ''.$domdesc. - &Apache::lonhtmlcommon::row_closure(). + &Apache::lonhtmlcommon::row_closure()); + if ($formatoptions) { + $r->print(&Apache::lonhtmlcommon::row_title($formattitle).$formatoptions. + &Apache::lonhtmlcommon::row_closure()); + } + $r->print( &Apache::lonhtmlcommon::row_title(&mt('File to upload')). ''. &Apache::lonhtmlcommon::row_closure(1). @@ -9132,6 +9042,84 @@ sub scantron_upload_scantron_data { return ''; } +sub scantron_upload_dataformat { + my ($dom) = @_; + my ($formatoptions,$formattitle,$formatjs); + $formatjs = <<'END'; +function toggleScantab(form) { + return; +} +END + my %domconfig = &Apache::lonnet::get_dom('configuration',['scantron'],$dom); + if (ref($domconfig{'scantron'}) eq 'HASH') { + if (ref($domconfig{'scantron'}{'config'}) eq 'HASH') { + if (keys(%{$domconfig{'scantron'}{'config'}}) > 1) { + if (($domconfig{'scantron'}{'config'}{'dat'}) && + (ref($domconfig{'scantron'}{'config'}{'csv'}) eq 'HASH')) { + if (ref($domconfig{'scantron'}{'config'}{'csv'}{'fields'}) eq 'HASH') { + if (keys(%{$domconfig{'scantron'}{'config'}{'csv'}{'fields'}})) { + my ($onclick,$formatextra,$singleline); + my @lines = &Apache::lonnet::get_scantronformat_file(); + my $count = 0; + foreach my $line (@lines) { + next if ($line =~ /^#/); + $singleline = $line; + $count ++; + } + if ($count > 1) { + $formatextra = ''; + $onclick = ' onclick="toggleScantab(this.form);"'; + $formatjs = <<"END"; +function toggleScantab(form) { + var divid = 'bubbletype'; + if (document.getElementById(divid)) { + var radioname = 'fileformat'; + var num = form.elements[radioname].length; + if (num) { + for (var i=0; i'; + } + $formattitle = &mt('File format'); + $formatoptions = ''.(' 'x2). + ''.$formatextra; + } + } + } + } elsif (keys(%{$domconfig{'scantron'}{'config'}}) == 1) { + if (ref($domconfig{'scantron'}{'config'}{'csv'}{'fields'}) eq 'HASH') { + if (keys(%{$domconfig{'scantron'}{'config'}{'csv'}{'fields'}})) { + $formattitle = &mt('Bubblesheet type'); + $formatoptions = &scantron_scantab(); + } + } + } + } + } + return ($formatoptions,$formattitle,$formatjs); +} sub scantron_upload_scantron_data_save { my($r)=@_; @@ -9161,8 +9149,38 @@ sub scantron_upload_scantron_data_save { &mt('The file: [_1] you attempted to upload contained no information. Please check that you entered the correct filename.', ''.&HTML::Entities::encode($env{'form.upfile.filename'},'<>&"').''),1)); } else { - my $result = - &Apache::lonnet::userfileupload('upfile','','scantron','','','', + my %domconfig = &Apache::lonnet::get_dom('configuration',['scantron'],$env{'form.domainid'}); + my $parser; + if (ref($domconfig{'scantron'}) eq 'HASH') { + if (ref($domconfig{'scantron'}{'config'}) eq 'HASH') { + my $is_csv; + my @possibles = keys(%{$domconfig{'scantron'}{'config'}}); + if (@possibles > 1) { + if ($env{'form.fileformat'} eq 'csv') { + if (ref($domconfig{'scantron'}{'config'}{'csv'}) eq 'HASH') { + if (ref($domconfig{'scantron'}{'config'}{'csv'}{'fields'}) eq 'HASH') { + if (keys(%{$domconfig{'scantron'}{'config'}{'csv'}{'fields'}}) > 1) { + $is_csv = 1; + } + } + } + } + } elsif (@possibles == 1) { + if (ref($domconfig{'scantron'}{'config'}{'csv'}) eq 'HASH') { + if (ref($domconfig{'scantron'}{'config'}{'csv'}{'fields'}) eq 'HASH') { + if (keys(%{$domconfig{'scantron'}{'config'}{'csv'}{'fields'}}) > 1) { + $is_csv = 1; + } + } + } + } + if ($is_csv) { + $parser = $domconfig{'scantron'}{'config'}{'csv'}; + } + } + } + my $result = + &Apache::lonnet::userfileupload('upfile','scantron','scantron',$parser,'','', $env{'form.courseid'},$env{'form.domainid'}); if ($result =~ m{^/uploaded/}) { $r->print( @@ -9207,7 +9225,7 @@ sub validate_uploaded_scantron_file { $idmap{$lckey} = $idmap{$key}; } my %unique_formats; - my @formatlines = &get_scantronformat_file(); + my @formatlines = &Apache::lonnet::get_scantronformat_file(); foreach my $line (@formatlines) { chomp($line); my @config = split(/:/,$line); @@ -9353,14 +9371,14 @@ sub checkscantron_results { if (!$symb) {return '';} my $grading_menu_button=&show_grading_menu_form($symb); my $cid = $env{'request.course.id'}; - my %lettdig = &letter_to_digits(); + my %lettdig = &Apache::lonnet::letter_to_digits(); my $numletts = scalar(keys(%lettdig)); my $cnum = $env{'course.'.$cid.'.num'}; my $cdom = $env{'course.'.$cid.'.domain'}; my (undef, undef, $sequence) = &Apache::lonnet::decode_symb($env{'form.selectpage'}); my %record; my %scantron_config = - &Apache::grades::get_scantron_config($env{'form.scantron_format'}); + &Apache::lonnet::get_scantron_config($env{'form.scantron_format'}); my $bubbles_per_row = &bubblesheet_bubbles_per_row(\%scantron_config); my ($scanlines,$scan_data)=&Apache::grades::scantron_getfile(); my $classlist=&Apache::loncoursedata::get_classlist(); @@ -9684,23 +9702,6 @@ sub verify_scantron_grading { return ($counter,$record); } -sub letter_to_digits { - my %lettdig = ( - A => 1, - B => 2, - C => 3, - D => 4, - E => 5, - F => 6, - G => 7, - H => 8, - I => 9, - J => 0, - ); - return %lettdig; -} - - #-------- end of section for handling grading scantron forms ------- # #------------------------------------------------------------------- @@ -10305,7 +10306,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) { @@ -10315,6 +10316,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 @@ -10342,12 +10359,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).'
'. @@ -10396,7 +10415,7 @@ ENDHEADER "\n".&mt("Username").":  ". "\n".&mt("Domain").": ". &Apache::loncommon::select_dom_form($env{'course.'.$env{'request.course.id'}.'.domain'},'udom'.$id).' '. - &Apache::loncommon::selectstudent_link('clickeranalysis','uname'.$id,'udom'.$id,0,$id); + &Apache::loncommon::selectstudent_link('clickeranalysis','uname'.$id,'udom'.$id,'',$id); $unknown_count++; } } @@ -10450,6 +10469,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)=@_; my $number=0; @@ -10648,12 +10710,20 @@ sub navmap_errormsg { } sub startpage { - my ($r,$symb,$crumbs,$onlyfolderflag,$nodisplayflag,$stuvcurrent,$stuvdisp,$nomenu,$js) = @_; + my ($r,$symb,$crumbs,$onlyfolderflag,$nodisplayflag,$stuvcurrent,$stuvdisp,$nomenu,$js,$onload) = @_; + my %args; + if ($onload) { + my %loaditems = ( + 'onload' => $onload, + ); + $args{'add_entries'} = \%loaditems; + } if ($nomenu) { - $r->print(&Apache::loncommon::start_page("Student's Version",$js,{'only_body' => '1'})); + $args{'only_body'} = 1; + $r->print(&Apache::loncommon::start_page("Student's Version",$js,\%args)); } else { - $r->print(&Apache::loncommon::start_page('Grading',$js, - {'bread_crumbs' => $crumbs})); + $args{'bread_crumbs'} = $crumbs; + $r->print(&Apache::loncommon::start_page('Grading',$js,\%args)); } unless ($nodisplayflag) { $r->print(&Apache::lonhtmlcommon::resource_info_box($symb,$onlyfolderflag,$stuvcurrent,$stuvdisp)); @@ -10735,8 +10805,16 @@ sub handler { } &Apache::loncommon::content_type($request,'text/html'); $request->send_http_header; - unless ((($command eq 'submission' || $command eq 'versionsub')) && ($perm{'vgr'})) { - $request->print($start_page); + if (($command eq 'scantron_selectphase' && $perm{'mgr'}) || + (($command eq 'scantronupload') && + (&Apache::lonnet::allowed('usc',$env{'request.role.domain'}) || + &Apache::lonnet::allowed('usc',$env{'request.course.id'})))) { + &startpage($request,$symb,[{href=>'/adm/grades', text=>"Grading"}],1,1, + undef,undef,undef,undef,'toggleScantab(document.rules);'); + } else { + unless ((($command eq 'submission' || $command eq 'versionsub')) && ($perm{'vgr'})) { + $request->print($start_page); + } } if ($command eq 'submission' && $perm{'vgr'}) { my ($stuvcurrent,$stuvdisp,$versionform,$js); @@ -10915,7 +10993,7 @@ ssi_with_retries() $r - Apache request object $i - number of the current scanline $scan_record - hash ref as returned from &scantron_parse_scanline() - $scan_config - hash ref as returned from &get_scantron_config() + $scan_config - hash ref as returned from &Apache::lonnet::get_scantron_config() $line - full contents of the current scanline $error - error condition, valid values are 'incorrectCODE', 'duplicateCODE',