Annotation of loncom/interface/statistics/lonstudentsubmissions.pm, revision 1.62

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

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
500 Internal Server Error

Internal Server Error

The server encountered an internal error or misconfiguration and was unable to complete your request.

Please contact the server administrator at root@localhost to inform them of the time this error occurred, and the actions you performed just before this error.

More information about this error may be available in the server error log.