File:  [LON-CAPA] / loncom / interface / statistics / lonstudentsubmissions.pm
Revision 1.68.2.3: download - view: text, annotated - select for diffs
Wed Feb 26 03:15:04 2014 UTC (10 years, 3 months ago) by raeburn
Branches: version_2_11_X
CVS tags: version_2_11_4_uiuc, version_2_11_4_msu, version_2_11_4, version_2_11_3_uiuc, version_2_11_3_msu, version_2_11_3, version_2_11_2_uiuc, version_2_11_2_msu, version_2_11_2_educog, version_2_11_2, version_2_11_1, version_2_11_0_RC3, version_2_11_0
- For 2.11
  - Backport 1.70

    1: # The LearningOnline Network with CAPA
    2: #
    3: # $Id: lonstudentsubmissions.pm,v 1.68.2.3 2014/02/26 03:15:04 raeburn Exp $
    4: #
    5: # Copyright Michigan State University Board of Trustees
    6: #
    7: # This file is part of the LearningOnline Network with CAPA (LON-CAPA).
    8: #
    9: # LON-CAPA is free software; you can redistribute it and/or modify
   10: # it under the terms of the GNU General Public License as published by
   11: # the Free Software Foundation; either version 2 of the License, or
   12: # (at your option) any later version.
   13: #
   14: # LON-CAPA is distributed in the hope that it will be useful,
   15: # but WITHOUT ANY WARRANTY; without even the implied warranty of
   16: # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
   17: # GNU General Public License for more details.
   18: #
   19: # You should have received a copy of the GNU General Public License
   20: # along with LON-CAPA; if not, write to the Free Software
   21: # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
   22: #
   23: # /home/httpd/html/adm/gpl.txt
   24: #
   25: # http://www.lon-capa.org/
   26: #
   27: package Apache::lonstudentsubmissions;
   28: 
   29: use strict;
   30: use Apache::lonnet;
   31: use Apache::loncommon();
   32: use Apache::lonhtmlcommon();
   33: use Apache::loncoursedata();
   34: use Apache::lonstatistics;
   35: use Apache::lonlocal;
   36: use Apache::lonstathelpers;
   37: use Apache::lonmsgdisplay();
   38: use HTML::Entities();
   39: use Time::Local();
   40: use Spreadsheet::WriteExcel();
   41: use lib '/home/httpd/lib/perl/';
   42: use LONCAPA;
   43:   
   44: 
   45: my @SubmitButtons = ({ name => 'SelectAnother',
   46:                        text => 'Choose a different Problem' },
   47:                      { name => 'Generate',
   48:                        text => 'Generate Report'},
   49:                      );
   50: 
   51: sub BuildStudentSubmissionsPage {
   52:     my ($r,$c)=@_;
   53:     #
   54:     my %Saveable_Parameters = ('Status' => 'scalar',
   55:                                'Section' => 'array',
   56:                                'NumPlots' => 'scalar',
   57:                                );
   58:     &Apache::loncommon::store_course_settings('student_submissions',
   59:                                               \%Saveable_Parameters);
   60:     &Apache::loncommon::restore_course_settings('student_submissions',
   61:                                                 \%Saveable_Parameters);
   62:     #
   63:     &Apache::lonstatistics::PrepareClasslist();
   64:     #
   65:     $r->print( &Apache::lonhtmlcommon::breadcrumbs('Student Submission Reports'));
   66:     $r->print(&CreateInterface());
   67:     #
   68:     my @Students = @Apache::lonstatistics::Students;
   69:     #
   70:     if (@Students < 1) {
   71:         $r->print('<div class="LC_warning">'
   72:                  .&mt('There are no students in the sections selected.')
   73:                  .'</div>');
   74:     }
   75:     #
   76:     my @CacheButtonHTML = 
   77:         &Apache::lonstathelpers::manage_caches($r,'Statistics','stats_status',
   78:                                    '<div class="LC_info">'.&mt('Loading student data...').'</div>');
   79:     $r->rflush();
   80:     #
   81:     my %anoncounter =
   82:          &Apache::lonnet::dump('nohist_anonsurveys',
   83:                         $env{'course.'.$env{'request.course.id'}.'.domain'},
   84:                         $env{'course.'.$env{'request.course.id'}.'.num'});
   85:     if (exists($env{'form.problemchoice'}) && 
   86:         ! exists($env{'form.SelectAnother'})) {
   87:         foreach my $button (@SubmitButtons) {
   88:             if ($button->{'name'} eq 'break') {
   89:                 $r->print("<br />\n");
   90:             } else {
   91:                 $r->print('<input type="submit" name="'.$button->{'name'}.'" '.
   92:                           'value="'.&mt($button->{'text'}).'" />');
   93:                 $r->print('&nbsp;'x5);
   94:             }
   95:         }
   96:         foreach my $html (@CacheButtonHTML) {
   97:             $r->print($html.('&nbsp;'x5));
   98:         }
   99:         #
  100:         $r->print('<hr />'.$/);
  101:         $r->rflush();
  102:         #
  103:         # Determine which problems we are to analyze
  104:         my @Symbs = 
  105:             &Apache::lonstathelpers::get_selected_symbs('problemchoice');
  106: 
  107:         # If there are multi-part problems with anonymous survey and named
  108:         # parts check if named was picked for display.
  109:         #
  110:         my %mixed_named; 
  111:         foreach my $envkey (%env) {
  112:             if ($envkey =~ /^form\.mixed_(\d+:\d+)$/) {
  113:                 my $item = $1; 
  114:                 if ($env{$envkey} =~ /^symb_(.+)$/) {
  115:                     my $symb = &unescape($1);
  116:                     if (ref($mixed_named{$symb}) eq 'ARRAY') {
  117:                         push(@{$mixed_named{$symb}},$item);
  118:                     } else {
  119:                         @{$mixed_named{$symb}} = ($item);
  120:                     }
  121:                 }
  122:             }
  123:         }
  124:         #
  125:         # Get resource objects
  126:         my $navmap = Apache::lonnavmaps::navmap->new();
  127:         if (!defined($navmap)) {
  128:             foreach my $selected (@Symbs) {
  129:                 $r->print('<input type="hidden" name="problemchoice" value="'.
  130:                           &escape($selected).'" />'.$/);
  131:                 if (ref($mixed_named{$selected}) eq 'ARRAY') {
  132:                     foreach my $item (@{$mixed_named{$selected}}) {
  133:                         $r->print('<input type="hidden" name="mixed_'.$item.'" value="'.&escape($selected).'" />'.$/);
  134:                     }
  135:                 }
  136:             }
  137:             $r->print('<div class="LC_error">'.&mt("Internal error").'</div>');
  138:             return;
  139:         }
  140:         my %already_seen;
  141:         my (@Problems,@anonProbs,@namedProbs,$show_named);
  142:         foreach my $symb (@Symbs) {
  143:             my $resource = $navmap->getBySymb($symb);
  144:             my ($hasanon,$hasnamed);
  145:             if (ref($resource)) {
  146:                 foreach my $partid (@{$resource->parts}) {
  147:                     if (($anoncounter{$symb."\0".$partid}) || ($resource->is_anonsurvey($partid))) {
  148:                         unless (exists($mixed_named{$symb})) {
  149:                             $hasanon = 1;
  150:                         }
  151:                     } else {
  152:                         $hasnamed = 1;
  153:                     }
  154:                 }
  155:                 if ($hasanon) {
  156:                     push(@anonProbs,$resource);
  157:                 } elsif ($hasnamed) {
  158:                     push(@namedProbs,$resource);
  159:                 }
  160:             }
  161:         }
  162:         if (@namedProbs > 0) {
  163:             @Problems = @namedProbs;
  164:             $show_named = 1;
  165:         } elsif (@anonProbs > 0) {
  166:             @Problems = @anonProbs;
  167:         } 
  168:         foreach my $selected (@Symbs) {
  169:             $r->print('<input type="hidden" name="problemchoice" value="'.
  170:                       &escape($selected).'" />'.$/);
  171:             if (ref($mixed_named{$selected}) eq 'ARRAY') {
  172:                 foreach my $item (@{$mixed_named{$selected}}) {
  173:                     $r->print('<input type="hidden" name="mixed_'.$item.'" value="'.&escape($selected).'" />'.$/);
  174:                 }
  175:             }
  176:         }
  177:         # If these are to be anonymized, do a random shuffle of @Students. 
  178:         unless ($show_named) {
  179:             &array_shuffle(\@Students);
  180:         }
  181:         #
  182: 
  183:         my $threshold = $env{'course.'.$env{'request.course.id'}.'.internal.anonsurvey_threshold'};
  184:         if ($threshold eq '') {
  185:             my %domconfig =
  186:                 &Apache::lonnet::get_dom('configuration',['coursedefaults'],
  187:                                         $env{'course.'.$env{'request.course.id'}.'.domain'});
  188:             if (ref($domconfig{'coursedefaults'}) eq 'HASH') {
  189:                 $threshold = $domconfig{'coursedefaults'}{'anonsurvey_threshold'};
  190:                 if ($threshold eq '') {
  191:                     $threshold = 10;
  192:                 }
  193:             } else {
  194:                 $threshold = 10;
  195:             }
  196:         }
  197:         $r->print('<p>'.
  198:                   &Apache::lonstatistics::section_and_enrollment_description().
  199:                   '</p>');
  200:         if (! scalar(@Problems) || ! defined($Problems[0])) {
  201:             $r->print(&mt('resource is undefined'));
  202:         } elsif (!$show_named && @Students < $threshold) {
  203:             $r->print(&mt('The number of students matching the selection criteria is too few for display of submission data for anonymous surveys.').'<br />'.&mt('There must be at least [quant,_1,student].',$threshold).' '.&mt('Contact a Domain Coordinator if you need the threshold to be changed for this course.'));
  204:         } else {
  205:             if (scalar(@Problems) == 1) {
  206:                 my $resource = $Problems[0];
  207:                 $r->print('<h1>'.$resource->title.'</h1>');
  208:                 $r->print('<h3>'.$resource->src.'</h3>');
  209:                 if ($env{'form.renderprob'} eq 'true') {
  210:                     $r->print(&Apache::lonstathelpers::render_resource($resource));
  211:                     $r->rflush();
  212:                 }
  213:             }
  214:             if ($env{'form.output'} eq 'excel') {
  215:                 &prepare_excel_output($r,\@Problems,\@Students,\%anoncounter,$show_named);
  216:             } elsif ($env{'form.output'} eq 'csv') {
  217:                 &prepare_csv_output($r,\@Problems,\@Students,\%anoncounter,$show_named);
  218:             } else {
  219:                 &prepare_html_output($r,\@Problems,\@Students,\%anoncounter,$show_named);
  220:             }
  221:         }
  222:         $r->print('<hr />');
  223:     } else {
  224:         $r->print('<input type="submit" name="Generate" value="'.
  225:                   &mt('Prepare Report').'" />');
  226:         $r->print('&nbsp;'x5);
  227:         $r->print('<p>'.
  228:                   &mt('Computing correct answers greatly increases the amount of time required to prepare a report.').
  229:                   '</p>');
  230:         $r->print('<p>'.
  231:                   &mt('Please select problems and use the [_1]Prepare Report[_2] button to continue.','<b>','</b>').
  232:                   '</p>');
  233:         $r->print(&Apache::lonstathelpers::MultipleProblemSelector
  234:                   (undef,'problemchoice','Statistics',\%anoncounter));
  235:     }
  236: }
  237: 
  238: sub array_shuffle {
  239:     my $array = shift;
  240:     return unless (ref($array) eq 'ARRAY');
  241:     my $i = scalar(@$array);
  242:     my $j;
  243:     foreach my $item (@$array) {
  244:         --$i;
  245:         $j = int(rand($i+1));
  246:         next if($i == $j);
  247:         @$array [$i,$j] = @$array[$j,$i];
  248:     }
  249:     return @$array;
  250: }
  251: 
  252: ##
  253: ## get_extra_response_headers
  254: ##
  255: sub get_extra_response_headers {
  256:     my ($show_named) = @_;
  257:     my @extra_resp_headers;
  258:     if ($env{'form.correctans'} eq 'true') {
  259:         push(@extra_resp_headers,'Correct');
  260:     }
  261:     if ($show_named) { 
  262:         if ($env{'form.prob_status'} eq 'true') {
  263:             push(@extra_resp_headers,'Award Detail'); 
  264:             push(@extra_resp_headers,'Time');
  265:             push(@extra_resp_headers,'Attempt');
  266:             push(@extra_resp_headers,'Awarded');
  267:         }
  268:     }
  269:     return @extra_resp_headers;
  270: }
  271: 
  272: ##
  273: ## get_headers:
  274: ##     return the proper headers for the given response 
  275: sub get_headers {
  276:     my ($prob,$partid,$respid,$resptype,$analysis,$output,$purpose,
  277:         @basic_headers) = @_;
  278:     my @headers;
  279:     if ($resptype eq 'essay' && $purpose eq 'display' &&
  280:         ($output eq 'html')) {# || scalar(@{$prob->parts})!=1)) {
  281:         @headers = ();
  282:     } elsif ($resptype =~ /^(option|match|rank)$/) {
  283:         my $prefix = '_';
  284:         if ($purpose eq 'display') {
  285:             $prefix = '';
  286:         }
  287:         my @foils = 
  288:             map { 
  289:                 $prefix.$_; 
  290:             } sort(keys(%{$analysis->{$partid.'.'.$respid}->{'_Foils'}}));
  291:         if (scalar(@basic_headers) && $basic_headers[0] eq 'Correct') {
  292:             @foils = map { ($_ , $_.' Correct') } @foils;
  293:             shift(@basic_headers);  # Get rid of 'Correct'
  294:         }
  295:         @headers = (@foils,@basic_headers);
  296:     } elsif (lc($resptype) eq 'task') {
  297:         @headers = ('Grader','Status',@basic_headers,'Submission');
  298:     } else {
  299:         @headers = ('Submission',@basic_headers);
  300:     }
  301:     return @headers;
  302: }
  303: 
  304: #########################################################
  305: #########################################################
  306: ##
  307: ##    HTML Output Routines
  308: ##
  309: #########################################################
  310: #########################################################
  311: sub prepare_html_output {
  312:     my ($r,$problems,$students,$anoncounter,$show_named) = @_;
  313:     my $c = $r->connection();
  314:     #
  315:     # Set a flag for the case when there is just one problem
  316:     my $single_response = 0;
  317:     if (scalar(@$problems) == 1 &&
  318:         $problems->[0]->countResponses == 1) {
  319:         $single_response = 1;
  320:     }
  321:     #
  322:     # Compute the number of columns per response
  323:     my @extra_resp_headers = &get_extra_response_headers($show_named);
  324:     #
  325:     # Create the table header
  326:     my @student_columns = &get_student_columns($show_named);
  327:     my %headers;
  328:     my $student_column_count = scalar(@student_columns);
  329:     $headers{'problem'} = qq{<th colspan="$student_column_count">\&nbsp;</th>};
  330:     foreach my $field (@student_columns) {
  331:         $headers{'student'}.= '<th>'.&mt(ucfirst($field)).'</th>';
  332:     }
  333:     #
  334:     # we put the headers into the %headers hash
  335:     my $total_col = $student_column_count;
  336:     my $nonempty_part_headers = 0;
  337:     #
  338:     my %problem_analysis;
  339:     foreach my $prob (@$problems) {
  340:         my %analysis = &Apache::lonstathelpers::get_problem_data($prob->src);
  341:         $problem_analysis{$prob->src}=\%analysis;
  342:         my $symb = $prob->symb();
  343:         #
  344:         my $prob_span = 0;
  345:         my $single_part = 0;
  346:         if (scalar(@{$prob->parts}) == 1) {
  347:             $single_part = 1;
  348:         }
  349:         my $shown_parts = 0;
  350:         foreach my $partid (@{$prob->parts}) {
  351:             if (($prob->is_anonsurvey($partid)) || ($anoncounter->{$symb."\0".$partid})) {
  352:                 next if ($show_named);
  353:             } else {
  354:                 next unless ($show_named);
  355:             }
  356:             $shown_parts ++;
  357:             my $part_span = 0;
  358:             my $responses = [$prob->responseIds($partid)];
  359:             my $resptypes = [$prob->responseType($partid)];
  360:             for (my $i=0;$i<scalar(@$responses);$i++) {
  361:                 my $respid = $responses->[$i];
  362:                 my @headers = &get_headers($prob,$partid,$respid,
  363:                                            $resptypes->[$i],
  364:                                            $problem_analysis{$prob->src},
  365:                                            'html','display',
  366:                                            @extra_resp_headers);
  367:                 if (scalar(@headers)>0) {
  368:                     $total_col += scalar(@headers);
  369:                     $part_span += scalar(@headers);
  370:                     $headers{'response'} .=
  371:                         '<th colspan="'.scalar(@headers).'">'.
  372:                         &mt('Response [_1]',$responses->[$i]).'</th>';
  373:                     $headers{'student'}.= '<th><span class="LC_nobreak">'.
  374:                                           join('</span></th><th><span class="LC_nobreak">',
  375:                                                       @headers).
  376:                                                           '</span></th>';
  377:                 }
  378:             }
  379:             if ($part_span == 0) {
  380:                 next;
  381:             }
  382:             if (! $single_part) {
  383:                 my $tmpname = $partid;
  384:                 if ($partid =~/^\d+$/) {
  385:                     $tmpname = $prob->part_display($partid);
  386:                 }
  387:                 if ($tmpname !~ /^part/) {
  388:                     $tmpname = 'Part '.$tmpname;
  389:                 }
  390:                 $headers{'part'} .= qq{<th colspan="$part_span">$tmpname</th>};
  391:                 $nonempty_part_headers = 1;
  392:             } else {
  393:                 $headers{'part'} .= qq{<th colspan="$part_span">&nbsp;</th>};
  394:             }
  395:             $prob_span += $part_span;
  396:         }
  397:         next if (!$shown_parts);
  398:         my $title = $prob->compTitle;
  399:         if ($prob_span > 0) {
  400:             $headers{'problem'}.= qq{<th colspan="$prob_span">$title</th>};
  401:         } elsif ($single_response) {
  402:             $prob_span = scalar(@student_columns);
  403:             $headers{'problem'} = qq{<th colspan="$prob_span">$title</th>};
  404:         }
  405:     }
  406:     if (exists($headers{'part'})) {
  407:         $headers{'part'} = qq{<th colspan="$student_column_count">\&nbsp;</th>}.
  408:             $headers{'part'};
  409:     }
  410:     if (exists($headers{'response'})) {
  411:         $headers{'response'}=
  412:             qq{<th colspan="$student_column_count">\&nbsp;</th>}.
  413:             $headers{'response'};
  414:     }
  415:     #my $full_header = $/.'<table>'.$/;
  416:     my $full_header = $/.&Apache::loncommon::start_data_table().$/;
  417:     $full_header .= '<tr align="left">'.$headers{'problem'}.'</tr>'.$/;
  418:     if ($nonempty_part_headers) {
  419:         $full_header .= '<tr align="left">'.$headers{'part'}.'</tr>'.$/;
  420:     }
  421:     $full_header .= '<tr align="left">'.$headers{'response'}.'</tr>'.$/;
  422:     $full_header .= '<tr align="left">'.$headers{'student'}.'</tr>'.$/;
  423:     #
  424:     # Main loop
  425:     my $count;
  426:     $r->print($/.$full_header.$/);
  427:     foreach my $student (@$students) {
  428:         my $student_row_data;
  429:         if ($count++ >= 30) {
  430:             $r->print(&Apache::loncommon::end_data_table().$/.$full_header.$/);
  431:             $count = 0;
  432:         }
  433:         last if ($c->aborted());
  434:         if ($show_named) {
  435:             foreach my $field (@student_columns) {
  436:                 $student_row_data .= '<td valign="top">';
  437:                 # handle comments like in lonstudentassessment.pm
  438:                 if($field eq 'comments') {
  439:                     $student_row_data .= 
  440:                         '<a href="/adm/'.$student->{'domain'}.'/'.
  441:                         $student->{'username'}.'/'.'aboutme#coursecomment">'.&mt('Comments').'</a>';
  442:                 } else {
  443:                     $student_row_data .= $student->{$field};
  444:                 }
  445:                 $student_row_data .= '</td>';
  446:             }
  447:         } else {
  448:             $student_row_data = '<td valign="top" colspan="'.$student_column_count.'">'.&mt('Anonymized').'</td>';
  449:         }
  450:         #
  451:         # Figure out what it is we need to output for this student
  452:         my @essays;
  453:         my %prob_data;
  454:         my $maxrow;
  455:         foreach my $prob (@$problems) {
  456:             my $symb = $prob->symb;
  457:             $prob_data{$symb}={};
  458:             foreach my $partid (@{$prob->parts}) {
  459:                 if (($prob->is_anonsurvey($partid)) || ($anoncounter->{$symb."\0".$partid})) {
  460:                     next if ($show_named);
  461:                 } else {
  462:                     next unless ($show_named);
  463:                 }
  464:                 my @responses = $prob->responseIds($partid);
  465:                 my @response_type = $prob->responseType($partid);
  466:                 for (my $i=0;$i<=$#responses;$i++) {
  467:                     my $respid  = $responses[$i];
  468:                     my $results = 
  469:                         &Apache::loncoursedata::get_response_data_by_student
  470:                         ($student,$prob->symb(),$respid);
  471:                     my $resptype = $response_type[$i];
  472:                     my @headers = &get_headers($prob,$partid,$respid,
  473:                                                $resptype,
  474:                                                $problem_analysis{$prob->src},
  475:                                                'html','normal',
  476:                                                @extra_resp_headers);
  477:                     my $width = scalar(@headers);
  478:                     next if ($width < 1);
  479:                     my $resp_data;
  480:                     $resp_data->{'fake'} = qq{<td colspan="$width">&nbsp;</td>};
  481:                     if (! defined($results)) {
  482:                         $results = [];
  483:                     }
  484:                     # 
  485:                     if (scalar(@$results) > $maxrow && $resptype ne 'essay') {
  486:                         $maxrow = scalar(@$results);
  487:                     }
  488:                     for (my $j=scalar(@$results)-1;$j>=0;$j--) {
  489:                         if ($env{'form.all_sub'} ne 'true') {
  490:                             next if ($j ne scalar(@$results)-1);
  491:                         }
  492:                         my $response = &hashify_response($results->[$j],
  493:                                                          $prob,
  494:                                                          $student,
  495:                                                          $partid,
  496:                                                          $respid);
  497:                         if ($resptype eq 'essay') {
  498:                             push(@essays,
  499:                                  &html_essay_results(\@headers,
  500:                                                      $prob,$partid,$respid,
  501:                                                      $response,
  502:                                                      $single_response).
  503:                                  '</td>');
  504: 			} elsif (lc($resptype) eq 'task') {
  505: 			    my $results = 
  506: 				&html_task_results(\@headers,
  507: 						   $prob,$partid,$respid,
  508: 						   $response,$resptype);
  509: 			    if ($results) {
  510: 				push(@{$resp_data->{'real'}},$results);
  511: 			    }
  512:                         } else {
  513:                             push(@{$resp_data->{'real'}},
  514:                                  &html_non_essay_results(\@headers,
  515:                                                          $prob,$partid,$respid,
  516:                                                          $response,$resptype));
  517:                         }
  518:                     }
  519:                     $prob_data{$prob->symb}->{$partid}->{$respid}=$resp_data;
  520:                 } # end of $i loop
  521:             } # end of partid loop
  522:         } # end of prob loop
  523:         #
  524:         # if there is no data, skip this student.
  525:         next if (! $maxrow && ! scalar(@essays));
  526:         #
  527:         # Go through the problem data and output a row.
  528:         my $printed_something;
  529:         for (my $rows_output = 0;$rows_output<$maxrow;$rows_output++) {
  530:             my $html;
  531:             my $no_data = 1;
  532:             foreach my $prob (@$problems) {
  533:                 foreach my $partid (@{$prob->parts}) {
  534:                     my @responses     = $prob->responseIds($partid);
  535:                     my @response_type = $prob->responseType($partid);
  536:                     for (my $i=0;$i<=$#responses;$i++) {
  537:                         my $respid   = $responses[$i];
  538:                         my $resp_data = 
  539:                             $prob_data{$prob->symb}->{$partid}->{$respid};
  540:                         next if ($response_type[$i] eq 'essay');
  541:                         if (defined($resp_data->{'real'}->[$rows_output])) {
  542:                             $html .= $resp_data->{'real'}->[$rows_output];
  543:                             $no_data = 0;
  544:                         } else {
  545:                             $html .= $resp_data->{'fake'};
  546:                         }
  547:                     }
  548:                 }
  549:             }
  550:             if (! $no_data) {
  551:                 $r->print(&Apache::loncommon::start_data_table_row().$student_row_data.$html.
  552:                           &Apache::loncommon::end_data_table_row().$/);
  553:                 $printed_something=1;
  554:             }
  555:         }
  556:         if (@essays) {
  557:             my $tr = &Apache::loncommon::start_data_table_row();
  558:             my $td = qq{<td  valign="top" class="essay" colspan="$total_col">};
  559:             if (! $printed_something) {
  560:                 $r->print($tr.$student_row_data.&Apache::loncommon::end_data_table_row().$/);
  561:             }
  562:             $r->print($tr.$td.
  563:                       join('</td></tr>'.$/.$tr.$td,@essays).'</td></tr>'.$/);
  564:             undef(@essays);
  565:         }
  566:     } # end of student loop
  567:     $r->print(&Apache::loncommon::end_data_table().$/);
  568:     return;
  569: }
  570: 
  571: sub hashify_response {
  572:     my ($response,$prob,$student,$partid,$respid) =@_;
  573:     my $resp_hash = {};
  574:     if ($env{'form.correctans'} eq 'true') {
  575:         $resp_hash->{'Correct'} = 
  576:             &Apache::lonstathelpers::get_student_answer
  577:             ($prob,$student->{'username'},$student->{'domain'},
  578:              $partid,$respid);
  579:     }
  580:     $resp_hash->{'Submission'} = 
  581:         $response->[&Apache::loncoursedata::RDs_submission()];
  582:     $resp_hash->{'Time'} = 
  583:         $response->[&Apache::loncoursedata::RDs_timestamp()];
  584:     $resp_hash->{'Attempt'} =
  585:         $response->[&Apache::loncoursedata::RDs_tries()];
  586:     $resp_hash->{'Awarded'} = 
  587:         $response->[&Apache::loncoursedata::RDs_awarded()];
  588:     if ($prob->is_task()) {
  589: 	$resp_hash->{'Grader'} = 
  590: 	    $response->[&Apache::loncoursedata::RDs_response_eval_2()];
  591: 	if ($resp_hash->{'Attempt'} eq '0') {
  592: 	    $resp_hash->{'Attempt'} = '';
  593: 	}
  594: 	$resp_hash->{'Award Detail'} = 
  595: 	    $response->[&Apache::loncoursedata::RDs_part_award()];
  596: 	$resp_hash->{'Status'} = 
  597: 	    $response->[&Apache::loncoursedata::RDs_response_eval()];
  598:     } else {
  599: 	$resp_hash->{'Award Detail'} = 
  600: 	    $response->[&Apache::loncoursedata::RDs_awarddetail()];
  601:     }
  602: 
  603:     return $resp_hash;
  604: }
  605: 
  606: #####################################################
  607: ##
  608: ##     HTML helper routines
  609: ##
  610: #####################################################
  611: sub html_essay_results {
  612:     my ($headers,$prob,$partid,$respid,$response,$single_response)=@_;
  613:     if (! ref($headers) || ref($headers) ne 'ARRAY') {
  614:         return '';
  615:     }
  616:     # Start of telling them what problem, part, and response
  617:     my $Str;
  618:     if (! $single_response) {
  619:         my $id = $prob->compTitle;
  620:         if (defined($partid) && $partid ne '0') {
  621:             $id .= ' '.$prob->part_display($partid);
  622:         }
  623:         if (defined($respid)) {
  624:             $id .= ' '.$respid;
  625:         }
  626:         $Str .= '<span class="LC_nobreak">'.$id.'</span>'.('&nbsp;'x4);
  627:     }
  628:     #
  629:     shift(@$headers); # Get rid of the Submission header
  630:     my $correct = '';
  631:     if ($headers->[0] eq 'Correct') {
  632:         $correct = &html_format_essay_sub($response->{'Correct'});
  633:         shift(@$headers);
  634:     }
  635:     $Str .= '<span class="LC_nobreak">'.
  636:         join('',
  637:              map {
  638:                  ('&nbsp;'x4).&mt($_.': [_1]',$response->{$_});
  639:              } @$headers).'</span>';
  640:     if (@$headers || ! $single_response) {
  641:         $Str .= '<br />';
  642:     }
  643:     $Str .= &html_format_essay_sub($response->{'Submission'});
  644:     #
  645:     if (defined($correct) && $correct !~ /^\s*$/) {
  646:         $Str .= '<hr /><b>'.&mt('Correct').'</b>'.$correct
  647:     }
  648:     return $Str;
  649: }
  650: 
  651: sub html_format_essay_sub {
  652:     my ($submission) = @_;
  653:     return '' if (! defined($submission) || $submission eq '');
  654:     $submission = &HTML::Entities::decode($submission);
  655:     $submission =~ s/\\\"/\"/g;
  656:     $submission =~ s/\\\'/\'/g;
  657:     $submission =~ s|\\r\\n|$/|g;
  658:     $submission = &HTML::Entities::encode($submission,'<>&"');
  659:     $submission =~ s|$/\s*$/|$/</p><p>$/|g;
  660:     $submission =~ s|\\||g;
  661:     $submission = '<p>'.$submission.'</p>';
  662:     return $submission;
  663: }
  664: 
  665: sub html_task_results {
  666:     my ($headers,$prob,$partid,$respid,$response,$resptype) = @_;
  667:     if (! ref($headers) || ref($headers) ne 'ARRAY' || ! scalar(@$headers)) {
  668:         return '';
  669:     }
  670: 
  671:     my @values;
  672:     @values = map { $response->{$_}; } @$headers;
  673: 
  674:     my $td = '<td valign="top">';
  675:     my $str = $td.join('</td>'.$td,@values).'</td>';
  676:     return $str;
  677: }
  678: 
  679: sub html_non_essay_results {
  680:     my ($headers,$prob,$partid,$respid,$response,$resptype) = @_;
  681:     if (! ref($headers) || ref($headers) ne 'ARRAY' || ! scalar(@$headers)) {
  682:         return '';
  683:     }
  684:     # 
  685:     my $submission = &HTML::Entities::decode(&unescape($response->{'Submission'})); 
  686:     return '' if (! defined($submission) || $submission eq '');
  687:     $submission =~ s/\\\"/\"/g;
  688:     $submission =~ s/\\\'/\'/g;
  689:     if ($resptype eq 'radiobutton') {
  690:         $submission = &HTML::Entities::encode($submission,'<>&"');
  691:         $submission =~ s/=([^=])$//;
  692:         $submission = '<span class="LC_nobreak">'.$submission.'</span>';
  693:     }
  694:     $response->{'Submission'} = $submission;
  695:     #
  696:     my @values;
  697:     if ($resptype =~ /^(option|match|rank)$/) {
  698:         my %submission = 
  699:             map { 
  700:                 my ($foil,$value) = split('=',&unescape($_));
  701:                 ($foil,$value);
  702:             } split('&',$response->{'Submission'});
  703:         my %correct;
  704:         if (exists($response->{'Correct'})) {
  705:             %correct = 
  706:                 map { 
  707:                     my ($foil,$value)=split('=',&unescape($_));
  708:                     ($foil,$value);
  709:                 } split('&',$response->{'Correct'});
  710:         }
  711:         #
  712:         foreach my $original_header (@$headers) {
  713:             if ($original_header =~ /^_/) {
  714:                 # '_' denotes a foil column
  715:                 my ($header) = ($original_header =~ m/^_(.*)$/);
  716:                 my $option = '';
  717:                 if ( my ($foil) = ($header =~ /(.*) Correct$/)) {
  718:                     if (exists($correct{$foil})) {
  719:                         $option = $correct{$foil};
  720:                     }
  721:                 } elsif (exists($submission{$header})) {
  722:                     $option = $submission{$header};
  723:                 }
  724:                 push(@values,&HTML::Entities::encode($option));
  725:             } elsif ($original_header eq 'Time') {
  726:                 push(@values,&Apache::lonlocal::locallocaltime($response->{$original_header}));
  727:             } else {
  728:                 # A normal column
  729:                 push(@values,$response->{$original_header});
  730:             }
  731:         }
  732:     } else {
  733:         foreach my $original_header (@$headers) {
  734:             if ($original_header eq 'Time') {
  735:                 push(@values,&Apache::lonlocal::locallocaltime($response->{$original_header}));
  736:             } elsif (($original_header eq 'Submission') &&
  737:                     !($resptype =~ /^(radiobutton|option|match|rank)$/)) {
  738:                 # encode all submissions which have not been encoded above
  739:                 push(@values,&HTML::Entities::encode($response->{$original_header},'<>&"'));
  740:             } elsif (($original_header eq 'Correct') &&
  741:                      ($resptype eq 'radiobutton')) {
  742:                 # encode foil separators
  743:                 push(@values,&HTML::Entities::encode($response->{$original_header},'&'));
  744:             } else {
  745:                 # A normal column
  746:                 push(@values,$response->{$original_header});
  747:             }
  748:         }
  749:     }
  750:     my $td = '<td valign="top">';
  751:     my $str = $td.join('</td>'.$td,@values).'</td>';
  752:     return $str;
  753: }
  754: 
  755: 
  756: #########################################################
  757: #########################################################
  758: ##
  759: ##    Excel Output Routines
  760: ##
  761: #########################################################
  762: #########################################################
  763: sub prepare_excel_output {
  764:     my ($r,$Problems,$Students,$anoncounter,$show_named) = @_;
  765:     my $c = $r->connection();
  766:     #
  767:     #
  768:     # Determine the number of columns in the spreadsheet
  769:     my $columncount = 3; # username, domain, id
  770:     my @extra_resp_headers = &get_extra_response_headers($show_named);
  771:     my $lastprob;
  772:     my %problem_analysis;
  773:     foreach my $prob (@$Problems) {
  774:         my $symb = $prob->symb();
  775:         my %analysis = &Apache::lonstathelpers::get_problem_data($prob->src);
  776:         $problem_analysis{$prob->src}=\%analysis;
  777:         foreach my $partid (@{$prob->parts}) {
  778:             if (($prob->is_anonsurvey($partid)) || ($anoncounter->{$symb."\0".$partid})) {
  779:                 next if ($show_named);
  780:             } else {
  781:                 next unless ($show_named);
  782:             }
  783: 
  784:             my $responses = [$prob->responseIds($partid)];
  785:             my $resptypes = [$prob->responseType($partid)];
  786:             for (my $i=0;$i<scalar(@$responses);$i++) {
  787:                 my @headers = &get_headers($prob,$partid,$responses->[$i],
  788:                                            $resptypes->[$i],
  789:                                            $problem_analysis{$prob->src},
  790:                                            'excel','display',
  791:                                            @extra_resp_headers);
  792:                 $columncount += scalar(@headers);
  793:             }
  794:         }
  795:         last if ($columncount > 255);
  796:         $lastprob = $prob;
  797:     }
  798:     if ($columncount > 255) {
  799:         $r->print('<p class="LC_error">'.&mt('Unable to complete request').'</p>'.$/.
  800:                   '<p class="LC_warning">'.&mt('LON-CAPA is unable to produce your Excel spreadsheet because your selections will result in more than 255 columns.  Excel allows only 255 columns in a spreadsheet.').'</p>'.$/.
  801:                   '<p class="LC_warning">'.&mt('Consider selecting fewer problems to generate reports on, or reducing the number of items per problem.  Or use HTML or CSV output.').'</p>'.$/);
  802:         if (ref($lastprob)) {
  803:             $r->print('<p>'.&mt('The last problem that will fit in the current spreadsheet is [_1].',$lastprob->compTitle).'</p>');
  804:         }
  805:         $r->rflush();
  806:         return;
  807:     }
  808:     #
  809:     # Print out a message telling them what we are doing
  810:     if (scalar(@$Problems) > 1) {
  811:         $r->print('<p class="LC_info">'.
  812:                   &mt('Preparing Excel spreadsheet of student responses to [_1] problems',
  813:                       scalar(@$Problems)).
  814:                   '</p>');
  815:     } else {
  816:         $r->print('<p class="LC_info">'.
  817:                   &mt('Preparing Excel spreadsheet of student responses').
  818:                   '</p>');
  819:     }
  820:     $r->rflush();
  821:     #
  822:     # Create the excel spreadsheet
  823:     my ($workbook,$filename,$format) = 
  824:         &Apache::loncommon::create_workbook($r);
  825:     return if (! defined($workbook));
  826: 
  827:     # Worksheet name
  828:     # The length of a worksheet name in Excel 95 is limited to 31 characters.
  829:     # Let's make sure to not exceed the maximum length in the translation files.
  830:     # Otherwise, no Excel file would be created.
  831:     my $worksheetname = &mt('Student Submission Data');
  832:     if (length($worksheetname) > 31) {
  833:         # nice way to cut off too long name
  834:         $worksheetname = substr($worksheetname,0,28,).'...';
  835:     }
  836:     my $worksheet  = $workbook->addworksheet($worksheetname);
  837:     #
  838:     # Add headers to the worksheet
  839:     my $rows_output = 0;
  840:     $worksheet->write($rows_output++,0,
  841:                     $env{'course.'.$env{'request.course.id'}.'.description'},
  842:                       $format->{'h1'});
  843:     $rows_output++;
  844:     my $cols_output = 0;
  845:     my $title_row  = $rows_output++;
  846:     my $partid_row = $rows_output++;
  847:     my $respid_row = $rows_output++;
  848:     my $header_row = $rows_output++;
  849:     $worksheet->write($title_row ,0,&mt('Problem Title'),$format->{'bold'});
  850:     $worksheet->write($partid_row,0,&mt('Part ID'),$format->{'bold'});
  851:     $worksheet->write($respid_row,0,&mt('Response ID'),$format->{'bold'});
  852:     # Student headers
  853:     my @StudentColumns = &get_student_columns($show_named);
  854:     foreach my $field (@StudentColumns) {
  855:         $worksheet->write($header_row,$cols_output++,&mt(ucfirst($field)),
  856:                           $format->{'bold'});
  857:     }
  858:     # Problem headers
  859:     my %start_col;
  860:     foreach my $prob (@$Problems) {
  861:         my $title = $prob->compTitle;
  862:         my $symb = $prob->symb();
  863:         $worksheet->write($title_row,$cols_output,
  864:                           $title,$format->{'h3'});
  865:         foreach my $partid (@{$prob->parts}) {
  866:             if (($prob->is_anonsurvey($partid)) || ($anoncounter->{$symb."\0".$partid})) {
  867:                 next if ($show_named);
  868:             } else {
  869:                 next unless ($show_named);
  870:             }
  871:             $worksheet->write($partid_row,$cols_output,
  872:                               $prob->part_display($partid));
  873:             my $responses = [$prob->responseIds($partid)];
  874:             my $resptypes = [$prob->responseType($partid)];
  875:             for (my $i=0;$i<scalar(@$responses);$i++) {
  876:                 $start_col{$prob->symb}->{$partid}->{$responses->[$i]}=
  877:                     $cols_output;
  878:                 $worksheet->write($respid_row,$cols_output,
  879:                                   $resptypes->[$i].', '.$responses->[$i]);
  880:                 my @headers = &get_headers($prob,$partid,$responses->[$i],
  881:                                            $resptypes->[$i],
  882:                                            $problem_analysis{$prob->src},
  883:                                            'excel','display',
  884:                                            @extra_resp_headers);
  885:                 foreach my $text (@headers) {
  886:                     if ($text eq 'Time') {
  887:                         $worksheet->set_column($cols_output,$cols_output,undef,
  888:                                                $format->{'date'});
  889:                     } 
  890:                     $worksheet->write($header_row,$cols_output++,$text);
  891:                 }
  892:             }
  893:         }
  894:     }
  895:     #
  896:     # Populate the worksheet with the student data
  897:     my %prog_state=&Apache::lonhtmlcommon::Create_PrgWin($r,scalar(@$Students));
  898:     my $max_row = $rows_output;
  899:     foreach my $student (@$Students) {
  900:         last if ($c->aborted());
  901:         $cols_output = 0;
  902:         my $student_row = $max_row;
  903:         foreach my $prob (@$Problems) {
  904:             my $symb = $prob->symb();
  905:             foreach my $partid (@{$prob->parts}) {
  906:                 if (($prob->is_anonsurvey($partid)) || ($anoncounter->{$symb."\0".$partid})) {
  907:                     next if ($show_named);
  908:                 } else {
  909:                     next unless ($show_named);
  910:                 }
  911:                 my @Response = $prob->responseIds($partid);
  912:                 my @ResponseType = $prob->responseType($partid);
  913:                 for (my $i=0;$i<=$#Response;$i++) {
  914:                     my $respid   = $Response[$i];
  915:                     my $resptype = $ResponseType[$i];
  916:                     my $results = 
  917:                         &Apache::loncoursedata::get_response_data_by_student
  918:                         ($student,$prob->symb(),$respid);
  919:                     my @headers = &get_headers($prob,$partid,$respid,
  920:                                                $resptype,
  921:                                                $problem_analysis{$prob->src},
  922:                                                'excel','normal',
  923:                                                @extra_resp_headers);
  924: 
  925:                     if (! defined($results)) {
  926:                         $results = [];
  927:                     }
  928:                     #
  929:                     $rows_output = $student_row;
  930:                     #
  931:                     my $response_start_col = $start_col{$prob->symb}->{$partid}->{$respid};
  932:                     for (my $j=scalar(@$results)-1;$j>=0;$j--) {
  933:                         $cols_output = $response_start_col;
  934:                         if ($env{'form.all_sub'} ne 'true') {
  935:                             next if ($j ne scalar(@$results)-1);
  936:                         }
  937:                         my $response = &hashify_response($results->[$j],
  938:                                                          $prob,
  939:                                                          $student,
  940:                                                          $partid,
  941:                                                          $respid);
  942:                         my @response_data = 
  943:                             &compile_response_data(\@headers,$response,
  944:                                                    $prob,$partid,$respid,
  945:                                                    $resptype,
  946:                                                    \&excel_format_item);
  947:                         $worksheet->write_row($rows_output++,$cols_output,
  948:                                               \@response_data);
  949:                         $cols_output+=scalar(@response_data);
  950:                         if ($rows_output > $max_row) {
  951:                             $max_row = $rows_output;
  952:                         }
  953:                     }
  954:                 }
  955:             }
  956:         }
  957:         # Prepend current student's user information to all rows  
  958:         for (my $row = $student_row;$row<$max_row;$row++) {
  959:             my $cols = 0;
  960:             foreach my $field (@StudentColumns) {
  961:                 if ($show_named) {
  962:                     my $value = $student->{$field};
  963:                     if ($field eq 'comments') {
  964:                         $value = &Apache::lonmsgdisplay::retrieve_instructor_comments
  965:                                  ($student->{'username'},$student->{'domain'});
  966:                     }
  967:                     $worksheet->write($row,$cols++,$value);
  968:                 } else {
  969:                     $worksheet->write($row,$cols++,
  970:                                       &mt('Anonymized'));
  971:                 }
  972:             }
  973:         }
  974:         &Apache::lonhtmlcommon::Increment_PrgWin($r,\%prog_state,'last student');
  975:     }
  976:     &Apache::lonhtmlcommon::Close_PrgWin($r,\%prog_state);
  977:     #
  978:     # Close the excel file
  979:     $workbook->close();
  980:     #
  981:     # Write a link to allow them to download it
  982:     $r->print('<p><a href="'.$filename.'">'.
  983:               &mt('Your Excel spreadsheet.').
  984:               '</a></p>'."\n");
  985:     $r->print('<script>'.
  986:               'window.document.Statistics.stats_status.value="'.
  987:               'Done compiling spreadsheet.  See link below to download.'.
  988:               '";</script>');
  989:     $r->rflush();
  990:     return;
  991: }
  992: 
  993: sub compile_response_data {
  994:     my ($headers,$response,$prob,$partid,$respid,$resptype,$format) = @_;
  995:     if (! ref($headers) || ref($headers) ne 'ARRAY' || ! scalar(@$headers)) {
  996:         return ();
  997:     }
  998:     if (ref($format) ne 'CODE') {
  999:         $format = sub { return $_[0]; };
 1000:     }
 1001:     #
 1002:     my $submission = 
 1003:         &HTML::Entities::decode
 1004:         (&unescape($response->{'Submission'}));
 1005:     if (!$prob->is_task()) {
 1006: 	return () if (! defined($submission) || $submission eq '');
 1007:     }
 1008:     $submission =~ s/\\\"/\"/g;
 1009:     $submission =~ s/\\\'/\'/g;
 1010:     if ($resptype eq 'radiobutton') {
 1011:         $submission =~ s/=([^=])$//;
 1012:     }
 1013:     $response->{'Submission'} = $submission;
 1014:     #
 1015:     my @values;
 1016:     if ($resptype =~ /^(option|match|rank)$/) {
 1017:         my %submission = 
 1018:             map { 
 1019:                 my ($foil,$value) = split('=',&unescape($_));
 1020:                 ($foil,$value);
 1021:             } split('&',$response->{'Submission'});
 1022:         my %correct;
 1023:         if (exists($response->{'Correct'})) {
 1024:             %correct = 
 1025:                 map { 
 1026:                     my ($foil,$value)=split('=',&unescape($_));
 1027:                     ($foil,$value);
 1028:                 } split('&',$response->{'Correct'});
 1029:         }
 1030:         #
 1031:         foreach my $original_header (@$headers) {
 1032:             if ($original_header =~ /^_/) {
 1033:                 # '_' denotes a foil column
 1034:                 my ($header) = ($original_header =~ m/^_(.*)$/);
 1035:                 my $option = '';
 1036:                 if ( my ($foil) = ($header =~ /(.*) Correct$/)) {
 1037:                     if (exists($correct{$foil})) {
 1038:                         $option = $correct{$foil};
 1039:                     }
 1040:                 } elsif (exists($submission{$header})) {
 1041:                     $option = $submission{$header};
 1042:                 }
 1043:                 push(@values,&{$format}($option,$header));
 1044:             } else {
 1045:                 # A normal column
 1046:                 push(@values,&{$format}($response->{$original_header},
 1047:                                         $original_header));
 1048:             }
 1049:         }
 1050:     } else {
 1051:         @values = map { &{$format}($response->{$_},$_); } @$headers;
 1052:     }
 1053:     return @values;
 1054: }
 1055: 
 1056: sub excel_format_item {
 1057:     my ($item,$type) = @_;
 1058:     if ($type eq 'Time') {
 1059:         $item = &Apache::lonstathelpers::calc_serial($item);
 1060:     } else {
 1061:         if ($item =~ m/^=/) {
 1062:             $item = ' '.$item;
 1063:         }
 1064:         $item =~ s/\\r//g;
 1065:         $item =~ s/\\n/\n/g;
 1066:         $item =~ s/(\s*$|^\s*)//g;
 1067:         $item =~ s/\\\'/\'/g;
 1068:     }
 1069:     return $item;
 1070: }
 1071: 
 1072: #########################################################
 1073: #########################################################
 1074: ##
 1075: ##      CSV output of student answers
 1076: ##
 1077: #########################################################
 1078: #########################################################
 1079: sub prepare_csv_output {
 1080:     my ($r,$problems,$students,$anoncounter,$show_named) = @_;
 1081:     my $c = $r->connection();
 1082:     #
 1083:     $r->print('<p class="LC_info">'.
 1084:               &mt('Generating CSV report of student responses').'</p>');
 1085:     #
 1086:     # Progress window
 1087:     my %prog_state=&Apache::lonhtmlcommon::Create_PrgWin($r,scalar(@$students));
 1088:     
 1089:     $r->rflush();
 1090:     #
 1091:     # Open a file
 1092:     my $outputfile;
 1093:     my $filename = '/prtspool/'.
 1094:         $env{'user.name'}.'_'.$env{'user.domain'}.'_'.
 1095:             time.'_'.rand(1000000000).'.csv';
 1096:     unless ($outputfile = Apache::File->new('>/home/httpd'.$filename)) {
 1097:         $r->log_error("Couldn't open $filename for output $!");
 1098:         $r->print(
 1099:             '<p class="LC_error">'
 1100:            .&mt('Problems occurred in writing the CSV file.')
 1101:            .' '.&mt('This error has been logged.')
 1102:            .' '.&mt('Please alert your LON-CAPA administrator.')
 1103:            .'</p>'
 1104:         );
 1105:         $outputfile = undef;
 1106:     }
 1107:     #
 1108:     # Compute the number of columns per response
 1109:     my @extra_resp_headers = &get_extra_response_headers($show_named);
 1110:     #
 1111:     # Create the table header
 1112:     my @student_columns = &get_student_columns($show_named);
 1113:     my $student_column_count = scalar(@student_columns);
 1114:     #
 1115:     my %headers;
 1116:     push(@{$headers{'student'}},@student_columns);
 1117:     # Pad for the student data
 1118:     foreach my $row ('problem','part','response') {
 1119:         $headers{$row}=[map {''} @student_columns];
 1120:     }
 1121:     #
 1122:     # we put the headers into the %headers hash
 1123:     my %problem_analysis;
 1124:     my %start_col;
 1125:     my $max_column = $student_column_count;
 1126:     foreach my $prob (@$problems) {
 1127:         my $symb = $prob->symb();
 1128:         my %analysis = &Apache::lonstathelpers::get_problem_data($prob->src);
 1129:         $problem_analysis{$prob->src}=\%analysis;
 1130:         $headers{'problem'}->[$max_column] = $prob->compTitle;
 1131:         foreach my $partid (@{$prob->parts}) {
 1132:             if (($prob->is_anonsurvey($partid)) || ($anoncounter->{$symb."\0".$partid})) {
 1133:                 next if ($show_named);
 1134:             } else {
 1135:                 next unless ($show_named);
 1136:             }
 1137:             $headers{'part'}->[$max_column] = $prob->part_display($partid);
 1138:             my $responses = [$prob->responseIds($partid)];
 1139:             my $resptypes = [$prob->responseType($partid)];
 1140:             for (my $i=0;$i<scalar(@$responses);$i++) {
 1141:                 my @headers = &get_headers($prob,$partid,$responses->[$i],
 1142:                                            $resptypes->[$i],
 1143:                                            $problem_analysis{$prob->src},
 1144:                                            'csv','display',
 1145:                                            @extra_resp_headers);
 1146:                 $start_col{$prob->symb}->{$partid}->{$responses->[$i]}=
 1147:                     $max_column;
 1148:                 $headers{'response'}->[$max_column]=
 1149:                     &mt('Response [_1]',$responses->[$i]);
 1150:                 for (my $j=0;$j<=$#headers;$j++) {
 1151:                     $headers{'student'}->[$max_column+$j]=$headers[$j];
 1152:                 }
 1153:                 $max_column += scalar(@headers);
 1154:             }
 1155:         }
 1156:     }
 1157:     foreach my $row ('problem','part','response','student') {
 1158:         print $outputfile '"'.
 1159:             join('","',
 1160:                  map { 
 1161:                      &Apache::loncommon::csv_translate($_); 
 1162:                  } @{$headers{$row}}).'"'.$/;
 1163:     }
 1164:     #
 1165:     # Main loop
 1166:     foreach my $student (@$students) {
 1167:         last if ($c->aborted());
 1168:         my @rows;
 1169:         foreach my $prob (@$problems) {
 1170:             my $symb = $prob->symb;
 1171:             foreach my $partid (@{$prob->parts}) {
 1172:                 if (($prob->is_anonsurvey($partid)) || ($anoncounter->{$symb."\0".$partid})) {
 1173:                     next if ($show_named); 
 1174:                 } else {
 1175:                     next unless ($show_named);
 1176:                 }
 1177:                 my @responses = $prob->responseIds($partid);
 1178:                 my @response_type = $prob->responseType($partid);
 1179:                 for (my $i=0;$i<=$#responses;$i++) {
 1180:                     my $respid   = $responses[$i];
 1181:                     my $resptype = $response_type[$i];
 1182:                     my @headers = &get_headers($prob,$partid,$respid,$resptype,
 1183:                                                $problem_analysis{$prob->src},
 1184:                                                'csv','normal',
 1185:                                                @extra_resp_headers);
 1186:                     my $results = 
 1187:                         &Apache::loncoursedata::get_response_data_by_student
 1188:                         ($student,$prob->symb(),$respid);
 1189:                     if (! defined($results)) {
 1190:                         $results = [];
 1191:                     }
 1192:                     for (my $j=0; $j<scalar(@$results);$j++) {
 1193:                         if ($env{'form.all_sub'} ne 'true') {
 1194:                             next if ($j != 0);
 1195:                         }
 1196:                         my $idx = scalar(@$results) - $j - 1;
 1197:                         my $response = &hashify_response($results->[$idx],
 1198:                                                          $prob,$student,
 1199:                                                          $partid,$respid);
 1200:                         my @data = &compile_response_data(\@headers,$response,
 1201:                                                           $prob,$partid,
 1202:                                                           $respid,$resptype,
 1203:                                                           \&csv_format_item);
 1204:                         my $resp_start_idx =
 1205:                             $start_col{$prob->symb}->{$partid}->{$respid};
 1206:                         for (my $k=0;$k<=$#data;$k++) {
 1207:                             $rows[$j]->[$resp_start_idx + $k] = $data[$k];
 1208:                         }
 1209:                     }
 1210:                 }
 1211:             }
 1212:         }
 1213:         foreach my $row (@rows) {
 1214:             my $student_row_data = '';
 1215:             if ($show_named) {
 1216:                 foreach my $field (@student_columns) {
 1217:                     my $value = $student->{$field};
 1218:                     if ($field eq 'comments') {
 1219:                         $value = &Apache::lonmsgdisplay::retrieve_instructor_comments
 1220:                                  ($student->{'username'},$student->{'domain'});
 1221:                     }
 1222:                     $student_row_data .= '"'.&Apache::loncommon::csv_translate($value).'",';
 1223:                 }
 1224:                 $student_row_data =~ s/,$//;
 1225:             } else {
 1226:                 $student_row_data = '"'.&mt('Anonymized').'"';
 1227:             }
 1228:             print $outputfile $student_row_data;
 1229:             for (my $i=$student_column_count;$i<$max_column;$i++) {
 1230:                 my $value = &Apache::loncommon::csv_translate($row->[$i]);
 1231:                 $value ||='';
 1232:                 print $outputfile ',"'.$value.'"';
 1233:             }
 1234:             print $outputfile $/;
 1235:         }
 1236:         undef(@rows);
 1237:         &Apache::lonhtmlcommon::Increment_PrgWin($r,\%prog_state,'last student');
 1238:     }
 1239:     close($outputfile);
 1240:     #
 1241:     # Close the progress window
 1242:     &Apache::lonhtmlcommon::Close_PrgWin($r,\%prog_state);
 1243:     #
 1244:     # Tell the user where to get their CSV file
 1245:     $r->print('<br />'.
 1246:               '<a href="'.$filename.'">'.&mt('Your CSV file.').'</a>'."\n");
 1247:     $r->rflush();
 1248:     return;
 1249: }
 1250: 
 1251: sub csv_format_item {
 1252:     my ($item,$type) = @_;
 1253:     if ($type eq 'Time') {
 1254:         $item = &Apache::lonlocal::locallocaltime($item);
 1255:     }
 1256:     $item =&Apache::loncommon::csv_translate($item); 
 1257:     return $item;
 1258: }
 1259: 
 1260: #########################################################
 1261: #########################################################
 1262: ##
 1263: ##   Generic Interface Routines
 1264: ##
 1265: #########################################################
 1266: #########################################################
 1267: sub CreateInterface {
 1268:     ##
 1269:     ## Output Selection
 1270:     my $output_selector = $/.'<select name="output">'.$/;
 1271:     foreach ('HTML','Excel','CSV') {
 1272:         $output_selector .= '    <option value="'.lc($_).'"';
 1273:         if ($env{'form.output'} eq lc($_)) {
 1274:             $output_selector .= ' selected="selected"';
 1275:         }
 1276:         $output_selector .='>'.&mt($_).'</option>'.$/;
 1277:     } 
 1278:     $output_selector .= '</select>'.$/;
 1279:     ##
 1280:     ## Environment variable initialization
 1281:     my $Str = '';
 1282:     $Str .= '<br />';
 1283:     $Str .= &Apache::loncommon::start_data_table();
 1284:     $Str .= &Apache::loncommon::start_data_table_header_row();
 1285:     $Str .= '<th>'.&mt('Sections').'</th>';
 1286:     $Str .= '<th>'.&mt('Groups').'</th>';
 1287:     $Str .= '<th>'.&mt('Student Data').&Apache::loncommon::help_open_topic("Chart_Student_Data").'</th>';
 1288:     $Str .= '<th>'.&mt('Access Status').'</th>';
 1289:     $Str .= '<th>'.&mt('Options').'</th>';
 1290:     $Str .= '<th>'.&mt('Output Format').'</th>';
 1291:     $Str .= &Apache::loncommon::end_data_table_header_row();
 1292:     #
 1293:     $Str .= &Apache::loncommon::start_data_table_row();
 1294:     $Str .= '<td align="center">'."\n";
 1295:     $Str .= &Apache::lonstatistics::SectionSelect('Section','multiple',5);
 1296:     $Str .= '</td>';
 1297:     #
 1298:     $Str .= '<td align="center">'."\n";
 1299:     $Str .= &Apache::lonstatistics::GroupSelect('Group','multiple',5);
 1300:     $Str .= '</td>';
 1301:     #
 1302:     $Str .= '<td align="center">'."\n";
 1303:     $Str .= &Apache::lonstatistics::StudentDataSelect('StudentData','multiple', 5,undef);
 1304:     $Str .= '</td>';
 1305:     #
 1306:     $Str .= '<td align="center">';
 1307:     $Str .= &Apache::lonhtmlcommon::StatusOptions(undef,undef,5);
 1308:     $Str .= '</td>';
 1309:     #
 1310:     # Render problem checkbox
 1311:     my $prob_checkbox = '<input type="checkbox" name="renderprob" ';
 1312:     if (exists($env{'form.renderprob'}) && $env{'form.renderprob'} eq 'true') {
 1313:         $prob_checkbox .= 'checked="checked" ';
 1314:     }
 1315:     $prob_checkbox .= 'value="true" />';
 1316:     #
 1317:     # Compute correct answers checkbox
 1318:     my $ans_checkbox = '<input type="checkbox" name="correctans" ';
 1319:     if (exists($env{'form.correctans'}) && $env{'form.correctans'} eq 'true') {
 1320:         $ans_checkbox .= 'checked="checked" ';
 1321:     }
 1322:     $ans_checkbox .= 'value="true" />';
 1323:     #
 1324:     # Show all submissions checkbox
 1325:     my $all_sub_checkbox = '<input type="checkbox" name="all_sub" ';
 1326:     if (exists($env{'form.all_sub'}) && 
 1327:         $env{'form.all_sub'} eq 'true') {
 1328:         $all_sub_checkbox .= 'checked="checked" ';
 1329:     }
 1330:     $all_sub_checkbox.= 'value="true" />';
 1331:     #
 1332:     # problem status checkbox
 1333:     my $prob_status_checkbox = '<input type="checkbox" name="prob_status" ';
 1334:     if (exists($env{'form.prob_status'}) && 
 1335:         $env{'form.prob_status'} eq 'true') {
 1336:         $prob_status_checkbox .= 'checked="checked" ';
 1337:     }
 1338:     $prob_status_checkbox .= 'value="true" />';
 1339:     #
 1340:     $Str .=
 1341:         '<td valign="top">'
 1342:        .'<label>'
 1343:        .$prob_checkbox.&mt('Show problem')
 1344:        .'</label><br />'
 1345:        .'<label>'
 1346:        .' '.$ans_checkbox.&mt('Show correct answers')
 1347:        .'</label><br />'
 1348:        .'<label>'
 1349:        .$all_sub_checkbox.&mt('Show all submissions')
 1350:        .'</label><br />'
 1351:        .'<label>'
 1352:        .$prob_status_checkbox.&mt('Show problem grading')
 1353:        .'</label>'
 1354:        .'</td>';
 1355:     #
 1356:     $Str .= '<td align="center" valign="top">'.$output_selector.'</td>';
 1357:     #
 1358:     $Str .= &Apache::loncommon::end_data_table_row();
 1359:     $Str .= &Apache::loncommon::end_data_table();
 1360:     #
 1361:     return $Str;
 1362: }
 1363: 
 1364: sub get_student_columns {
 1365:     my ($show_named) = @_; 
 1366:     my @student_columns;
 1367:     if ($show_named) {
 1368:         @student_columns = @Apache::lonstatistics::SelectedStudentData;
 1369:         if (grep(/^all$/,@student_columns)) {
 1370:             @student_columns = qw(fullname username domain id section status groups comments);
 1371:         }
 1372:     } else {
 1373:         @student_columns = ('username');
 1374:     }
 1375:     return @student_columns;
 1376: } 
 1377: 
 1378: 1;
 1379: 
 1380: __END__

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