Annotation of loncom/interface/statistics/lonstathelpers.pm, revision 1.77

1.1       matthew     1: # The LearningOnline Network with CAPA
                      2: #
1.77    ! raeburn     3: # $Id: lonstathelpers.pm,v 1.76 2020/08/26 18:13:39 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: ####################################################
                     28: ####################################################
                     29: 
                     30: =pod
                     31: 
                     32: =head1 NAME
                     33: 
                     34: Apache::lonstathelpers - helper routines used by statistics
                     35: 
                     36: =head1 SYNOPSIS
                     37: 
                     38: This module provides a place to consolidate much of the statistics 
                     39: routines that are needed across multiple statistics functions.
                     40: 
                     41: =head1 OVERVIEW
                     42: 
                     43: =over 4
                     44: 
                     45: =cut
                     46: 
                     47: ####################################################
                     48: ####################################################
                     49: package Apache::lonstathelpers;
                     50: 
                     51: use strict;
1.46      albertel   52: use Apache::lonnet;
1.1       matthew    53: use Apache::loncommon();
                     54: use Apache::lonhtmlcommon();
                     55: use Apache::loncoursedata();
                     56: use Apache::lonstatistics;
                     57: use Apache::lonlocal;
                     58: use HTML::Entities();
                     59: use Time::Local();
                     60: use Spreadsheet::WriteExcel();
1.8       matthew    61: use GDBM_File;
                     62: use Storable qw(freeze thaw);
1.53      www        63: use lib '/home/httpd/lib/perl/';
                     64: use LONCAPA;
                     65:  
1.1       matthew    66: 
                     67: ####################################################
                     68: ####################################################
                     69: 
                     70: =pod
                     71: 
                     72: =item &render_resource($resource)
                     73: 
1.42      matthew    74: Input: a navmaps resource
1.1       matthew    75: 
                     76: Retunrs: a scalar containing html for a rendering of the problem
                     77: within a table.
                     78: 
                     79: =cut
                     80: 
                     81: ####################################################
                     82: ####################################################
                     83: sub render_resource {
                     84:     my ($resource) = @_;
                     85:     ##
                     86:     ## Render the problem
1.43      matthew    87:     my ($base) = ($resource->src =~ m|^(.*/)[^/]*$|);
                     88:     $base="http://".$ENV{'SERVER_NAME'}.$base;
1.55      raeburn    89:     my ($src,$symb)=($resource->link,&escape($resource->shown_symb));
1.40      matthew    90:     my $rendered_problem = &Apache::lonnet::ssi_body($src.'?symb='.$symb);
1.1       matthew    91:     $rendered_problem =~ s/<\s*form\s*/<nop /g;
                     92:     $rendered_problem =~ s|(<\s*/form\s*>)|<\/nop>|g;
1.70      golterma   93:     return '<div class="LC_Box">'.
                     94:         '<h4 class="LC_hcell">'.&mt('Problem').'</h4>'.
                     95:         '<base href="'.$base.'" />'.$rendered_problem.
                     96:         '</div>';
1.1       matthew    97: }
1.2       matthew    98: 
                     99: ####################################################
                    100: ####################################################
                    101: 
                    102: =pod
                    103: 
1.40      matthew   104: =item &get_resources
                    105: 
                    106: =cut
                    107: 
                    108: ####################################################
                    109: ####################################################
                    110: sub get_resources {
1.75      raeburn   111:     my ($navmap,$sequence,$include_tools) = @_;
                    112:     my @resources;
                    113:     if ($include_tools) {
                    114:         @resources = $navmap->retrieveResources($sequence,
                    115:                                                 sub { shift->is_gradable(); },
                    116:                                                 0,0,0);
                    117:     } else {
                    118:         @resources = $navmap->retrieveResources($sequence,
                    119:                                                 sub { shift->is_problem(); },
                    120:                                                 0,0,0);
                    121:     }
1.40      matthew   122:     return @resources;
                    123: }
                    124: 
                    125: ####################################################
                    126: ####################################################
                    127: 
                    128: =pod
                    129: 
                    130: =item &problem_selector($AcceptedResponseTypes)
1.2       matthew   131: 
                    132: Input: scalar containing regular expression which matches response
                    133: types to show.  '.' will yield all, '(option|radiobutton)' will match
                    134: all option response and radiobutton problems.
                    135: 
                    136: Returns: A string containing html for a table which lists the sequences
                    137: and their contents.  A radiobutton is provided for each problem.
1.14      matthew   138: Skips 'survey' problems.
1.2       matthew   139: 
                    140: =cut
                    141: 
                    142: ####################################################
                    143: ####################################################
1.40      matthew   144: sub problem_selector {
1.76      raeburn   145:     my ($AcceptedResponseTypes,$sequence_addendum,$symbmode,$all,$prefix,
                    146:         $byres,$include_tools,$smallbox,$onclick) = @_;
1.65      www       147: # all: also make sequences selectable
                    148: # prefix: prefix for all form names
1.76      raeburn   149: # byres: radiobutton shown per resource
                    150: # include_tools: external tools included 
1.65      www       151: # smallbox: use smaller box
                    152: # onclick: javascript to execute when clicked
1.2       matthew   153:     my $Str;
1.65      www       154:     my $jsadd='';
                    155:     if ($onclick) {
1.71      bisitz    156:         $jsadd="onclick='$onclick'";
1.65      www       157:     }
1.66      www       158:     $Str =  &Apache::loncommon::start_scrollbox(($smallbox?'420px':'620px'),
                    159:                                                 ($smallbox?'400px':'600px'),
                    160:                                                 ($smallbox?'60px':'300px')).
1.65      www       161:             &Apache::loncommon::start_data_table();
1.27      matthew   162:     my $rb_count =0;
1.40      matthew   163:     my ($navmap,@sequences) = 
                    164:         &Apache::lonstatistics::selected_sequences_with_assessments('all');
                    165:     return $navmap if (! ref($navmap)); # error
                    166:     foreach my $seq (@sequences) {
1.2       matthew   167:         my $seq_str = '';
1.75      raeburn   168:         foreach my $res (&get_resources($navmap,$seq,$include_tools)) {
1.77    ! raeburn   169:             if ($res->src() eq '/res/lib/templates/simpleproblem.problem') {
        !           170:                 next if (grep(/^placeholder$/,@{$res->parts}));
        !           171:             }
1.76      raeburn   172:             my $title = $res->compTitle;
                    173:             if (! defined($title) || $title eq '') {
                    174:                 ($title) = ($res->src =~ m:/([^/]*)$:);
                    175:             }
                    176:             my $totalresps = 0;
                    177:             if ($byres) {
                    178:                 foreach my $part (@{$res->parts}) {
                    179:                     $totalresps += scalar($res->responseIds($part));
                    180:                 }
                    181:                 my $value = &HTML::Entities::encode($res->symb(),'<>&"');
                    182:                 my $checked;
                    183:                 if ($env{'form.problemchoice'} eq $res->symb()) {
                    184:                     $checked = ' checked="checked"';
                    185:                 }
1.77    ! raeburn   186:                 my $rowspan;
        !           187:                 if ($totalresps > 1) {
        !           188:                     $rowspan = ' rowspan="'.$totalresps.'"';
        !           189:                 }
1.76      raeburn   190:                 $seq_str .= &Apache::loncommon::start_data_table_row().
1.77    ! raeburn   191:                             '<td'.$rowspan.' style="vertical-align:middle">'.
1.76      raeburn   192:                             '<label><input type="radio" name="symb" value="'.$value.'"'.$checked.' />'.
                    193:                             $title.'</label>';
                    194:                 my $link = $res->link.'?symb='.&escape($res->shown_symb);
                    195:                 $seq_str .= ('&nbsp;'x2).
                    196:                             '<a target="preview" href="'.$link.'">'.&mt('view').'</a></td>';
                    197:             }
                    198:             my %partsseen;
1.40      matthew   199:             foreach my $part (@{$res->parts}) {
1.75      raeburn   200:                 my (@response_ids,@response_types);
                    201:                 if ($res->is_tool) {
                    202:                     @response_ids = ();
                    203:                     @response_types = ('tool');
                    204:                 } else {
                    205:                     @response_ids   = $res->responseIds($part);
                    206:                     @response_types = $res->responseType($part);
                    207:                 }
1.40      matthew   208:                 for (my $i=0;$i<scalar(@response_types);$i++){
                    209:                     my $respid = $response_ids[$i];
                    210:                     my $resptype = $response_types[$i];
1.2       matthew   211:                     if ($resptype =~ m/$AcceptedResponseTypes/) {
1.76      raeburn   212:                         if ($byres) {
                    213:                             unless (exists($partsseen{$part})) {
                    214:                                 my $parttitle = $part;
                    215:                                 if ($part eq '0') {
                    216:                                     $parttitle = '';
                    217:                                 }
                    218:                                 if ($parttitle ne '') {
                    219:                                     $parttitle = ('&nbsp;'x2).&mt('part').':&nbsp;'.$parttitle;
                    220:                                 }
                    221:                                 if (keys(%partsseen)) {
                    222:                                     $seq_str .= &Apache::loncommon::continue_data_table_row();
                    223:                                 }
                    224:                                 unless ($partsseen{$part}) {
                    225:                                     $seq_str .= '<td rowspan="'.scalar(@response_ids).'" style="vertical-align:middle">'.
                    226:                                                 $parttitle.'</td>';
                    227:                                     $partsseen{$part} = scalar(@response_ids);
                    228:                                 }
                    229:                             }
                    230:                             $seq_str .= '<td>'.$resptype;
                    231:                             if (scalar(@response_ids) > 1) {
                    232:                                 $seq_str .= '&nbsp;'.&mt('id').':&nbsp;'.$respid;
                    233:                             }
                    234:                             $seq_str .= '</td>'. &Apache::loncommon::end_data_table_row()."\n";
                    235:                         } else {
                    236:                             my $value = &make_target_id({symb=>$res->symb,
                    237:                                                          part=>$part,
                    238:                                                          respid=>$respid,
                    239:                                                          resptype=>$resptype});
                    240:                             my $checked = '';
                    241:                             if ($env{'form.problemchoice'} eq $value) {
                    242:                                 $checked = ' checked="checked"';
                    243:                             }
                    244:                             $seq_str .= &Apache::loncommon::start_data_table_row().
                    245:                                 ($symbmode?
                    246:                                  '<td><input type="radio" id="'.$prefix.$rb_count.'" name="'.$prefix.'symb" value="'.&HTML::Entities::encode($res->symb,'<>&"').'" '.$checked.' '.
                    247:                                  $jsadd.
                    248:                                  ' /></td>'
                    249:                                  :qq{<td><input type="radio" id="$rb_count" name="problemchoice" value="$value"$checked /></td>}).
                    250:                                 '<td><label for="'.$prefix.$rb_count.'">'.$resptype.'</label></td>'.
                    251:                                 '<td><label for="'.$prefix.$rb_count.'">'.$title.'</label>';
                    252:                             if (scalar(@response_ids) > 1) {
                    253:                                 $seq_str .= &mt('response').' '.$respid;
                    254:                             }
                    255:                             my $link = $res->link.'?symb='.&escape($res->shown_symb);
                    256:                             $seq_str .= ('&nbsp;'x2).
                    257:                                         '<a target="preview" href="'.$link.'">'.&mt('view').'</a>';
                    258:                             $seq_str .= "</td>". &Apache::loncommon::end_data_table_row()."\n";
                    259:                             $rb_count++;
1.2       matthew   260:                         }
                    261:                     }
                    262:                 }
                    263:             }
                    264:         }
                    265:         if ($seq_str ne '') {
1.76      raeburn   266:             if ($byres) {
1.61      www       267:                 $Str .= &Apache::loncommon::start_data_table_header_row().
1.76      raeburn   268:                         '<th colspan="3">'.$seq->compTitle.'</th>'.
                    269:                         &Apache::loncommon::end_data_table_header_row().
                    270:                         $seq_str;
                    271:             } else {
                    272:                 $Str .= &Apache::loncommon::start_data_table_header_row().
                    273:                     '<th colspan="3">'.
                    274:                     ($all?'<input type="radio" id="'.$prefix.'s'.$rb_count.'" name="'.$prefix.'symb" value="'.&HTML::Entities::encode($seq->symb,'<>&').'" '.$jsadd.' />':'').
                    275:                     $seq->compTitle.'</th>'.
                    276:                     &Apache::loncommon::end_data_table_header_row()."\n".$seq_str;
                    277:                 if (defined($sequence_addendum)) {
                    278:                     $Str .= &Apache::loncommon::start_data_table_header_row().
                    279:                         ('<td>&nbsp;</td>'x2).
                    280:                         '<td align="right">'.$sequence_addendum.'</td>'.
                    281:                         &Apache::loncommon::end_data_table_header_row()."\n";
                    282:                 }
1.50      matthew   283:             }
1.2       matthew   284:         }
                    285:     }
1.64      www       286:     $Str .= &Apache::loncommon::end_data_table().&Apache::loncommon::end_scrollbox()."\n";
1.2       matthew   287:     return $Str;
                    288: }
                    289: 
                    290: ####################################################
                    291: ####################################################
                    292: 
                    293: =pod
                    294: 
