--- loncom/interface/statistics/lonstathelpers.pm 2004/03/12 21:05:08 1.7 +++ loncom/interface/statistics/lonstathelpers.pm 2020/08/26 18:13:39 1.76 @@ -1,6 +1,6 @@ # The LearningOnline Network with CAPA # -# $Id: lonstathelpers.pm,v 1.7 2004/03/12 21:05:08 matthew Exp $ +# $Id: lonstathelpers.pm,v 1.76 2020/08/26 18:13:39 raeburn Exp $ # # Copyright Michigan State University Board of Trustees # @@ -40,7 +40,6 @@ routines that are needed across multiple =head1 OVERVIEW - =over 4 =cut @@ -50,7 +49,7 @@ routines that are needed across multiple package Apache::lonstathelpers; use strict; -use Apache::lonnet(); +use Apache::lonnet; use Apache::loncommon(); use Apache::lonhtmlcommon(); use Apache::loncoursedata(); @@ -59,6 +58,11 @@ use Apache::lonlocal; use HTML::Entities(); use Time::Local(); use Spreadsheet::WriteExcel(); +use GDBM_File; +use Storable qw(freeze thaw); +use lib '/home/httpd/lib/perl/'; +use LONCAPA; + #################################################### #################################################### @@ -67,8 +71,7 @@ use Spreadsheet::WriteExcel(); =item &render_resource($resource) -Input: a resource generated from -&Apache::loncoursedata::get_sequence_assessment_data(). +Input: a navmaps resource Retunrs: a scalar containing html for a rendering of the problem within a table. @@ -81,17 +84,16 @@ sub render_resource { my ($resource) = @_; ## ## Render the problem - my $base; - ($base,undef) = ($resource->{'src'} =~ m|(.*/)[^/]*$|); - $base = "http://".$ENV{'SERVER_NAME'}.$base; - my $rendered_problem = - &Apache::lonnet::ssi_body($resource->{'src'}); + my ($base) = ($resource->src =~ m|^(.*/)[^/]*$|); + $base="http://".$ENV{'SERVER_NAME'}.$base; + my ($src,$symb)=($resource->link,&escape($resource->shown_symb)); + my $rendered_problem = &Apache::lonnet::ssi_body($src.'?symb='.$symb); $rendered_problem =~ s/<\s*form\s*/<nop /g; $rendered_problem =~ s|(<\s*/form\s*>)|<\/nop>|g; - return '<table bgcolor="ffffff"><tr><td>'. - '<base href="'.$base.'" />'. - $rendered_problem. - '</td></tr></table>'; + return '<div class="LC_Box">'. + '<h4 class="LC_hcell">'.&mt('Problem').'</h4>'. + '<base href="'.$base.'" />'.$rendered_problem. + '</div>'; } #################################################### @@ -99,7 +101,33 @@ sub render_resource { =pod -=item &ProblemSelector($AcceptedResponseTypes) +=item &get_resources + +=cut + +#################################################### +#################################################### +sub get_resources { + my ($navmap,$sequence,$include_tools) = @_; + my @resources; + if ($include_tools) { + @resources = $navmap->retrieveResources($sequence, + sub { shift->is_gradable(); }, + 0,0,0); + } else { + @resources = $navmap->retrieveResources($sequence, + sub { shift->is_problem(); }, + 0,0,0); + } + return @resources; +} + +#################################################### +#################################################### + +=pod + +=item &problem_selector($AcceptedResponseTypes) Input: scalar containing regular expression which matches response types to show. '.' will yield all, '(option|radiobutton)' will match @@ -107,58 +135,148 @@ all option response and radiobutton prob Returns: A string containing html for a table which lists the sequences and their contents. A radiobutton is provided for each problem. +Skips 'survey' problems. =cut #################################################### #################################################### -sub ProblemSelector { - my ($AcceptedResponseTypes) = @_; +sub problem_selector { + my ($AcceptedResponseTypes,$sequence_addendum,$symbmode,$all,$prefix, + $byres,$include_tools,$smallbox,$onclick) = @_; +# all: also make sequences selectable +# prefix: prefix for all form names +# byres: radiobutton shown per resource +# include_tools: external tools included +# smallbox: use smaller box +# onclick: javascript to execute when clicked my $Str; - $Str = "\n<table>\n"; - foreach my $seq (&Apache::lonstatistics::Sequences_with_Assess()) { - next if ($seq->{'num_assess'}<1); + my $jsadd=''; + if ($onclick) { + $jsadd="onclick='$onclick'"; + } + $Str = &Apache::loncommon::start_scrollbox(($smallbox?'420px':'620px'), + ($smallbox?'400px':'600px'), + ($smallbox?'60px':'300px')). + &Apache::loncommon::start_data_table(); + my $rb_count =0; + my ($navmap,@sequences) = + &Apache::lonstatistics::selected_sequences_with_assessments('all'); + return $navmap if (! ref($navmap)); # error + foreach my $seq (@sequences) { my $seq_str = ''; - foreach my $res (@{$seq->{'contents'}}) { - next if ($res->{'type'} ne 'assessment'); - foreach my $part (@{$res->{'parts'}}) { - my $partdata = $res->{'partdata'}->{$part}; - for (my $i=0;$i<scalar(@{$partdata->{'ResponseTypes'}});$i++){ - my $respid = $partdata->{'ResponseIds'}->[$i]; - my $resptype = $partdata->{'ResponseTypes'}->[$i]; + foreach my $res (&get_resources($navmap,$seq,$include_tools)) { + my $title = $res->compTitle; + if (! defined($title) || $title eq '') { + ($title) = ($res->src =~ m:/([^/]*)$:); + } + my $totalresps = 0; + if ($byres) { + foreach my $part (@{$res->parts}) { + $totalresps += scalar($res->responseIds($part)); + } + my $value = &HTML::Entities::encode($res->symb(),'<>&"'); + my $checked; + if ($env{'form.problemchoice'} eq $res->symb()) { + $checked = ' checked="checked"'; + } + $seq_str .= &Apache::loncommon::start_data_table_row(). + '<td rowspan="'.$totalresps.'" style="vertical-align:middle">'. + '<label><input type="radio" name="symb" value="'.$value.'"'.$checked.' />'. + $title.'</label>'; + my $link = $res->link.'?symb='.&escape($res->shown_symb); + $seq_str .= (' 'x2). + '<a target="preview" href="'.$link.'">'.&mt('view').'</a></td>'; + } + my %partsseen; + foreach my $part (@{$res->parts}) { + my (@response_ids,@response_types); + if ($res->is_tool) { + @response_ids = (); + @response_types = ('tool'); + } else { + @response_ids = $res->responseIds($part); + @response_types = $res->responseType($part); + } + for (my $i=0;$i<scalar(@response_types);$i++){ + my $respid = $response_ids[$i]; + my $resptype = $response_types[$i]; if ($resptype =~ m/$AcceptedResponseTypes/) { - my $value = &make_target_id({symb=>$res->{'symb'}, - part=>$part, - respid=>$respid, - resptype=>$resptype}); - my $checked = ''; - if ($ENV{'form.problemchoice'} eq $value) { - $checked = 'checked '; - } - my $title = $res->{'title'}; - if (! defined($title) || $title eq '') { - ($title) = ($res->{'src'} =~ m:/([^/]*)$:); - } - $seq_str .= '<tr><td>'. - '<input type="radio" name="problemchoice" value="'.$value.'" '.$checked.'/>'. - '</td><td>'. - $resptype.'</td><td>'. - '<a href="'.$res->{'src'}.'">'.$title.'</a> '; -# '<a href="'.$res->{'src'}.'">'.$resptype.' '.$res->{'title'}.'</a> '; - if (scalar(@{$partdata->{'ResponseIds'}}) > 1) { - $seq_str .= &mt('response').' '.$respid; + if ($byres) { + unless (exists($partsseen{$part})) { + my $parttitle = $part; + if ($part eq '0') { + $parttitle = ''; + } + if ($parttitle ne '') { + $parttitle = (' 'x2).&mt('part').': '.$parttitle; + } + if (keys(%partsseen)) { + $seq_str .= &Apache::loncommon::continue_data_table_row(); + } + unless ($partsseen{$part}) { + $seq_str .= '<td rowspan="'.scalar(@response_ids).'" style="vertical-align:middle">'. + $parttitle.'</td>'; + $partsseen{$part} = scalar(@response_ids); + } + } + $seq_str .= '<td>'.$resptype; + if (scalar(@response_ids) > 1) { + $seq_str .= ' '.&mt('id').': '.$respid; + } + $seq_str .= '</td>'. &Apache::loncommon::end_data_table_row()."\n"; + } else { + my $value = &make_target_id({symb=>$res->symb, + part=>$part, + respid=>$respid, + resptype=>$resptype}); + my $checked = ''; + if ($env{'form.problemchoice'} eq $value) { + $checked = ' checked="checked"'; + } + $seq_str .= &Apache::loncommon::start_data_table_row(). + ($symbmode? + '<td><input type="radio" id="'.$prefix.$rb_count.'" name="'.$prefix.'symb" value="'.&HTML::Entities::encode($res->symb,'<>&"').'" '.$checked.' '. + $jsadd. + ' /></td>' + :qq{<td><input type="radio" id="$rb_count" name="problemchoice" value="$value"$checked /></td>}). + '<td><label for="'.$prefix.$rb_count.'">'.$resptype.'</label></td>'. + '<td><label for="'.$prefix.$rb_count.'">'.$title.'</label>'; + if (scalar(@response_ids) > 1) { + $seq_str .= &mt('response').' '.$respid; + } + my $link = $res->link.'?symb='.&escape($res->shown_symb); + $seq_str .= (' 'x2). + '<a target="preview" href="'.$link.'">'.&mt('view').'</a>'; + $seq_str .= "</td>". &Apache::loncommon::end_data_table_row()."\n"; + $rb_count++; } - $seq_str .= "</td></tr>\n"; } } } } if ($seq_str ne '') { - $Str .= '<tr><td> </td><td colspan="2"><b>'.$seq->{'title'}.'</b></td>'. - "</tr>\n".$seq_str; + if ($byres) { + $Str .= &Apache::loncommon::start_data_table_header_row(). + '<th colspan="3">'.$seq->compTitle.'</th>'. + &Apache::loncommon::end_data_table_header_row(). + $seq_str; + } else { + $Str .= &Apache::loncommon::start_data_table_header_row(). + '<th colspan="3">'. + ($all?'<input type="radio" id="'.$prefix.'s'.$rb_count.'" name="'.$prefix.'symb" value="'.&HTML::Entities::encode($seq->symb,'<>&').'" '.$jsadd.' />':''). + $seq->compTitle.'</th>'. + &Apache::loncommon::end_data_table_header_row()."\n".$seq_str; + if (defined($sequence_addendum)) { + $Str .= &Apache::loncommon::start_data_table_header_row(). + ('<td> </td>'x2). + '<td align="right">'.$sequence_addendum.'</td>'. + &Apache::loncommon::end_data_table_header_row()."\n"; + } + } } } - $Str .= "</table>\n"; + $Str .= &Apache::loncommon::end_data_table().&Apache::loncommon::end_scrollbox()."\n"; return $Str; } @@ -167,6 +285,265 @@ sub ProblemSelector { =pod +=item &MultipleProblemSelector($navmap,$selected,$inputname) + +Generate HTML with checkboxes for problem selection. + +Input: + +$navmap: a navmap object. If undef, navmaps will be called to create a +new object. + +$selected: Scalar, Array, or hash reference of currently selected items. + +$inputname: The name of the form elements to use for the checkboxs. + +Returns: A string containing html for a table which lists the sequences +and their contents. A checkbox is provided for each problem. + +=cut + +#################################################### +#################################################### +sub MultipleProblemSelector { + my ($navmap,$inputname,$formname,$anoncounter)=@_; + my $cid = $env{'request.course.id'}; + my $Str; + # Massage the input as needed. + if (! defined($navmap)) { + $navmap = Apache::lonnavmaps::navmap->new(); + if (! defined($navmap)) { + $Str .= '<div class="LC_error">' + .&mt('Error: cannot process course structure') + .'</div>'; + return $Str; + } + } + my $selected = {map { ($_,1) } (&get_selected_symbs($inputname))}; + # Header + $Str .= <<"END"; +<script type="text/javascript" language="JavaScript"> + function checkall(value,seqid) { + for (i=0; i<document.forms.$formname.elements.length; i++) { + ele = document.forms.$formname.elements[i]; + if (ele.name == '$inputname') { + if (seqid != null) { + itemid = document.forms.$formname.elements[i].id; + thing = itemid.split(':'); + if (thing[0] == seqid) { + document.forms.$formname.elements[i].checked=value; + } + } else { + document.forms.$formname.elements[i].checked=value; + } + } + } + } +</script> +END + my $checkanonjs = <<"END"; + +<script type="text/javascript" language="JavaScript"> + function checkanon() { + return true; + } +</script> + +END + if (ref($anoncounter) eq 'HASH') { + if (keys(%{$anoncounter}) > 0) { + 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"); + &js_escape(\$anonwarning); + $checkanonjs = <<"END"; + +<script type="text/javascript" language="JavaScript"> + function checkanon() { + anoncount = 0; + namedcount = 0; + for (i=0; i<document.forms.$formname.elements.length; i++) { + ele = document.forms.$formname.elements[i]; + if (ele.name == '$inputname') { + itemid = document.forms.$formname.elements[i].id; + if (document.forms.$formname.elements[i].checked) { + anonid = 'anonymous_'+itemid; + mixid = 'mixed_'+itemid; + anonele = document.getElementById(anonid); + mixele = document.getElementById(mixid); + if (anonele.value > 0) { + if (mixele.value == 'none') { + anoncount ++; + } else { + if (mixele.value == '0') { + if (mixele.checked) { + anoncount ++; + } else { + namedcount ++; + } + } else { + namedcount ++; + } + } + } else { + namedcount ++; + } + } + } + } + if (anoncount > 0 && namedcount > 0) { + alert("$anonwarning"); + return false; + } + } +</script> + +END + } + } + $Str .= $checkanonjs. + '<a href="javascript:checkall(true)">'.&mt('Select All').'</a>'. + (' 'x4). + '<a href="javascript:checkall(false)">'.&mt('Unselect All').'</a>'; + $Str .= $/.'<table>'.$/; + my $iterator = $navmap->getIterator(undef, undef, undef, 1); + my $sequence_string; + my $seq_id = 0; + my @Accumulator = (&new_accumulator($env{'course.'.$cid.'.description'}, + '', + '', + $seq_id++, + $inputname)); + my @Sequence_Data; + while (my $curRes = $iterator->next()) { + if ($curRes == $iterator->END_MAP) { + if (ref($Accumulator[-1]) eq 'CODE') { + my $old_accumulator = pop(@Accumulator); + push(@Sequence_Data,&{$old_accumulator}()); + } + } elsif ($curRes == $iterator->BEGIN_MAP) { + # Not much to do here. + } + next if (! ref($curRes)); + if ($curRes->is_map) { + push(@Accumulator,&new_accumulator($curRes->compTitle, + $curRes->src, + $curRes->symb, + $seq_id++, + $inputname)); + } elsif ($curRes->is_problem) { + my $anonpart = 0; + my $namedpart = 0; + my @parts = @{$curRes->parts()}; + if (ref($anoncounter) eq 'HASH') { + if (keys(%{$anoncounter}) > 0) { + my @parts = @{$curRes->parts()}; + my $symb = $curRes->symb(); + foreach my $part (@parts) { + if ((exists($anoncounter->{$symb."\0".$part})) || + $curRes->is_anonsurvey($part)) { + $anonpart ++; + } else { + $namedpart ++ + } + } + } + } + if (@Accumulator && $Accumulator[-1] ne '') { + &{$Accumulator[-1]}($curRes, + exists($selected->{$curRes->symb}), + $anonpart,$namedpart); + } + } + } + my $course_seq = pop(@Sequence_Data); + foreach my $seq ($course_seq,@Sequence_Data) { + #my $seq = pop(@Sequence_Data); + next if (! defined($seq) || ref($seq) ne 'HASH'); + $Str.= '<tr><td colspan="2">'. + '<b>'.$seq->{'title'}.'</b>'.(' 'x2). + '<a href="javascript:checkall(true,'.$seq->{'id'}.')">'. + &mt('Select').'</a>'.(' 'x2). + '<a href="javascript:checkall(false,'.$seq->{'id'}.')">'. + &mt('Unselect').'</a>'.(' 'x2). + '</td></tr>'.$/; + $Str.= $seq->{'html'}; + } + $Str .= '</table>'.$/; + return $Str; +} + +sub new_accumulator { + my ($title,$src,$symb,$seq_id,$inputname) = @_; + my $target; + my $item_id=0; + return + sub { + if (@_) { + my ($res,$checked,$anonpart,$namedpart) = @_; + $target.='<tr><td><label>'. + '<input type="checkbox" name="'.$inputname.'" '; + if ($checked) { + $target .= 'checked="checked" '; + } + my $anon_id = $item_id; + $target .= 'id="'.$seq_id.':'.$item_id++.'" '; + my $esc_symb = &escape($res->symb); + $target.= + 'value="'.$esc_symb.'" />'. + ' '.$res->compTitle.'</label>'. + (' 'x2).'<a target="preview" '. + 'href="'.$res->link.'?symb='. + &escape($res->shown_symb).'">'.&mt('view').'</a>'. + '<input type="hidden" id="anonymous_'.$seq_id.':'.$anon_id.'" name="hidden_'.$seq_id.':'.$anon_id.'" value="'.$anonpart.'" />'; + my $mixed = '<input type="hidden" id="mixed_'.$seq_id.':'.$anon_id.'" value="none" name="mixed_'.$seq_id.':'.$anon_id.'" />'; + if ($anonpart) { + if ($namedpart) { + my $checknamed = ''; + my $checkedanon = ' checked="checked"'; + if ($env{'form.mixed_'.$seq_id.':'.$anon_id} eq $esc_symb) { + $checknamed = $checkedanon; + $checkedanon = ''; + } + $mixed = ' ('. + &mt('Both anonymous and named submissions -- display: [_1]Anonymous [_2]Named[_3]', + '<span class="LC_nobreak"><label>'. + '<input type="radio" name="mixed_'.$seq_id.':'.$anon_id. + '" value="0" id="mixed_'.$seq_id.':'.$anon_id.'"'.$checkedanon.' />', + '</label></span>'.(' 'x2).' <span class="LC_nobreak">'. + '<label><input type="radio" name="mixed_'.$seq_id.':'.$anon_id. + '" value="symb_'.$esc_symb.'" id="named_'.$seq_id.':'.$anon_id.'"'.$checknamed.' />', + '</label></span>').')'; + } else { + $target .= ' '.&mt('(Anonymous Survey)'); + } + } + $target.= $mixed.'</td></tr>'.$/; + } else { + if (defined($target)) { + return { title => $title, + symb => $symb, + src => $src, + id => $seq_id, + html => $target, }; + } + return undef; + } + }; +} + +sub get_selected_symbs { + my ($inputfield) = @_; + my $field = 'form.'.$inputfield; + my @symbs = (map { + &unescape($_); + } &Apache::loncommon::get_env_multiple($field)); + return @symbs; +} + +#################################################### +#################################################### + +=pod + =item &make_target_id($target) Inputs: Hash ref with the following entries: @@ -184,10 +561,10 @@ Used by Apache::lonstathelpers::ProblemS #################################################### sub make_target_id { my ($target) = @_; - my $id = &Apache::lonnet::escape($target->{'symb'}).':'. - &Apache::lonnet::escape($target->{'part'}).':'. - &Apache::lonnet::escape($target->{'respid'}).':'. - &Apache::lonnet::escape($target->{'resptype'}); + my $id = &escape($target->{'symb'}).':'. + &escape($target->{'part'}).':'. + &escape($target->{'respid'}).':'. + &escape($target->{'resptype'}); return $id; } @@ -210,11 +587,23 @@ Returns: A hash reference, $target, cont #################################################### sub get_target_from_id { my ($id) = @_; - my ($symb,$part,$respid,$resptype) = split(':',$id); - return ({ symb =>&Apache::lonnet::unescape($symb), - part =>&Apache::lonnet::unescape($part), - respid =>&Apache::lonnet::unescape($respid), - resptype =>&Apache::lonnet::unescape($resptype)}); + if (! ref($id)) { + my ($symb,$part,$respid,$resptype) = split(':',$id); + return ({ symb => &unescape($symb), + part => &unescape($part), + respid => &unescape($respid), + resptype => &unescape($resptype)}); + } elsif (ref($id) eq 'ARRAY') { + my @Return; + foreach my $selected (@$id) { + my ($symb,$part,$respid,$resptype) = split(':',$selected); + push(@Return,{ symb => &unescape($symb), + part => &unescape($part), + respid => &unescape($respid), + resptype => &unescape($resptype)}); + } + return \@Return; + } } #################################################### @@ -222,7 +611,7 @@ sub get_target_from_id { =pod -=item &get_prev_curr_next($target) +=item &get_prev_curr_next($target,$AcceptableResponseTypes,$granularity) Determine the problem parts or responses preceeding and following the current resource. @@ -230,7 +619,7 @@ current resource. Inputs: $target (see &Apache::lonstathelpers::get_target_from_id()) $AcceptableResponseTypes, regular expression matching acceptable response types, - $granularity, either 'part' or 'response' + $granularity, either 'part', 'response', 'part_survey', or 'part_task' Returns: three hash references, $prev, $curr, $next, which refer to the preceeding, current, or following problem parts or responses, depending @@ -253,30 +642,47 @@ sub get_prev_curr_next { # # Build an array with the data we need to search through my @Resource; - foreach my $seq (&Apache::lonstatistics::Sequences_with_Assess()) { - foreach my $res (@{$seq->{'contents'}}) { - next if ($res->{'type'} ne 'assessment'); - foreach my $part (@{$res->{'parts'}}) { - my $partdata = $res->{'partdata'}->{$part}; - if ($granularity eq 'part') { + my ($navmap,@sequences) = + &Apache::lonstatistics::selected_sequences_with_assessments('all'); + return $navmap if (! ref($navmap)); + foreach my $seq (@sequences) { + my @resources = &get_resources($navmap,$seq); + foreach my $res (@resources) { + foreach my $part (@{$res->parts}) { + if (($res->is_survey($part) || ($res->is_anonsurvey($part))) && + ($granularity eq 'part_survey')) { push (@Resource, - { symb => $res->{symb}, + { symb => $res->symb, + part => $part, + resource => $res, + } ); + } elsif ($res->is_task($part) && ($granularity eq 'part_task')){ + push (@Resource, + { symb => $res->symb, + part => $part, + resource => $res, + } ); + } elsif ($granularity eq 'part') { + push (@Resource, + { symb => $res->symb, part => $part, resource => $res, } ); } elsif ($granularity eq 'response') { + my @response_ids = $res->responseIds($part); + my @response_types = $res->responseType($part); for (my $i=0; - $i<scalar(@{$partdata->{'ResponseTypes'}}); + $i<scalar(@response_ids); $i++){ - my $respid = $partdata->{'ResponseIds'}->[$i]; - my $resptype = $partdata->{'ResponseTypes'}->[$i]; + my $respid = $response_ids[$i]; + my $resptype = $response_types[$i]; next if ($resptype !~ m/$AcceptableResponseTypes/); push (@Resource, - { symb => $res->{symb}, + { symb => $res->symb, part => $part, - respid => $partdata->{'ResponseIds'}->[$i], + respid => $respid, + resptype => $resptype, resource => $res, - resptype => $resptype } ); } } @@ -288,7 +694,7 @@ sub get_prev_curr_next { my $curr_idx; for ($curr_idx=0;$curr_idx<$#Resource;$curr_idx++) { my $curr_item = $Resource[$curr_idx]; - if ($granularity eq 'part') { + if ($granularity =~ /^(part|part_survey|part_task)$/) { if ($curr_item->{'symb'} eq $target->{'symb'} && $curr_item->{'part'} eq $target->{'part'}) { last; @@ -303,7 +709,7 @@ sub get_prev_curr_next { } } my $curr_item = $Resource[$curr_idx]; - if ($granularity eq 'part') { + if ($granularity =~ /^(part|part_survey|part_task)$/) { if ($curr_item->{'symb'} ne $target->{'symb'} || $curr_item->{'part'} ne $target->{'part'}) { # bogus symb - return nothing @@ -334,7 +740,7 @@ sub get_prev_curr_next { $curr = $Resource[$curr_idx ]; $next = $Resource[$curr_idx+1]; } - return ($prev,$curr,$next); + return ($navmap,$prev,$curr,$next); } @@ -343,15 +749,123 @@ sub get_prev_curr_next { =pod +=item GetStudentAnswers($r,$problem,$Students) + +Determines the correct answer for a set of students on a given problem. +The students answers are stored in the student hashes pointed to by the +array @$Students under the key 'answer'. + +Inputs: $r +$problem: hash reference containing the keys 'resource', 'part', and 'respid'. +$Students: reference to array containing student hashes (need 'username', + 'domain'). + +Returns: nothing + +=cut + +##################################################### +##################################################### +sub GetStudentAnswers { + my ($r,$problem,$Students,$formname,$inputname) = @_; + my %answers; + my $status_type; + if (defined($formname)) { + $status_type = 'inline'; + } else { + $status_type = 'popup'; + } + my $c = $r->connection(); + my %Answers; + my ($resource,$partid,$respid) = ($problem->{'resource'}, + $problem->{'part'}, + $problem->{'respid'}); + # Read in the cache (if it exists) before we start timing things. + &Apache::lonstathelpers::ensure_proper_cache($resource->{'symb'}); + # Open progress window + my %prog_state=&Apache::lonhtmlcommon::Create_PrgWin($r,scalar(@$Students)); + $r->rflush(); + foreach my $student (@$Students) { + last if ($c->aborted()); + my $sname = $student->{'username'}; + my $sdom = $student->{'domain'}; + my $answer = &Apache::lonstathelpers::get_student_answer + ($resource,$sname,$sdom,$partid,$respid); + &Apache::lonhtmlcommon::Increment_PrgWin($r,\%prog_state, + 'last student'); + $answers{$answer}++; + $student->{'answer'} = $answer; + } + &Apache::lonstathelpers::write_analysis_cache(); + return if ($c->aborted()); + $r->rflush(); + # close progress window + &Apache::lonhtmlcommon::Close_PrgWin($r,\%prog_state); + return \%answers; +} + +##################################################### +##################################################### + +=pod + =item analyze_problem_as_student -Analyzes a homework problem for a student and returns the correct answer -for the student. Attempts to put together an answer for problem types -that do not natively support it. +Analyzes a homework problem for a student Inputs: $resource: a resource object $sname, $sdom, $partid, $respid +Returns: the problem analysis hash + +=cut + +##################################################### +##################################################### +sub analyze_problem_as_student { + my ($resource,$sname,$sdom) = @_; + if (ref($resource) ne 'HASH') { + my $res = $resource; + $resource = { 'src' => $res->src, + 'symb' => $res->symb, + 'parts' => $res->parts }; + foreach my $part (@{$resource->{'parts'}}) { + $resource->{'partdata'}->{$part}->{'ResponseIds'}= + [$res->responseIds($part)]; + } + } + my $url = $resource->{'src'}; + my $symb = $resource->{'symb'}; + my $analysis = &get_from_analysis_cache($sname,$sdom,$symb); + if (! defined($analysis)) { + my $courseid = $env{'request.course.id'}; + my $Answ=&Apache::lonnet::ssi($url,('grade_target' => 'analyze', + 'grade_domain' => $sdom, + 'grade_username' => $sname, + 'grade_symb' => $symb, + 'grade_courseid' => $courseid)); + (my $garbage,$analysis)=split(/_HASH_REF__/,$Answ,2); + &store_analysis($sname,$sdom,$symb,$analysis); + } + my %Answer=&Apache::lonnet::str2hash($analysis); + # + return \%Answer; +} + +##################################################### +##################################################### + +=pod + +=item get_student_answer + +Analyzes a homework problem for a particular student and returns the correct +answer. Attempts to put together an answer for problem types +that do not natively support it. + +Inputs: $resource: a resource object (from navmaps or hash from loncoursedata) + $sname, $sdom, $partid, $respid + Returns: $answer If $partid and $respid are specified, $answer is simply a scalar containing @@ -364,41 +878,39 @@ keys $partid.'.'.$respid.'.answer'. ##################################################### ##################################################### -sub analyze_problem_as_student { +sub get_student_answer { my ($resource,$sname,$sdom,$partid,$respid) = @_; - my $returnvalue; - my $url = $resource->{'src'}; - my $symb = $resource->{'symb'}; - my $courseid = $ENV{'request.course.id'}; - my $Answ=&Apache::lonnet::ssi($url,('grade_target' => 'analyze', - 'grade_domain' => $sdom, - 'grade_username' => $sname, - 'grade_symb' => $symb, - 'grade_courseid' => $courseid)); - (my $garbage,$Answ)=split(/_HASH_REF__/,$Answ,2); - my %Answer=&Apache::lonnet::str2hash($Answ); # - if (! defined($partid)) { - # If you do not specify a partid, you get them all. - foreach my $partid (@{$resource->{'parts'}}) { - my $partdata = $resource->{'partdata'}->{$partid}; - foreach my $respid (@{$partdata->{'ResponseIds'}}) { - my $prefix = $partid.'.'.$respid; - my $key = $prefix.'.answer'; - $returnvalue->{$key} = &get_answer($prefix,$key,%Answer); - } + if (ref($resource) ne 'HASH') { + my $res = $resource; + $resource = { 'src' => $res->src, + 'symb' => $res->symb, + 'parts' => $res->parts }; + foreach my $part (@{$resource->{'parts'}}) { + $resource->{'partdata'}->{$part}->{'ResponseIds'}= + [$res->responseIds($part)]; } - } elsif (! defined($respid)) { + } + # + my $analysis = + &analyze_problem_as_student($resource,$sname,$sdom); + my $answer; + foreach my $partid (@{$resource->{'parts'}}) { my $partdata = $resource->{'partdata'}->{$partid}; foreach my $respid (@{$partdata->{'ResponseIds'}}) { my $prefix = $partid.'.'.$respid; my $key = $prefix.'.answer'; - $returnvalue->{$key} = &get_answer($prefix,$key,%Answer); + $answer->{$partid}->{$respid} = + &get_answer($prefix,$key,%$analysis); } + } + my $returnvalue; + if (! defined($partid)) { + $returnvalue = $answer; + } elsif (! defined($respid)) { + $returnvalue = $answer->{$partid}; } else { - my $prefix = $partid.'.'.$respid; - my $key = $prefix.'.answer'; - $returnvalue = &get_answer($prefix,$key,%Answer); + $returnvalue = $answer->{$partid}->{$respid}; } return $returnvalue; } @@ -407,11 +919,16 @@ sub get_answer { my ($prefix,$key,%Answer) = @_; my $returnvalue; if (exists($Answer{$key})) { - my $student_answer = $Answer{$key}->[0]; - if (! defined($student_answer)) { - $student_answer = $Answer{$key}->[1]; - } - $returnvalue = $student_answer; + if (ref($Answer{$key}) eq 'HASH') { + my $which = 'INTERNAL'; + if (!exists($Answer{$key}{$which})) { + $which = (sort(keys(%{ $Answer{$key} })))[0]; + } + my $student_answer = $Answer{$key}{$which}[0][0]; + $returnvalue = $student_answer; + } else { + &Apache::lonnet::logthis("error analyzing problem. got a answer of type ".ref($Answer{$key})); + } } else { if (exists($Answer{$prefix.'.shown'})) { # The response has foils @@ -423,11 +940,11 @@ sub get_answer { } foreach my $foil (@{$Answer{$prefix.'.shown'}}) { if (ref($values{$foil}) eq 'ARRAY') { - $returnvalue.=&HTML::Entities::encode($foil).'='. - join(',',map {&HTML::Entities::encode($_)} @{$values{$foil}}).'&'; + $returnvalue.=&HTML::Entities::encode($foil,'<>&"').'='. + join(',',map {&HTML::Entities::encode($_,'<>&"')} @{$values{$foil}}).'&'; } else { - $returnvalue.=&HTML::Entities::encode($foil).'='. - &HTML::Entities::encode($values{$foil}).'&'; + $returnvalue.=&HTML::Entities::encode($foil,'<>&"').'='. + &HTML::Entities::encode($values{$foil},'<>&"').'&'; } } $returnvalue =~ s/ /\%20/g; @@ -437,6 +954,168 @@ sub get_answer { return $returnvalue; } +##################################################### +##################################################### + +=pod + +=item Caching routines + +=over 4 + +=item &load_analysis_cache($symb) + +Loads the cache for the given symb into memory from disk. +Requires the cache filename be set. +Only should be called by &ensure_proper_cache. + +=cut + +##################################################### +##################################################### +{ + my $cache_filename = undef; + my $current_symb = undef; + my %cache; + +sub load_analysis_cache { + my ($symb) = @_; + return if (! defined($cache_filename)); + if (! defined($current_symb) || $current_symb ne $symb) { + undef(%cache); + my $storedstring; + my %cache_db; + if (tie(%cache_db,'GDBM_File',$cache_filename,&GDBM_READER(),0640)) { + $storedstring = $cache_db{&escape($symb)}; + untie(%cache_db); + } + if (defined($storedstring)) { + %cache = %{thaw($storedstring)}; + } + } + return; +} + +##################################################### +##################################################### + +=pod + +=item &get_from_analysis_cache($sname,$sdom,$symb,$partid,$respid) + +Returns the appropriate data from the cache, or undef if no data exists. + +=cut + +##################################################### +##################################################### +sub get_from_analysis_cache { + my ($sname,$sdom,$symb) = @_; + &ensure_proper_cache($symb); + my $returnvalue; + if (exists($cache{$sname.':'.$sdom})) { + $returnvalue = $cache{$sname.':'.$sdom}; + } else { + $returnvalue = undef; + } + return $returnvalue; +} + +##################################################### +##################################################### + +=pod + +=item &write_analysis_cache($symb) + +Writes the in memory cache to disk so that it can be read in with +&load_analysis_cache($symb). + +=cut + +##################################################### +##################################################### +sub write_analysis_cache { + return if (! defined($current_symb) || ! defined($cache_filename)); + my %cache_db; + my $key = &escape($current_symb); + if (tie(%cache_db,'GDBM_File',$cache_filename,&GDBM_WRCREAT(),0640)) { + my $storestring = freeze(\%cache); + $cache_db{$key}=$storestring; + $cache_db{$key.'.time'}=time; + untie(%cache_db); + } + undef(%cache); + undef($current_symb); + undef($cache_filename); + return; +} + +##################################################### +##################################################### + +=pod + +=item &ensure_proper_cache($symb) + +Called to make sure we have the proper cache set up. This is called +prior to every analysis lookup. + +=cut + +##################################################### +##################################################### +sub ensure_proper_cache { + my ($symb) = @_; + my $cid = $env{'request.course.id'}; + my $new_filename = LONCAPA::tempdir() . + 'problemanalysis_'.$cid.'_analysis_cache.db'; + if (! defined($cache_filename) || + $cache_filename ne $new_filename || + ! defined($current_symb) || + $current_symb ne $symb) { + $cache_filename = $new_filename; + # Notice: $current_symb is not set to $symb until after the cache is + # loaded. This is what tells &load_analysis_cache to load in a new + # symb cache. + &load_analysis_cache($symb); + $current_symb = $symb; + } +} + +##################################################### +##################################################### + +=pod + +=item &store_analysis($sname,$sdom,$symb,$partid,$respid,$dataset) + +Stores the analysis data in the in memory cache. + +=cut + +##################################################### +##################################################### +sub store_analysis { + my ($sname,$sdom,$symb,$dataset) = @_; + return if ($symb ne $current_symb); + $cache{$sname.':'.$sdom}=$dataset; + return; +} + +} +##################################################### +##################################################### + +=pod + +=back + +=cut + +##################################################### +##################################################### + ## ## The following is copied from datecalc1.pl, part of the ## Spreadsheet::WriteExcel CPAN module. @@ -653,20 +1332,22 @@ sub get_problem_data { } } # End of logging code - next if ($key !~ /^$part/); - $key =~ s/^$part\.//; + next if ($key !~ /^\Q$part\E/); + $key =~ s/^\Q$part\E\.//; if (ref($value) eq 'ARRAY') { if ($key eq 'options') { $Partdata{$part}->{'_Options'}=$value; } elsif ($key eq 'concepts') { $Partdata{$part}->{'_Concepts'}=$value; + } elsif ($key eq 'items') { + $Partdata{$part}->{'_Items'}=$value; } elsif ($key =~ /^concept\.(.*)$/) { my $concept = $1; foreach my $foil (@$value) { $Partdata{$part}->{'_Foils'}->{$foil}->{'_Concept'}= $concept; } - } elsif ($key =~ /^(incorrect|answer|ans_low|ans_high)$/) { + } elsif ($key =~ /^(unit|incorrect|answer|ans_low|ans_high|str_type)$/) { $Partdata{$part}->{$key}=$value; } } else { @@ -678,13 +1359,51 @@ sub get_problem_data { } elsif ($key =~ /^foil\.value\.(.*)$/) { my $foil = $1; $Partdata{$part}->{'_Foils'}->{$foil}->{'value'}=$value; + } elsif ($key eq 'answercomputed') { + $Partdata{$part}->{'answercomputed'} = $value; } } } } + # Further debugging code + if (0) { + &Apache::lonnet::logthis('lonstathelpers::get_problem_data'); + &log_hash_ref(\%Partdata); + } return %Partdata; } +sub log_array_ref { + my ($arrayref,$prefix) = @_; + return if (ref($arrayref) ne 'ARRAY'); + if (! defined($prefix)) { $prefix = ''; }; + foreach my $v (@$arrayref) { + if (ref($v) eq 'ARRAY') { + &log_array_ref($v,$prefix.' '); + } elsif (ref($v) eq 'HASH') { + &log_hash_ref($v,$prefix.' '); + } else { + &Apache::lonnet::logthis($prefix.'"'.$v.'"'); + } + } +} + +sub log_hash_ref { + my ($hashref,$prefix) = @_; + return if (ref($hashref) ne 'HASH'); + if (! defined($prefix)) { $prefix = ''; }; + while (my ($k,$v) = each(%$hashref)) { + if (ref($v) eq 'ARRAY') { + &Apache::lonnet::logthis($prefix.'"'.$k.'" = array'); + &log_array_ref($v,$prefix.' '); + } elsif (ref($v) eq 'HASH') { + &Apache::lonnet::logthis($prefix.'"'.$k.'" = hash'); + &log_hash_ref($v,$prefix.' '); + } else { + &Apache::lonnet::logthis($prefix.'"'.$k.'" => "'.$v.'"'); + } + } +} #################################################### #################################################### @@ -719,7 +1438,7 @@ sub limit_by_time_form { my $enddateform = &Apache::lonhtmlcommon::date_setter ('Statistics','limitby_enddate',$endtime,undef,undef,$state); my $Str; - $Str .= '<script language="Javascript" >'; + $Str .= '<script type="text/javascript" language="JavaScript">'; $Str .= 'function toggle_limitby_activity(state) {'; $Str .= ' if (state) {'; $Str .= ' limitby_startdate_enable();'; @@ -733,11 +1452,11 @@ sub limit_by_time_form { $Str .= '<fieldset>'; my $timecheckbox = '<input type="checkbox" name="limit_by_time" '; if (&limit_by_time()) { - $timecheckbox .= ' checked '; + $timecheckbox .= 'checked="checked" '; } - $timecheckbox .= 'OnChange="javascript:toggle_limitby_activity(this.checked);" '; + $timecheckbox .= 'onchange="javascript:toggle_limitby_activity(this.checked);" '; $timecheckbox .= ' />'; - $Str .= '<legend>'.&mt('[_1] Limit by time',$timecheckbox).'</legend>'; + $Str .= '<legend><label>'.&mt('[_1] Limit by time',$timecheckbox).'</label></legend>'; $Str .= &mt('Start Time: [_1]',$startdateform).'<br />'; $Str .= &mt(' End Time: [_1]',$enddateform).'<br />'; $Str .= '</fieldset>'; @@ -745,8 +1464,8 @@ sub limit_by_time_form { } sub limit_by_time { - if (exists($ENV{'form.limit_by_time'}) && - $ENV{'form.limit_by_time'} ne '' ) { + if (exists($env{'form.limit_by_time'}) && + $env{'form.limit_by_time'} ne '' ) { return 1; } else { return 0; @@ -762,6 +1481,149 @@ sub get_time_limits { } #################################################### +#################################################### + +=pod + +=item &manage_caches + +Inputs: $r, apache request object + +Returns: An array of scalars containing html for buttons. + +=cut + +#################################################### +#################################################### +sub manage_caches { + my ($r,$formname,$inputname,$update_message) = @_; + &Apache::loncoursedata::clear_internal_caches(); + my $sectionkey = + join(',', + map { + &escape($_); + } sort(&Apache::lonstatistics::get_selected_sections()) + ); + my $statuskey = $Apache::lonstatistics::enrollment_status; + if (exists($env{'form.ClearCache'}) || + exists($env{'form.updatecaches'}) || + (exists($env{'form.firstrun'}) && $env{'form.firstrun'} ne 'no') || + (exists($env{'form.prevsection'}) && + $env{'form.prevsection'} ne $sectionkey) || + (exists($env{'form.prevenrollstatus'}) && + $env{'form.prevenrollstatus'} ne $statuskey) + ) { + if (defined($update_message)) { + $r->print($update_message); + } + if (0) { + &Apache::lonnet::logthis('Updating mysql student data caches'); + } + &gather_full_student_data($r,$formname,$inputname); + } + # + my @Buttons = + ('<input type="submit" name="ClearCache" '. + 'value="'.&mt('Clear Caches').'" />', + '<input type="submit" name="updatecaches" '. + 'value="'.&mt('Update Caches').'" />'. + &Apache::loncommon::help_open_topic('Statistics_Cache'), + '<input type="hidden" name="prevsection" value="'.$sectionkey.'" />', + '<input type="hidden" name="prevenrollstatus" value="'.$statuskey.'" />' + ); + # + if (! exists($env{'form.firstrun'})) { + $r->print('<input type="hidden" name="firstrun" value="yes" />'); + } else { + $r->print('<input type="hidden" name="firstrun" value="no" />'); + } + # + return @Buttons; +} + +sub gather_full_student_data { + my ($r,$formname,$inputname) = @_; + my $status_type; + if (defined($formname)) { + $status_type = 'inline'; + } else { + $status_type = 'popup'; + } + my $c = $r->connection(); + # + &Apache::loncoursedata::clear_internal_caches(); + # + my @Students = @Apache::lonstatistics::Students; + # + # Open the progress window + my %prog_state=&Apache::lonhtmlcommon::Create_PrgWin($r,scalar(@Students)); + # + while (my $student = shift @Students) { + return if ($c->aborted()); + my $status = &Apache::loncoursedata::ensure_current_full_data + ($student->{'username'},$student->{'domain'}, + $env{'request.course.id'}); + &Apache::lonhtmlcommon::Increment_PrgWin($r,\%prog_state, + &mt('last student')); + } + &Apache::lonhtmlcommon::Close_PrgWin($r,\%prog_state); + $r->rflush(); + return; +} + +#################################################### +#################################################### + +=pod + +=item &submission_report_form + +Input: The originating reportSelected value for the current stats page. + +Output: Scalar containing HTML with needed form elements and a link to +the student submission reports page. + +=cut + +#################################################### +#################################################### +sub submission_report_form { + my ($original_report) = @_; + # Note: In the link below we change the reportSelected value. If + # the user hits the 'back' button on the browser after getting their + # student submissions report, this value may still be around. So we + # output a script block to set it properly. If the $original_report + # value is unset, you are just asking for trouble. + if (! defined($original_report)) { + &Apache::lonnet::logthis + ('someone called lonstathelpers::submission_report_form without '. + ' enough input.'); + } + my $html = $/. + '<script type="text/javascript" language="JavaScript">'. + "document.Statistics.reportSelected.value='$original_report';". + '</script>'. + '<input type="hidden" name="correctans" value="true" />'. + '<input type="hidden" name="prob_status" value="true" />'. + '<input type="hidden" name="all_sub" value="true" />'; + my $output_selector = $/.'<select name="output">'.$/; + foreach ('HTML','Excel','CSV') { + $output_selector .= ' <option value="'.lc($_).'"'; + if ($env{'form.output'} eq lc($_)) { + $output_selector .= ' selected '; + } + $output_selector .='>'.&mt($_).'</option>'.$/; + } + $output_selector .= '</select>'.$/; + my $link = '<a href="javascript:'. + q{document.Statistics.reportSelected.value='student_submission_reports';}. + 'document.Statistics.submit();">'; + $html.= &mt('View data as [_1] [_2]go[_3]',$output_selector, + $link,'</a>').$/; + return $html +} + +#################################################### #################################################### =pod