File:  [LON-CAPA] / loncom / interface / statistics / lonstudentsubmissions.pm
Revision 1.71: download - view: text, annotated - select for diffs
Fri Mar 28 15:07:01 2014 UTC (10 years, 3 months ago) by bisitz
Branches: MAIN
CVS tags: version_2_12_X, HEAD
Hints for bug #6700

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

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