1.24      matthew   295: =item &MultipleProblemSelector($navmap,$selected,$inputname)
1.21      matthew   296: 
                    297: Generate HTML with checkboxes for problem selection.
                    298: 
                    299: Input: 
                    300: 
                    301: $navmap: a navmap object.  If undef, navmaps will be called to create a
                    302: new object.
                    303: 
                    304: $selected: Scalar, Array, or hash reference of currently selected items.
                    305: 
                    306: $inputname: The name of the form elements to use for the checkboxs.
                    307: 
                    308: Returns: A string containing html for a table which lists the sequences
                    309: and their contents.  A checkbox is provided for each problem.
                    310: 
                    311: =cut
                    312: 
                    313: ####################################################
                    314: ####################################################
                    315: sub MultipleProblemSelector {
1.63      raeburn   316:     my ($navmap,$inputname,$formname,$anoncounter)=@_;
1.46      albertel  317:     my $cid = $env{'request.course.id'};
1.21      matthew   318:     my $Str;
                    319:     # Massage the input as needed.
                    320:     if (! defined($navmap)) {
                    321:         $navmap = Apache::lonnavmaps::navmap->new();
                    322:         if (! defined($navmap)) {
1.56      bisitz    323:             $Str .= '<div class="LC_error">'
                    324:                    .&mt('Error: cannot process course structure')
                    325:                    .'</div>';
1.21      matthew   326:             return $Str;
                    327:         }
                    328:     }
                    329:     my $selected = {map { ($_,1) } (&get_selected_symbs($inputname))};
                    330:     # Header
                    331:     $Str .= <<"END";
1.58      bisitz    332: <script type="text/javascript" language="JavaScript">
1.25      matthew   333:     function checkall(value,seqid) {
1.21      matthew   334:         for (i=0; i<document.forms.$formname.elements.length; i++) {
                    335:             ele = document.forms.$formname.elements[i];
                    336:             if (ele.name == '$inputname') {
1.25      matthew   337:                 if (seqid != null) {
                    338:                     itemid = document.forms.$formname.elements[i].id;
                    339:                     thing = itemid.split(':');
                    340:                     if (thing[0] == seqid) {
                    341:                         document.forms.$formname.elements[i].checked=value;
                    342:                     }
                    343:                 } else {
                    344:                     document.forms.$formname.elements[i].checked=value;
                    345:                 }
1.21      matthew   346:             }
                    347:         }
                    348:     }
                    349: </script>
                    350: END
1.63      raeburn   351:     my $checkanonjs = <<"END";
                    352:  
                    353: <script type="text/javascript" language="JavaScript">
                    354:     function checkanon() {
                    355:         return true;
                    356:     }
                    357: </script>
                    358: 
                    359: END
                    360:     if (ref($anoncounter) eq 'HASH') {
                    361:         if (keys(%{$anoncounter}) > 0) {
1.74      damieng   362:             my $anonwarning = &mt('Your selection includes both problems with and without anonymous submissions.')."\n".&mt('You must select either only anonymous or only named problems.')."\n\n".&mt('If a selection contains both anonymous and named parts,[_1]use the Anonymous/Named buttons to ensure selections will be either all anonymous[_1]or all named.',"\n");
                    363:             &js_escape(\$anonwarning);
1.63      raeburn   364:             $checkanonjs = <<"END";
                    365: 
                    366: <script type="text/javascript" language="JavaScript">
                    367:     function checkanon() {
                    368:         anoncount = 0;
                    369:         namedcount = 0;
                    370:         for (i=0; i<document.forms.$formname.elements.length; i++) {
                    371:             ele = document.forms.$formname.elements[i];
                    372:             if (ele.name == '$inputname') {
                    373:                 itemid = document.forms.$formname.elements[i].id;
                    374:                 if (document.forms.$formname.elements[i].checked) {
                    375:                     anonid = 'anonymous_'+itemid;
                    376:                     mixid = 'mixed_'+itemid;
                    377:                     anonele = document.getElementById(anonid);
                    378:                     mixele = document.getElementById(mixid);
                    379:                     if (anonele.value > 0) {
                    380:                         if (mixele.value == 'none') {
                    381:                             anoncount ++;
                    382:                         } else {
                    383:                             if (mixele.value == '0') {
                    384:                                 if (mixele.checked) {
                    385:                                     anoncount ++; 
                    386:                                 } else {
                    387:                                     namedcount ++;
                    388:                                 } 
                    389:                             } else {
                    390:                                 namedcount ++;
                    391:                             }
                    392:                         }
                    393:                     } else {
                    394:                         namedcount ++;
                    395:                     }
                    396:                 }
                    397:             }
                    398:         }
                    399:         if (anoncount > 0 && namedcount > 0) {
                    400:             alert("$anonwarning");
                    401:             return false;
                    402:         } 
                    403:     }
                    404: </script>
                    405: 
                    406: END
                    407:         }
                    408:     }
                    409:     $Str .= $checkanonjs.
1.21      matthew   410:         '<a href="javascript:checkall(true)">'.&mt('Select All').'</a>'.
                    411:         ('&nbsp;'x4).
                    412:         '<a href="javascript:checkall(false)">'.&mt('Unselect All').'</a>';
                    413:     $Str .= $/.'<table>'.$/;
                    414:     my $iterator = $navmap->getIterator(undef, undef, undef, 1);
                    415:     my $sequence_string;
1.25      matthew   416:     my $seq_id = 0;
1.46      albertel  417:     my @Accumulator = (&new_accumulator($env{'course.'.$cid.'.description'},
1.21      matthew   418:                                         '',
                    419:                                         '',
1.25      matthew   420:                                         $seq_id++,
1.21      matthew   421:                                         $inputname));
                    422:     my @Sequence_Data;
                    423:     while (my $curRes = $iterator->next()) {
                    424:         if ($curRes == $iterator->END_MAP) {
                    425:             if (ref($Accumulator[-1]) eq 'CODE') {
1.24      matthew   426:                 my $old_accumulator = pop(@Accumulator);
                    427:                 push(@Sequence_Data,&{$old_accumulator}());
1.21      matthew   428:             }
                    429:         } elsif ($curRes == $iterator->BEGIN_MAP) {
                    430:             # Not much to do here.
                    431:         }
                    432:         next if (! ref($curRes));
                    433:         if ($curRes->is_map) {
1.24      matthew   434:             push(@Accumulator,&new_accumulator($curRes->compTitle,
1.21      matthew   435:                                                $curRes->src,
                    436:                                                $curRes->symb,
1.25      matthew   437:                                                $seq_id++,
1.21      matthew   438:                                                $inputname));
                    439:         } elsif ($curRes->is_problem) {
1.63      raeburn   440:             my $anonpart = 0;
                    441:             my $namedpart = 0;
                    442:             my @parts = @{$curRes->parts()};
                    443:             if (ref($anoncounter) eq 'HASH') {
                    444:                 if (keys(%{$anoncounter}) > 0) {
                    445:                     my @parts = @{$curRes->parts()};
                    446:                     my $symb = $curRes->symb();
                    447:                     foreach my $part (@parts) {
                    448:                         if ((exists($anoncounter->{$symb."\0".$part})) ||
                    449:                             $curRes->is_anonsurvey($part)) {
                    450:                             $anonpart ++;
                    451:                         } else {
                    452:                             $namedpart ++ 
                    453:                         }
                    454:                     }
                    455:                 }
                    456:             }
1.21      matthew   457:             if (@Accumulator && $Accumulator[-1] ne '') {
                    458:                 &{$Accumulator[-1]}($curRes,
1.63      raeburn   459:                                     exists($selected->{$curRes->symb}),
                    460:                                     $anonpart,$namedpart);
1.21      matthew   461:             }
                    462:         }
                    463:     }
                    464:     my $course_seq = pop(@Sequence_Data);
                    465:     foreach my $seq ($course_seq,@Sequence_Data) {
                    466:         #my $seq = pop(@Sequence_Data);
                    467:         next if (! defined($seq) || ref($seq) ne 'HASH');
                    468:         $Str.= '<tr><td colspan="2">'.
1.25      matthew   469:             '<b>'.$seq->{'title'}.'</b>'.('&nbsp;'x2).
                    470:             '<a href="javascript:checkall(true,'.$seq->{'id'}.')">'.
                    471:                                   &mt('Select').'</a>'.('&nbsp;'x2).
                    472:             '<a href="javascript:checkall(false,'.$seq->{'id'}.')">'.
                    473:                                   &mt('Unselect').'</a>'.('&nbsp;'x2).
1.21      matthew   474:             '</td></tr>'.$/;
                    475:         $Str.= $seq->{'html'};
                    476:     }
                    477:     $Str .= '</table>'.$/;
                    478:     return $Str;
                    479: }
                    480: 
                    481: sub new_accumulator {
1.25      matthew   482:     my ($title,$src,$symb,$seq_id,$inputname) = @_;
1.21      matthew   483:     my $target;
1.25      matthew   484:     my $item_id=0;
1.21      matthew   485:     return 
                    486:         sub {
                    487:             if (@_) { 
1.63      raeburn   488:                 my ($res,$checked,$anonpart,$namedpart) = @_;
1.23      matthew   489:                 $target.='<tr><td><label>'.
1.21      matthew   490:                     '<input type="checkbox" name="'.$inputname.'" ';
                    491:                 if ($checked) {
1.56      bisitz    492:                     $target .= 'checked="checked" ';
1.21      matthew   493:                 }
1.63      raeburn   494:                 my $anon_id = $item_id;
1.25      matthew   495:                 $target .= 'id="'.$seq_id.':'.$item_id++.'" ';
1.63      raeburn   496:                 my $esc_symb = &escape($res->symb);
1.21      matthew   497:                 $target.= 
1.63      raeburn   498:                     'value="'.$esc_symb.'" />'.
1.26      matthew   499:                     '&nbsp;'.$res->compTitle.'</label>'.
                    500:                     ('&nbsp;'x2).'<a target="preview" '.
1.55      raeburn   501:                     'href="'.$res->link.'?symb='.
1.56      bisitz    502:                     &escape($res->shown_symb).'">'.&mt('view').'</a>'.
1.63      raeburn   503:                     '<input type="hidden" id="anonymous_'.$seq_id.':'.$anon_id.'" name="hidden_'.$seq_id.':'.$anon_id.'" value="'.$anonpart.'" />';
                    504:                 my $mixed = '<input type="hidden" id="mixed_'.$seq_id.':'.$anon_id.'" value="none" name="mixed_'.$seq_id.':'.$anon_id.'" />';
                    505:                 if ($anonpart) {
                    506:                     if ($namedpart) {
                    507:                         my $checknamed = '';
                    508:                         my $checkedanon = ' checked="checked"';
                    509:                         if ($env{'form.mixed_'.$seq_id.':'.$anon_id} eq $esc_symb) {
                    510:                             $checknamed = $checkedanon;
                    511:                             $checkedanon = '';
                    512:                         }
                    513:                         $mixed = '&nbsp;('.
                    514:     &mt('Both anonymous and named submissions -- display: [_1]Anonymous [_2]Named[_3]',
                    515:     '<span class="LC_nobreak"><label>'.
                    516:     '<input type="radio" name="mixed_'.$seq_id.':'.$anon_id.
                    517:     '" value="0" id="mixed_'.$seq_id.':'.$anon_id.'"'.$checkedanon.' />',
                    518:     '</label></span>'.('&nbsp;'x2).' <span class="LC_nobreak">'.
                    519:     '<label><input type="radio" name="mixed_'.$seq_id.':'.$anon_id.
                    520:     '" value="symb_'.$esc_symb.'" id="named_'.$seq_id.':'.$anon_id.'"'.$checknamed.' />',
                    521:     '</label></span>').')';
                    522:                     } else {
                    523:                         $target .= '&nbsp;'.&mt('(Anonymous Survey)');
                    524:                     }
                    525:                 }
                    526:                 $target.= $mixed.'</td></tr>'.$/;
1.21      matthew   527:             } else { 
                    528:                 if (defined($target)) {
                    529:                     return { title => $title,
                    530:                              symb  => $symb,
                    531:                              src   => $src,
1.25      matthew   532:                              id    => $seq_id,
1.21      matthew   533:                              html  => $target, }; 
                    534:                 }
                    535:                 return undef;
                    536:             }
                    537:         };
                    538: }
                    539: 
                    540: sub get_selected_symbs {
                    541:     my ($inputfield) = @_;
                    542:     my $field = 'form.'.$inputfield;
1.48      matthew   543:     my @symbs = (map {
1.53      www       544:                      &unescape($_);
1.48      matthew   545:                      } &Apache::loncommon::get_env_multiple($field));
                    546:     return @symbs;
1.21      matthew   547: }
                    548: 
                    549: ####################################################
                    550: ####################################################
                    551: 
                    552: =pod
                    553: 
1.2       matthew   554: =item &make_target_id($target)
                    555: 
                    556: Inputs: Hash ref with the following entries:
                    557:     $target->{'symb'}, $target->{'part'}, $target->{'respid'}, 
                    558:     $target->{'resptype'}.
                    559: 
                    560: Returns: A string, suitable for a form parameter, which uniquely identifies
                    561: the problem, part, and response to do statistical analysis on.
                    562: 
                    563: Used by Apache::lonstathelpers::ProblemSelector().
                    564: 
                    565: =cut
                    566: 
                    567: ####################################################
                    568: ####################################################
                    569: sub make_target_id {
                    570:     my ($target) = @_;
1.53      www       571:     my $id = &escape($target->{'symb'}).':'.
                    572:              &escape($target->{'part'}).':'.
                    573:              &escape($target->{'respid'}).':'.
                    574:              &escape($target->{'resptype'});
1.2       matthew   575:     return $id;
                    576: }
                    577: 
                    578: ####################################################
                    579: ####################################################
                    580: 
                    581: =pod
                    582: 
                    583: =item &get_target_from_id($id)
                    584: 
                    585: Inputs: $id, a scalar string from Apache::lonstathelpers::make_target_id().
                    586: 
                    587: Returns: A hash reference, $target, containing the following keys:
                    588:     $target->{'symb'}, $target->{'part'}, $target->{'respid'}, 
                    589:     $target->{'resptype'}.
                    590: 
                    591: =cut
                    592: 
                    593: ####################################################
                    594: ####################################################
                    595: sub get_target_from_id {
                    596:     my ($id) = @_;
1.21      matthew   597:     if (! ref($id)) {
                    598:         my ($symb,$part,$respid,$resptype) = split(':',$id);
1.53      www       599:         return ({ symb     => &unescape($symb),
                    600:                   part     => &unescape($part),
                    601:                   respid   => &unescape($respid),
                    602:                   resptype => &unescape($resptype)});
1.21      matthew   603:     } elsif (ref($id) eq 'ARRAY') {
                    604:         my @Return;
                    605:         foreach my $selected (@$id) {
                    606:             my ($symb,$part,$respid,$resptype) = split(':',$selected);
1.53      www       607:             push(@Return,{ symb     => &unescape($symb),
                    608:                            part     => &unescape($part),
                    609:                            respid   => &unescape($respid),
                    610:                            resptype => &unescape($resptype)});
1.21      matthew   611:         }
                    612:         return \@Return;
                    613:     }
1.2       matthew   614: }
                    615: 
                    616: ####################################################
                    617: ####################################################
                    618: 
                    619: =pod
                    620: 
1.13      matthew   621: =item &get_prev_curr_next($target,$AcceptableResponseTypes,$granularity)
1.2       matthew   622: 
                    623: Determine the problem parts or responses preceeding and following the
                    624: current resource.
                    625: 
                    626: Inputs: $target (see &Apache::lonstathelpers::get_target_from_id())
                    627:   $AcceptableResponseTypes, regular expression matching acceptable
                    628:                             response types,
1.52      albertel  629:   $granularity, either 'part', 'response', 'part_survey', or 'part_task'
1.2       matthew   630: 
                    631: Returns: three hash references, $prev, $curr, $next, which refer to the
                    632: preceeding, current, or following problem parts or responses, depending
                    633: on the value of $granularity.  Values of undef indicate there is no
                    634: previous or next part/response.  A value of undef for all three indicates
                    635: there was no match found to the current part/resource.
                    636: 
                    637: The hash references contain the following keys:
                    638:     symb, part, resource
                    639: 
                    640: If $granularity eq 'response', the following ADDITIONAL keys will be present:
                    641:     respid, resptype
                    642: 
                    643: =cut
                    644: 
                    645: ####################################################
                    646: ####################################################
                    647: sub get_prev_curr_next {
                    648:     my ($target,$AcceptableResponseTypes,$granularity) = @_;
                    649:     #
                    650:     # Build an array with the data we need to search through
                    651:     my @Resource;
1.40      matthew   652:     my ($navmap,@sequences) = 
                    653:         &Apache::lonstatistics::selected_sequences_with_assessments('all');
                    654:     return $navmap if (! ref($navmap));
                    655:     foreach my $seq (@sequences) {
                    656:         my @resources = &get_resources($navmap,$seq);
                    657:         foreach my $res (@resources) {
                    658:             foreach my $part (@{$res->parts}) {
1.60      raeburn   659:                 if (($res->is_survey($part) || ($res->is_anonsurvey($part))) && 
                    660:                     ($granularity eq 'part_survey')) {
1.20      matthew   661:                     push (@Resource,
1.40      matthew   662:                           { symb     => $res->symb,
1.20      matthew   663:                             part     => $part,
                    664:                             resource => $res,
                    665:                         } );
1.52      albertel  666: 		} elsif ($res->is_task($part) && ($granularity eq 'part_task')){
                    667:                     push (@Resource,
                    668:                           { symb     => $res->symb,
                    669:                             part     => $part,
                    670:                             resource => $res,
                    671:                         } );
1.13      matthew   672:                 } elsif ($granularity eq 'part') {
1.2       matthew   673:                     push (@Resource,
1.40      matthew   674:                           { symb     => $res->symb,
1.2       matthew   675:                             part     => $part,
                    676:                             resource => $res,
                    677:                         } );
                    678:                 } elsif ($granularity eq 'response') {
1.40      matthew   679:                     my @response_ids   = $res->responseIds($part);
                    680:                     my @response_types = $res->responseType($part);
1.2       matthew   681:                     for (my $i=0;
1.40      matthew   682:                          $i<scalar(@response_ids);
1.2       matthew   683:                          $i++){
1.40      matthew   684:                         my $respid   = $response_ids[$i];
                    685:                         my $resptype = $response_types[$i];
1.2       matthew   686:                         next if ($resptype !~ m/$AcceptableResponseTypes/);
                    687:                         push (@Resource,
1.40      matthew   688:                               { symb     => $res->symb,
1.2       matthew   689:                                 part     => $part,
1.40      matthew   690:                                 respid   => $respid,
                    691:                                 resptype => $resptype,
1.2       matthew   692:                                 resource => $res,
                    693:                                 } );
                    694:                     }
                    695:                 }
                    696:             }
                    697:         }
                    698:     }
                    699:     #
                    700:     # Get the index of the current situation
                    701:     my $curr_idx;
                    702:     for ($curr_idx=0;$curr_idx<$#Resource;$curr_idx++) {
                    703:         my $curr_item = $Resource[$curr_idx];
1.52      albertel  704:         if ($granularity =~ /^(part|part_survey|part_task)$/) {
1.2       matthew   705:             if ($curr_item->{'symb'} eq $target->{'symb'} &&
                    706:                 $curr_item->{'part'} eq $target->{'part'}) {
                    707:                 last;
                    708:             }
                    709:         } elsif ($granularity eq 'response') {
                    710:             if ($curr_item->{'symb'} eq $target->{'symb'} &&
                    711:                 $curr_item->{'part'} eq $target->{'part'} &&
                    712:                 $curr_item->{'respid'} eq $target->{'respid'} &&
                    713:                 $curr_item->{'resptype'} eq $target->{'resptype'}) {
                    714:                 last;
                    715:             }
                    716:         }
                    717:     }
                    718:     my $curr_item = $Resource[$curr_idx];
1.52      albertel  719:     if ($granularity =~ /^(part|part_survey|part_task)$/) {
1.2       matthew   720:         if ($curr_item->{'symb'}     ne $target->{'symb'} ||
                    721:             $curr_item->{'part'}     ne $target->{'part'}) {
                    722:             # bogus symb - return nothing
                    723:             return (undef,undef,undef);
                    724:         }
                    725:     } elsif ($granularity eq 'response') {
                    726:         if ($curr_item->{'symb'}     ne $target->{'symb'} ||
                    727:             $curr_item->{'part'}     ne $target->{'part'} ||
                    728:             $curr_item->{'respid'}   ne $target->{'respid'} ||
                    729:             $curr_item->{'resptype'} ne $target->{'resptype'}){
                    730:             # bogus symb - return nothing
                    731:             return (undef,undef,undef);
                    732:         }
                    733:     }
                    734:     #
                    735:     # Now just pick up the data we need
                    736:     my ($prev,$curr,$next);
                    737:     if ($curr_idx == 0) {
                    738:         $prev = undef;
                    739:         $curr = $Resource[$curr_idx  ];
                    740:         $next = $Resource[$curr_idx+1];
                    741:     } elsif ($curr_idx == $#Resource) {
                    742:         $prev = $Resource[$curr_idx-1];
                    743:         $curr = $Resource[$curr_idx  ];
                    744:         $next = undef;
                    745:     } else {
                    746:         $prev = $Resource[$curr_idx-1];
                    747:         $curr = $Resource[$curr_idx  ];
                    748:         $next = $Resource[$curr_idx+1];
                    749:     }
1.40      matthew   750:     return ($navmap,$prev,$curr,$next);
1.4       matthew   751: }
                    752: 
1.9       matthew   753: 
                    754: #####################################################
                    755: #####################################################
                    756: 
                    757: =pod
                    758: 
                    759: =item GetStudentAnswers($r,$problem,$Students)
                    760: 
                    761: Determines the correct answer for a set of students on a given problem.
                    762: The students answers are stored in the student hashes pointed to by the
                    763: array @$Students under the key 'answer'.
                    764: 
                    765: Inputs: $r
                    766: $problem: hash reference containing the keys 'resource', 'part', and 'respid'.
                    767: $Students: reference to array containing student hashes (need 'username', 
                    768:     'domain').  
                    769: 
                    770: Returns: nothing 
                    771: 
                    772: =cut
                    773: 
                    774: #####################################################
                    775: #####################################################
                    776: sub GetStudentAnswers {
1.12      matthew   777:     my ($r,$problem,$Students,$formname,$inputname) = @_;
1.31      matthew   778:     my %answers;
1.12      matthew   779:     my $status_type;
                    780:     if (defined($formname)) {
                    781:         $status_type = 'inline';
                    782:     } else {
                    783:         $status_type = 'popup';
                    784:     }    
1.9       matthew   785:     my $c = $r->connection();
                    786:     my %Answers;
                    787:     my ($resource,$partid,$respid) = ($problem->{'resource'},
                    788:                                       $problem->{'part'},
                    789:                                       $problem->{'respid'});
                    790:     # Read in the cache (if it exists) before we start timing things.
                    791:     &Apache::lonstathelpers::ensure_proper_cache($resource->{'symb'});
                    792:     # Open progress window
1.68      www       793:     my %prog_state=&Apache::lonhtmlcommon::Create_PrgWin($r,scalar(@$Students));
1.9       matthew   794:     $r->rflush();
                    795:     foreach my $student (@$Students) {
                    796:         last if ($c->aborted());
                    797:         my $sname = $student->{'username'};
                    798:         my $sdom = $student->{'domain'};
1.30      matthew   799:         my $answer = &Apache::lonstathelpers::get_student_answer
1.9       matthew   800:             ($resource,$sname,$sdom,$partid,$respid);
                    801:         &Apache::lonhtmlcommon::Increment_PrgWin($r,\%prog_state,
1.62      bisitz    802:                                                      'last student');
1.31      matthew   803:         $answers{$answer}++;
1.9       matthew   804:         $student->{'answer'} = $answer;
                    805:     }
1.29      matthew   806:     &Apache::lonstathelpers::write_analysis_cache();
1.9       matthew   807:     return if ($c->aborted());
                    808:     $r->rflush();
                    809:     # close progress window
                    810:     &Apache::lonhtmlcommon::Close_PrgWin($r,\%prog_state);
1.31      matthew   811:     return \%answers;
1.9       matthew   812: }
1.4       matthew   813: 
                    814: #####################################################
                    815: #####################################################
                    816: 
                    817: =pod
                    818: 
                    819: =item analyze_problem_as_student
                    820: 
1.30      matthew   821: Analyzes a homework problem for a student
1.4       matthew   822: 
                    823: Inputs: $resource: a resource object
                    824:         $sname, $sdom, $partid, $respid
                    825: 
1.30      matthew   826: Returns: the problem analysis hash
1.6       matthew   827: 
1.4       matthew   828: =cut
                    829: 
                    830: #####################################################
                    831: #####################################################
                    832: sub analyze_problem_as_student {
1.30      matthew   833:     my ($resource,$sname,$sdom) = @_;
1.22      matthew   834:     if (ref($resource) ne 'HASH') {
                    835:         my $res = $resource;
                    836:         $resource = { 'src' => $res->src,
                    837:                       'symb' => $res->symb,
                    838:                       'parts' => $res->parts };
                    839:         foreach my $part (@{$resource->{'parts'}}) {
                    840:             $resource->{'partdata'}->{$part}->{'ResponseIds'}=
                    841:                 [$res->responseIds($part)];
                    842:         }
                    843:     }
1.4       matthew   844:     my $url = $resource->{'src'};
                    845:     my $symb = $resource->{'symb'};
1.29      matthew   846:     my $analysis = &get_from_analysis_cache($sname,$sdom,$symb);
                    847:     if (! defined($analysis)) {
1.46      albertel  848:         my $courseid = $env{'request.course.id'};
1.29      matthew   849:         my $Answ=&Apache::lonnet::ssi($url,('grade_target' => 'analyze',
                    850:                                             'grade_domain' => $sdom,
                    851:                                             'grade_username' => $sname,
                    852:                                             'grade_symb' => $symb,
                    853:                                             'grade_courseid' => $courseid));
                    854:         (my $garbage,$analysis)=split(/_HASH_REF__/,$Answ,2);
                    855:         &store_analysis($sname,$sdom,$symb,$analysis);
                    856:     }
                    857:     my %Answer=&Apache::lonnet::str2hash($analysis);
1.6       matthew   858:     #
1.30      matthew   859:     return \%Answer;
                    860: }
                    861: 
                    862: #####################################################
                    863: #####################################################
                    864: 
                    865: =pod
                    866: 
                    867: =item get_student_answer
                    868: 
                    869: Analyzes a homework problem for a particular student and returns the correct 
                    870: answer.  Attempts to put together an answer for problem types 
                    871: that do not natively support it.
                    872: 
                    873: Inputs: $resource: a resource object (from navmaps or hash from loncoursedata)
                    874:         $sname, $sdom, $partid, $respid
                    875: 
                    876: Returns: $answer
                    877: 
                    878: If $partid and $respid are specified, $answer is simply a scalar containing
                    879: the correct answer for the response.
                    880: 
                    881: If $partid or $respid are undefined, $answer will be a hash reference with
                    882: keys $partid.'.'.$respid.'.answer'.
                    883: 
                    884: =cut
                    885: 
                    886: #####################################################
                    887: #####################################################
                    888: sub get_student_answer {
                    889:     my ($resource,$sname,$sdom,$partid,$respid) = @_;
                    890:     #
                    891:     if (ref($resource) ne 'HASH') {
                    892:         my $res = $resource;
                    893:         $resource = { 'src' => $res->src,
                    894:                       'symb' => $res->symb,
                    895:                       'parts' => $res->parts };
                    896:         foreach my $part (@{$resource->{'parts'}}) {
                    897:             $resource->{'partdata'}->{$part}->{'ResponseIds'}=
                    898:                 [$res->responseIds($part)];
                    899:         }
                    900:     }
                    901:     #
                    902:     my $analysis = 
                    903:         &analyze_problem_as_student($resource,$sname,$sdom);
1.29      matthew   904:     my $answer;
1.8       matthew   905:     foreach my $partid (@{$resource->{'parts'}}) {
1.6       matthew   906:         my $partdata = $resource->{'partdata'}->{$partid};
                    907:         foreach my $respid (@{$partdata->{'ResponseIds'}}) {
                    908:             my $prefix = $partid.'.'.$respid;
                    909:             my $key = $prefix.'.answer';
1.30      matthew   910:             $answer->{$partid}->{$respid} = 
                    911:                 &get_answer($prefix,$key,%$analysis);
1.6       matthew   912:         }
1.8       matthew   913:     }
1.30      matthew   914:     my $returnvalue;
1.8       matthew   915:     if (! defined($partid)) {
                    916:         $returnvalue = $answer;
                    917:     } elsif (! defined($respid)) {
                    918:         $returnvalue = $answer->{$partid};
1.6       matthew   919:     } else {
1.8       matthew   920:         $returnvalue = $answer->{$partid}->{$respid};
1.6       matthew   921:     }
                    922:     return $returnvalue;
                    923: }
                    924: 
                    925: sub get_answer {
                    926:     my ($prefix,$key,%Answer) = @_;
                    927:     my $returnvalue;
1.4       matthew   928:     if (exists($Answer{$key})) {
1.54      albertel  929: 	if (ref($Answer{$key}) eq 'HASH') {
                    930: 	    my $which = 'INTERNAL';
                    931: 	    if (!exists($Answer{$key}{$which})) {
                    932: 		$which = (sort(keys(%{ $Answer{$key} })))[0];
                    933: 	    }
                    934: 	    my $student_answer = $Answer{$key}{$which}[0][0];
                    935: 	    $returnvalue = $student_answer; 
                    936: 	} else {
                    937: 	    &Apache::lonnet::logthis("error analyzing problem. got a answer of type ".ref($Answer{$key}));
                    938: 	}
1.4       matthew   939:     } else {
                    940:         if (exists($Answer{$prefix.'.shown'})) {
                    941:             # The response has foils
                    942:             my %values;
                    943:             while (my ($k,$v) = each(%Answer)) {
                    944:                 next if ($k !~ /^$prefix\.foil\.(value|area)\.(.*)$/);
                    945:                 my $foilname = $2;
                    946:                 $values{$foilname}=$v;
                    947:             }
                    948:             foreach my $foil (@{$Answer{$prefix.'.shown'}}) {
                    949:                 if (ref($values{$foil}) eq 'ARRAY') {
1.10      albertel  950:                     $returnvalue.=&HTML::Entities::encode($foil,'<>&"').'='.
                    951:                         join(',',map {&HTML::Entities::encode($_,'<>&"')} @{$values{$foil}}).'&';
1.4       matthew   952:                 } else {
1.10      albertel  953:                     $returnvalue.=&HTML::Entities::encode($foil,'<>&"').'='.
                    954:                         &HTML::Entities::encode($values{$foil},'<>&"').'&';
1.4       matthew   955:                 }
                    956:             }
                    957:             $returnvalue =~ s/ /\%20/g;
                    958:             chop ($returnvalue);
                    959:         }
                    960:     }
                    961:     return $returnvalue;
                    962: }
1.8       matthew   963: 
                    964: #####################################################
                    965: #####################################################
                    966: 
                    967: =pod
                    968: 
                    969: =item Caching routines
                    970: 
                    971: =over 4
                    972: 
1.29      matthew   973: =item &load_analysis_cache($symb)
1.8       matthew   974: 
                    975: Loads the cache for the given symb into memory from disk.  
                    976: Requires the cache filename be set.  
                    977: Only should be called by &ensure_proper_cache.
                    978: 
                    979: =cut
                    980: 
                    981: #####################################################
                    982: #####################################################
                    983: {
                    984:     my $cache_filename = undef;
                    985:     my $current_symb = undef;
                    986:     my %cache;
                    987: 
1.29      matthew   988: sub load_analysis_cache {
1.8       matthew   989:     my ($symb) = @_;
                    990:     return if (! defined($cache_filename));
                    991:     if (! defined($current_symb) || $current_symb ne $symb) {
                    992:         undef(%cache);
                    993:         my $storedstring;
                    994:         my %cache_db;
                    995:         if (tie(%cache_db,'GDBM_File',$cache_filename,&GDBM_READER(),0640)) {
1.53      www       996:             $storedstring = $cache_db{&escape($symb)};
1.8       matthew   997:             untie(%cache_db);
                    998:         }
                    999:         if (defined($storedstring)) {
                   1000:             %cache = %{thaw($storedstring)};
                   1001:         }
                   1002:     }
                   1003:     return;
                   1004: }
                   1005: 
                   1006: #####################################################
                   1007: #####################################################
                   1008: 
                   1009: =pod
                   1010: 
1.29      matthew  1011: =item &get_from_analysis_cache($sname,$sdom,$symb,$partid,$respid)
1.8       matthew  1012: 
                   1013: Returns the appropriate data from the cache, or undef if no data exists.
                   1014: 
                   1015: =cut
                   1016: 
                   1017: #####################################################
                   1018: #####################################################
1.29      matthew  1019: sub get_from_analysis_cache {
                   1020:     my ($sname,$sdom,$symb) = @_;
1.8       matthew  1021:     &ensure_proper_cache($symb);
                   1022:     my $returnvalue;
1.29      matthew  1023:     if (exists($cache{$sname.':'.$sdom})) {
                   1024:         $returnvalue = $cache{$sname.':'.$sdom};
1.8       matthew  1025:     } else {
                   1026:         $returnvalue = undef;
                   1027:     }
                   1028:     return $returnvalue;
                   1029: }
                   1030: 
                   1031: #####################################################
                   1032: #####################################################
                   1033: 
                   1034: =pod
                   1035: 
1.29      matthew  1036: =item &write_analysis_cache($symb)
1.8       matthew  1037: 
                   1038: Writes the in memory cache to disk so that it can be read in with
1.29      matthew  1039: &load_analysis_cache($symb).
1.8       matthew  1040: 
                   1041: =cut
                   1042: 
                   1043: #####################################################
                   1044: #####################################################
1.29      matthew  1045: sub write_analysis_cache {
1.8       matthew  1046:     return if (! defined($current_symb) || ! defined($cache_filename));
                   1047:     my %cache_db;
1.53      www      1048:     my $key = &escape($current_symb);
1.8       matthew  1049:     if (tie(%cache_db,'GDBM_File',$cache_filename,&GDBM_WRCREAT(),0640)) {
                   1050:         my $storestring = freeze(\%cache);
                   1051:         $cache_db{$key}=$storestring;
                   1052:         $cache_db{$key.'.time'}=time;
                   1053:         untie(%cache_db);
                   1054:     }
                   1055:     undef(%cache);
                   1056:     undef($current_symb);
                   1057:     undef($cache_filename);
                   1058:     return;
                   1059: }
                   1060: 
                   1061: #####################################################
                   1062: #####################################################
                   1063: 
                   1064: =pod
                   1065: 
                   1066: =item &ensure_proper_cache($symb)
                   1067: 
                   1068: Called to make sure we have the proper cache set up.  This is called
1.29      matthew  1069: prior to every analysis lookup.
1.8       matthew  1070: 
                   1071: =cut
                   1072: 
                   1073: #####################################################
                   1074: #####################################################
                   1075: sub ensure_proper_cache {
                   1076:     my ($symb) = @_;
1.46      albertel 1077:     my $cid = $env{'request.course.id'};
1.67      foxr     1078:     my $new_filename = LONCAPA::tempdir() .
1.29      matthew  1079:         'problemanalysis_'.$cid.'_analysis_cache.db';
1.8       matthew  1080:     if (! defined($cache_filename) ||
                   1081:         $cache_filename ne $new_filename ||
                   1082:         ! defined($current_symb)   ||
                   1083:         $current_symb ne $symb) {
                   1084:         $cache_filename = $new_filename;
                   1085:         # Notice: $current_symb is not set to $symb until after the cache is
1.29      matthew  1086:         # loaded.  This is what tells &load_analysis_cache to load in a new
1.8       matthew  1087:         # symb cache.
1.29      matthew  1088:         &load_analysis_cache($symb);
1.8       matthew  1089:         $current_symb = $symb;
                   1090:     }
                   1091: }
                   1092: 
                   1093: #####################################################
                   1094: #####################################################
                   1095: 
                   1096: =pod
                   1097: 
1.29      matthew  1098: =item &store_analysis($sname,$sdom,$symb,$partid,$respid,$dataset)
1.8       matthew  1099: 
1.29      matthew  1100: Stores the analysis data in the in memory cache.
1.8       matthew  1101: 
                   1102: =cut
                   1103: 
                   1104: #####################################################
                   1105: #####################################################
1.29      matthew  1106: sub store_analysis {
                   1107:     my ($sname,$sdom,$symb,$dataset) = @_;
1.8       matthew  1108:     return if ($symb ne $current_symb);
1.29      matthew  1109:     $cache{$sname.':'.$sdom}=$dataset;
1.8       matthew  1110:     return;
                   1111: }
                   1112: 
                   1113: }
                   1114: #####################################################
                   1115: #####################################################
                   1116: 
                   1117: =pod
                   1118: 
                   1119: =back
                   1120: 
                   1121: =cut
                   1122: 
                   1123: #####################################################
                   1124: #####################################################
1.4       matthew  1125: 
                   1126: ##
                   1127: ## The following is copied from datecalc1.pl, part of the 
                   1128: ## Spreadsheet::WriteExcel CPAN module.
                   1129: ##
                   1130: ##
                   1131: ######################################################################
                   1132: #
                   1133: # Demonstration of writing date/time cells to Excel spreadsheets,
                   1134: # using UNIX/Perl time as source of date/time.
                   1135: #
                   1136: # Copyright 2000, Andrew Benham, adsb@bigfoot.com
                   1137: #
                   1138: ######################################################################
                   1139: #
                   1140: # UNIX/Perl time is the time since the Epoch (00:00:00 GMT, 1 Jan 1970)
                   1141: # measured in seconds.
                   1142: #
                   1143: # An Excel file can use exactly one of two different date/time systems.
                   1144: # In these systems, a floating point number represents the number of days
                   1145: # (and fractional parts of the day) since a start point. The floating point
                   1146: # number is referred to as a 'serial'.
                   1147: # The two systems ('1900' and '1904') use different starting points:
                   1148: #  '1900'; '1.00' is 1 Jan 1900 BUT 1900 is erroneously regarded as
                   1149: #          a leap year - see:
                   1150: #            http://support.microsoft.com/support/kb/articles/Q181/3/70.asp
                   1151: #          for the excuse^H^H^H^H^H^Hreason.
                   1152: #  '1904'; '1.00' is 2 Jan 1904.
                   1153: #
                   1154: # The '1904' system is the default for Apple Macs. Windows versions of
                   1155: # Excel have the option to use the '1904' system.
                   1156: #
                   1157: # Note that Visual Basic's "DateSerial" function does NOT erroneously
                   1158: # regard 1900 as a leap year, and thus its serials do not agree with
                   1159: # the 1900 serials of Excel for dates before 1 Mar 1900.
                   1160: #
                   1161: # Note that StarOffice (at least at version 5.2) does NOT erroneously
                   1162: # regard 1900 as a leap year, and thus its serials do not agree with
                   1163: # the 1900 serials of Excel for dates before 1 Mar 1900.
                   1164: #
                   1165: ######################################################################
                   1166: #
                   1167: # Calculation description
                   1168: # =======================
                   1169: #
                   1170: # 1900 system
                   1171: # -----------
                   1172: # Unix time is '0' at 00:00:00 GMT 1 Jan 1970, i.e. 70 years after 1 Jan 1900.
                   1173: # Of those 70 years, 17 (1904,08,12,16,20,24,28,32,36,40,44,48,52,56,60,64,68)
                   1174: # were leap years with an extra day.
                   1175: # Thus there were 17 + 70*365 days = 25567 days between 1 Jan 1900 and
                   1176: # 1 Jan 1970.
                   1177: # In the 1900 system, '1' is 1 Jan 1900, but as 1900 was not a leap year
                   1178: # 1 Jan 1900 should really be '2', so 1 Jan 1970 is '25569'.
                   1179: #
                   1180: # 1904 system
                   1181: # -----------
                   1182: # Unix time is '0' at 00:00:00 GMT 1 Jan 1970, i.e. 66 years after 1 Jan 1904.
                   1183: # Of those 66 years, 17 (1904,08,12,16,20,24,28,32,36,40,44,48,52,56,60,64,68)
                   1184: # were leap years with an extra day.
                   1185: # Thus there were 17 + 66*365 days = 24107 days between 1 Jan 1904 and
                   1186: # 1 Jan 1970.
                   1187: # In the 1904 system, 2 Jan 1904 being '1', 1 Jan 1970 is '24107'.
                   1188: #
                   1189: ######################################################################
                   1190: #
                   1191: # Copyright (c) 2000, Andrew Benham.
                   1192: # This program is free software. It may be used, redistributed and/or
                   1193: # modified under the same terms as Perl itself.
                   1194: #
                   1195: # Andrew Benham, adsb@bigfoot.com
                   1196: # London, United Kingdom
                   1197: # 11 Nov 2000
                   1198: #
                   1199: ######################################################################
                   1200: #-----------------------------------------------------------
                   1201: # calc_serial()
                   1202: #
                   1203: # Called with (up to) 2 parameters.
                   1204: #   1.  Unix timestamp.  If omitted, uses current time.
                   1205: #   2.  GMT flag. Set to '1' to return serial in GMT.
                   1206: #       If omitted, returns serial in appropriate timezone.
                   1207: #
                   1208: # Returns date/time serial according to $DATE_SYSTEM selected
                   1209: #-----------------------------------------------------------
                   1210: sub calc_serial {
                   1211:     # Use 1900 date system on all platforms other than Apple Mac (for which
                   1212:     # use 1904 date system).
                   1213:     my $DATE_SYSTEM = ($^O eq 'MacOS') ? 1 : 0;
                   1214:     my $time = (defined $_[0]) ? $_[0] : time();
                   1215:     my $gmtflag = (defined $_[1]) ? $_[1] : 0;
                   1216:     #
                   1217:     # Divide timestamp by number of seconds in a day.
                   1218:     # This gives a date serial with '0' on 1 Jan 1970.
                   1219:     my $serial = $time / 86400;
                   1220:     #
                   1221:     # Adjust the date serial by the offset appropriate to the
                   1222:     # currently selected system (1900/1904).
                   1223:     if ($DATE_SYSTEM == 0) {        # use 1900 system
                   1224:         $serial += 25569;
                   1225:     } else {                        # use 1904 system
                   1226:         $serial += 24107;
                   1227:     }
                   1228:     #
                   1229:     unless ($gmtflag) {
                   1230:         # Now have a 'raw' serial with the right offset. But this
                   1231:         # gives a serial in GMT, which is false unless the timezone
                   1232:         # is GMT. We need to adjust the serial by the appropriate
                   1233:         # timezone offset.
                   1234:         # Calculate the appropriate timezone offset by seeing what
                   1235:         # the differences between localtime and gmtime for the given
                   1236:         # time are.
                   1237:         #    
                   1238:         my @gmtime = gmtime($time);
                   1239:         my @ltime  = localtime($time);
                   1240:         #
                   1241:         # For the first 7 elements of the two arrays, adjust the
                   1242:         # date serial where the elements differ.
                   1243:         for (0 .. 6) {
                   1244:             my $diff = $ltime[$_] - $gmtime[$_];
                   1245:             if ($diff) {
                   1246:                 $serial += _adjustment($diff,$_);
                   1247:             }
                   1248:         }
                   1249:     }
                   1250:     #
                   1251:     # Perpetuate the error that 1900 was a leap year by decrementing
                   1252:     # the serial if we're using the 1900 system and the date is prior to
                   1253:     # 1 Mar 1900. This has the effect of making serial value '60'
                   1254:     # 29 Feb 1900.
                   1255:     #
                   1256:     # This fix only has any effect if UNIX/Perl time on the platform
                   1257:     # can represent 1900. Many can't.
                   1258:     #
                   1259:     unless ($DATE_SYSTEM) {
                   1260:         $serial-- if ($serial < 61);    # '61' is 1 Mar 1900
                   1261:     }
                   1262:     return $serial;
                   1263: }
                   1264: 
                   1265: sub _adjustment {
                   1266:     # Based on the difference in the localtime/gmtime array elements
                   1267:     # number, return the adjustment required to the serial.
                   1268:     #
                   1269:     # We only look at some elements of the localtime/gmtime arrays:
                   1270:     #    seconds    unlikely to be different as all known timezones
                   1271:     #               have an offset of integral multiples of 15 minutes,
                   1272:     #               but it's easy to do.
                   1273:     #    minutes    will be different for timezone offsets which are
                   1274:     #               not an exact number of hours.
                   1275:     #    hours      very likely to be different.
                   1276:     #    weekday    will differ when localtime/gmtime difference
                   1277:     #               straddles midnight.
                   1278:     #
                   1279:     # Assume that difference between localtime and gmtime is less than
                   1280:     # 5 days, then don't have to do maths for day of month, month number,
                   1281:     # year number, etc...
                   1282:     #
                   1283:     my ($delta,$element) = @_;
                   1284:     my $adjust = 0;
                   1285:     #
                   1286:     if ($element == 0) {            # Seconds
                   1287:         $adjust = $delta/86400;         # 60 * 60 * 24
                   1288:     } elsif ($element == 1) {       # Minutes
                   1289:         $adjust = $delta/1440;          # 60 * 24
                   1290:     } elsif ($element == 2) {       # Hours
                   1291:         $adjust = $delta/24;            # 24
                   1292:     } elsif ($element == 6) {       # Day of week number
                   1293:         # Catch difference straddling Sat/Sun in either direction
                   1294:         $delta += 7 if ($delta < -4);
                   1295:         $delta -= 7 if ($delta > 4);
                   1296:         #    
                   1297:         $adjust = $delta;
                   1298:     }
                   1299:     return $adjust;
                   1300: }
                   1301: 
                   1302: ###########################################################
                   1303: ###########################################################
                   1304: 
                   1305: =pod
                   1306: 
                   1307: =item get_problem_data
                   1308: 
                   1309: Returns a data structure describing the problem.
                   1310: 
                   1311: Inputs: $url
                   1312: 
                   1313: Returns: %Partdata
                   1314: 
                   1315: =cut
                   1316: 
                   1317: ## note: we must force each foil and option to not begin or end with
                   1318: ##       spaces as they are stored without such data.
                   1319: ##
                   1320: ###########################################################
                   1321: ###########################################################
                   1322: sub get_problem_data {
                   1323:     my ($url) = @_;
                   1324:     my $Answ=&Apache::lonnet::ssi($url,('grade_target' => 'analyze'));
                   1325:     (my $garbage,$Answ)=split(/_HASH_REF__/,$Answ,2);
                   1326:     my %Answer;
                   1327:     %Answer=&Apache::lonnet::str2hash($Answ);
                   1328:     my %Partdata;
                   1329:     foreach my $part (@{$Answer{'parts'}}) {
                   1330:         while (my($key,$value) = each(%Answer)) {
                   1331:             #
                   1332:             # Logging code:
1.7       matthew  1333:             if (0) {
1.4       matthew  1334:                 &Apache::lonnet::logthis($part.' got key "'.$key.'"');
                   1335:                 if (ref($value) eq 'ARRAY') {
                   1336:                     &Apache::lonnet::logthis('    @'.join(',',@$value));
                   1337:                 } else {
                   1338:                     &Apache::lonnet::logthis('    '.$value);
                   1339:                 }
                   1340:             }
                   1341:             # End of logging code
1.51      albertel 1342:             next if ($key !~ /^\Q$part\E/);
                   1343:             $key =~ s/^\Q$part\E\.//;
1.4       matthew  1344:             if (ref($value) eq 'ARRAY') {
                   1345:                 if ($key eq 'options') {
                   1346:                     $Partdata{$part}->{'_Options'}=$value;
                   1347:                 } elsif ($key eq 'concepts') {
                   1348:                     $Partdata{$part}->{'_Concepts'}=$value;
1.28      matthew  1349:                 } elsif ($key eq 'items') {
                   1350:                     $Partdata{$part}->{'_Items'}=$value;
1.4       matthew  1351:                 } elsif ($key =~ /^concept\.(.*)$/) {
                   1352:                     my $concept = $1;
                   1353:                     foreach my $foil (@$value) {
                   1354:                         $Partdata{$part}->{'_Foils'}->{$foil}->{'_Concept'}=
                   1355:                                                                       $concept;
                   1356:                     }
1.32      matthew  1357:                 } elsif ($key =~ /^(unit|incorrect|answer|ans_low|ans_high|str_type)$/) {
1.4       matthew  1358:                     $Partdata{$part}->{$key}=$value;
                   1359:                 }
                   1360:             } else {
                   1361:                 if ($key=~ /^foil\.text\.(.*)$/) {
                   1362:                     my $foil = $1;
                   1363:                     $Partdata{$part}->{'_Foils'}->{$foil}->{'name'}=$foil;
                   1364:                     $value =~ s/(\s*$|^\s*)//g;
                   1365:                     $Partdata{$part}->{'_Foils'}->{$foil}->{'text'}=$value;
                   1366:                 } elsif ($key =~ /^foil\.value\.(.*)$/) {
                   1367:                     my $foil = $1;
                   1368:                     $Partdata{$part}->{'_Foils'}->{$foil}->{'value'}=$value;
1.28      matthew  1369:                 } elsif ($key eq 'answercomputed') {
                   1370:                     $Partdata{$part}->{'answercomputed'} = $value;
1.4       matthew  1371:                 }
                   1372:             }
                   1373:         }
                   1374:     }
1.28      matthew  1375:     # Further debugging code
                   1376:     if (0) {
                   1377:         &Apache::lonnet::logthis('lonstathelpers::get_problem_data');
                   1378:         &log_hash_ref(\%Partdata);
                   1379:     }
1.4       matthew  1380:     return %Partdata;
1.5       matthew  1381: }
                   1382: 
1.28      matthew  1383: sub log_array_ref {
                   1384:     my ($arrayref,$prefix) = @_;
                   1385:     return if (ref($arrayref) ne 'ARRAY');
                   1386:     if (! defined($prefix)) { $prefix = ''; };
                   1387:     foreach my $v (@$arrayref) {
                   1388:         if (ref($v) eq 'ARRAY') {
                   1389:             &log_array_ref($v,$prefix.'  ');
                   1390:         } elsif (ref($v) eq 'HASH') {
                   1391:             &log_hash_ref($v,$prefix.'  ');
                   1392:         } else {
                   1393:             &Apache::lonnet::logthis($prefix.'"'.$v.'"');
                   1394:         }
                   1395:     }
                   1396: }
                   1397: 
                   1398: sub log_hash_ref {
                   1399:     my ($hashref,$prefix) = @_;
                   1400:     return if (ref($hashref) ne 'HASH');
                   1401:     if (! defined($prefix)) { $prefix = ''; };
                   1402:     while (my ($k,$v) = each(%$hashref)) {
                   1403:         if (ref($v) eq 'ARRAY') {
                   1404:             &Apache::lonnet::logthis($prefix.'"'.$k.'" = array');
                   1405:             &log_array_ref($v,$prefix.'  ');
                   1406:         } elsif (ref($v) eq 'HASH') {
                   1407:             &Apache::lonnet::logthis($prefix.'"'.$k.'" = hash');
                   1408:             &log_hash_ref($v,$prefix.'  ');
                   1409:         } else {
                   1410:             &Apache::lonnet::logthis($prefix.'"'.$k.'" => "'.$v.'"');
                   1411:         }
                   1412:     }
                   1413: }
1.5       matthew  1414: ####################################################
                   1415: ####################################################
                   1416: 
                   1417: =pod
                   1418: 
                   1419: =item &limit_by_time()
                   1420: 
                   1421: =cut
                   1422: 
                   1423: ####################################################
                   1424: ####################################################
                   1425: sub limit_by_time_form {
                   1426:     my $Starttime_form = '';
                   1427:     my $starttime = &Apache::lonhtmlcommon::get_date_from_form
                   1428:         ('limitby_startdate');
                   1429:     my $endtime = &Apache::lonhtmlcommon::get_date_from_form
                   1430:         ('limitby_enddate');
                   1431:     if (! defined($endtime)) {
                   1432:         $endtime = time;
                   1433:     }
                   1434:     if (! defined($starttime)) {
                   1435:         $starttime = $endtime - 60*60*24*7;
                   1436:     }
                   1437:     my $state;
                   1438:     if (&limit_by_time()) {
                   1439:         $state = '';
                   1440:     } else {
                   1441:         $state = 'disabled';
                   1442:     }
                   1443:     my $startdateform = &Apache::lonhtmlcommon::date_setter
                   1444:         ('Statistics','limitby_startdate',$starttime,undef,undef,$state);
                   1445:     my $enddateform = &Apache::lonhtmlcommon::date_setter
                   1446:         ('Statistics','limitby_enddate',$endtime,undef,undef,$state);
                   1447:     my $Str;
1.58      bisitz   1448:     $Str .= '<script type="text/javascript" language="JavaScript">';
1.5       matthew  1449:     $Str .= 'function toggle_limitby_activity(state) {';
                   1450:     $Str .= '    if (state) {';
                   1451:     $Str .= '        limitby_startdate_enable();';
                   1452:     $Str .= '        limitby_enddate_enable();';
                   1453:     $Str .= '    } else {';
                   1454:     $Str .= '        limitby_startdate_disable();';
                   1455:     $Str .= '        limitby_enddate_disable();';
                   1456:     $Str .= '    }';    
                   1457:     $Str .= '}';
                   1458:     $Str .= '</script>';
                   1459:     $Str .= '<fieldset>';
                   1460:     my $timecheckbox = '<input type="checkbox" name="limit_by_time" ';
                   1461:     if (&limit_by_time()) {
1.72      bisitz   1462:         $timecheckbox .= 'checked="checked" ';
1.5       matthew  1463:     } 
1.72      bisitz   1464:     $timecheckbox .= 'onchange="javascript:toggle_limitby_activity(this.checked);" ';
1.5       matthew  1465:     $timecheckbox .= ' />';
1.49      albertel 1466:     $Str .= '<legend><label>'.&mt('[_1] Limit by time',$timecheckbox).'</label></legend>';
1.5       matthew  1467:     $Str .= &mt('Start Time: [_1]',$startdateform).'<br />';
                   1468:     $Str .= &mt('&nbsp;End Time: [_1]',$enddateform).'<br />';
                   1469:     $Str .= '</fieldset>';
                   1470:     return $Str;
                   1471: }
                   1472: 
                   1473: sub limit_by_time {
1.46      albertel 1474:     if (exists($env{'form.limit_by_time'}) &&
                   1475:         $env{'form.limit_by_time'} ne '' ) {
1.5       matthew  1476:         return 1;
                   1477:     } else {
                   1478:         return 0;
                   1479:     }
                   1480: }
                   1481: 
                   1482: sub get_time_limits {
                   1483:     my $starttime = &Apache::lonhtmlcommon::get_date_from_form
                   1484:         ('limitby_startdate');
                   1485:     my $endtime = &Apache::lonhtmlcommon::get_date_from_form
                   1486:         ('limitby_enddate');
                   1487:     return ($starttime,$endtime);
1.11      matthew  1488: }
                   1489: 
1.2       matthew  1490: ####################################################
                   1491: ####################################################
                   1492: 
                   1493: =pod
                   1494: 
1.12      matthew  1495: =item &manage_caches
                   1496: 
                   1497: Inputs: $r, apache request object
                   1498: 
                   1499: Returns: An array of scalars containing html for buttons.
                   1500: 
                   1501: =cut
                   1502: 
                   1503: ####################################################
                   1504: ####################################################
                   1505: sub manage_caches {
1.23      matthew  1506:     my ($r,$formname,$inputname,$update_message) = @_;
1.12      matthew  1507:     &Apache::loncoursedata::clear_internal_caches();
1.16      matthew  1508:     my $sectionkey = 
                   1509:         join(',',
                   1510:              map {
1.53      www      1511:                      &escape($_);
1.44      matthew  1512:                  } sort(&Apache::lonstatistics::get_selected_sections())
1.16      matthew  1513:              );
                   1514:     my $statuskey = $Apache::lonstatistics::enrollment_status;
1.46      albertel 1515:     if (exists($env{'form.ClearCache'}) || 
                   1516:         exists($env{'form.updatecaches'}) || 
                   1517:         (exists($env{'form.firstrun'}) && $env{'form.firstrun'} ne 'no') ||
                   1518:         (exists($env{'form.prevsection'}) &&
                   1519:             $env{'form.prevsection'} ne $sectionkey) ||
                   1520:         (exists($env{'form.prevenrollstatus'}) &&
                   1521:             $env{'form.prevenrollstatus'} ne $statuskey)
1.16      matthew  1522:         ) {
1.23      matthew  1523:         if (defined($update_message)) {
                   1524:             $r->print($update_message);
                   1525:         }
1.40      matthew  1526:         if (0) {
                   1527:             &Apache::lonnet::logthis('Updating mysql student data caches');
                   1528:         }
1.36      matthew  1529:         &gather_full_student_data($r,$formname,$inputname);
1.12      matthew  1530:     }
                   1531:     #
1.16      matthew  1532:     my @Buttons = 
                   1533:         ('<input type="submit" name="ClearCache" '.
                   1534:              'value="'.&mt('Clear Caches').'" />',
                   1535:          '<input type="submit" name="updatecaches" '.
1.17      matthew  1536:              'value="'.&mt('Update Caches').'" />'.
                   1537:          &Apache::loncommon::help_open_topic('Statistics_Cache'),
1.16      matthew  1538:          '<input type="hidden" name="prevsection" value="'.$sectionkey.'" />',
                   1539:          '<input type="hidden" name="prevenrollstatus" value="'.$statuskey.'" />'
                   1540:          );
                   1541:     #
1.46      albertel 1542:     if (! exists($env{'form.firstrun'})) {
1.12      matthew  1543:         $r->print('<input type="hidden" name="firstrun" value="yes" />');
                   1544:     } else {
                   1545:         $r->print('<input type="hidden" name="firstrun" value="no" />');
                   1546:     }
                   1547:     #
                   1548:     return @Buttons;
                   1549: }
                   1550: 
1.36      matthew  1551: sub gather_full_student_data {
                   1552:     my ($r,$formname,$inputname) = @_;
                   1553:     my $status_type;
                   1554:     if (defined($formname)) {
                   1555:         $status_type = 'inline';
                   1556:     } else {
                   1557:         $status_type = 'popup';
                   1558:     }
                   1559:     my $c = $r->connection();
                   1560:     #
                   1561:     &Apache::loncoursedata::clear_internal_caches();
                   1562:     #
                   1563:     my @Students = @Apache::lonstatistics::Students;
                   1564:     #
                   1565:     # Open the progress window
1.68      www      1566:     my %prog_state=&Apache::lonhtmlcommon::Create_PrgWin($r,scalar(@Students));
1.36      matthew  1567:     #
                   1568:     while (my $student = shift @Students) {
                   1569:         return if ($c->aborted());
                   1570:         my $status = &Apache::loncoursedata::ensure_current_full_data
                   1571:             ($student->{'username'},$student->{'domain'},
1.46      albertel 1572:              $env{'request.course.id'});
1.36      matthew  1573:         &Apache::lonhtmlcommon::Increment_PrgWin($r,\%prog_state,
                   1574:                                                  &mt('last student'));
                   1575:     }
                   1576:     &Apache::lonhtmlcommon::Close_PrgWin($r,\%prog_state);
                   1577:     $r->rflush();
                   1578:     return;
                   1579: }
1.12      matthew  1580: 
1.38      matthew  1581: ####################################################
                   1582: ####################################################
                   1583: 
                   1584: =pod
                   1585: 
                   1586: =item &submission_report_form
                   1587: 
                   1588: Input: The originating reportSelected value for the current stats page.
                   1589: 
                   1590: Output: Scalar containing HTML with needed form elements and a link to 
                   1591: the student submission reports page.
                   1592: 
                   1593: =cut
                   1594: 
                   1595: ####################################################
                   1596: ####################################################
                   1597: sub submission_report_form {
                   1598:     my ($original_report) = @_;
                   1599:     # Note: In the link below we change the reportSelected value.  If
                   1600:     # the user hits the 'back' button on the browser after getting their
                   1601:     # student submissions report, this value may still be around.  So we
                   1602:     # output a script block to set it properly.  If the $original_report
                   1603:     # value is unset, you are just asking for trouble.
                   1604:     if (! defined($original_report)) {
                   1605:         &Apache::lonnet::logthis
                   1606:             ('someone called lonstathelpers::submission_report_form without '.
                   1607:              ' enough input.');
                   1608:     }
                   1609:     my $html = $/.
1.58      bisitz   1610:         '<script type="text/javascript" language="JavaScript">'.
1.38      matthew  1611:         "document.Statistics.reportSelected.value='$original_report';".
                   1612:         '</script>'.
                   1613:         '<input type="hidden" name="correctans" value="true" />'.
                   1614:         '<input type="hidden" name="prob_status" value="true" />'.
                   1615:         '<input type="hidden" name="all_sub" value="true" />';
                   1616:     my $output_selector = $/.'<select name="output">'.$/;
                   1617:     foreach ('HTML','Excel','CSV') {
                   1618:         $output_selector .= '    <option value="'.lc($_).'"';
1.46      albertel 1619:         if ($env{'form.output'} eq lc($_)) {
1.38      matthew  1620:             $output_selector .= ' selected ';
                   1621:         }
                   1622:         $output_selector .='>'.&mt($_).'</option>'.$/;
                   1623:     } 
                   1624:     $output_selector .= '</select>'.$/;
                   1625:     my $link = '<a href="javascript:'.
                   1626:        q{document.Statistics.reportSelected.value='student_submission_reports';}.
                   1627:        'document.Statistics.submit();">';
                   1628:     $html.= &mt('View data as [_1] [_2]go[_3]',$output_selector,
                   1629:                 $link,'</a>').$/;
                   1630:     return $html
                   1631: }
1.12      matthew  1632: 
                   1633: ####################################################
                   1634: ####################################################
                   1635: 
                   1636: =pod
                   1637: 
1.2       matthew  1638: =back
                   1639: 
                   1640: =cut
                   1641: 
                   1642: ####################################################
                   1643: ####################################################
1.1       matthew  1644: 
                   1645: 1;
                   1646: 
                   1647: __END__

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