loncom/interface/statistics/lonstathelpers.pm - diff

Return to lonstathelpers.pm CVS log

Up to [LON-CAPA] / loncom / interface / statistics

Diff for /loncom/interface/statistics/lonstathelpers.pm between versions 1.21 and 1.51

version 1.21, 2004/09/15 21:07:34	version 1.51, 2005/11/12 03:58:55
Line 49 routines that are needed across multiple	Line 49 routines that are needed across multiple
package Apache::lonstathelpers;	package Apache::lonstathelpers;

use strict;	use strict;
use Apache::lonnet();	use Apache::lonnet;
use Apache::loncommon();	use Apache::loncommon();
use Apache::lonhtmlcommon();	use Apache::lonhtmlcommon();
use Apache::loncoursedata();	use Apache::loncoursedata();
Line 68 use Storable qw(freeze thaw);	Line 68 use Storable qw(freeze thaw);

=item &render_resource($resource)	=item &render_resource($resource)

Input: a resource generated from	Input: a navmaps resource
&Apache::loncoursedata::get_sequence_assessment_data().

Retunrs: a scalar containing html for a rendering of the problem	Retunrs: a scalar containing html for a rendering of the problem
within a table.	within a table.
Line 82 sub render_resource {	Line 81 sub render_resource {
my ($resource) = @_;	my ($resource) = @_;
##	##
## Render the problem	## Render the problem
my $base;	my ($base) = ($resource->src =~ m\|^(./)[^/]$\|);
($base,undef) = ($resource->{'src'} =~ m\|(./)[^/]$\|);	$base="http://".$ENV{'SERVER_NAME'}.$base;
$base = "http://".$ENV{'SERVER_NAME'}.$base;	my ($src,$symb)=($resource->src,&Apache::lonnet::escape($resource->symb));
my $rendered_problem =	my $rendered_problem = &Apache::lonnet::ssi_body($src.'?symb='.$symb);
&Apache::lonnet::ssi_body($resource->{'src'});
$rendered_problem =~ s/<\sform\s/<nop /g;	$rendered_problem =~ s/<\sform\s/<nop /g;
$rendered_problem =~ s\|(<\s/form\s>)\|<\/nop>\|g;	$rendered_problem =~ s\|(<\s/form\s>)\|<\/nop>\|g;
return '<table bgcolor="ffffff"><tr><td>'.	return '<table bgcolor="ffffff"><tr><td>'.
Line 100 sub render_resource {	Line 98 sub render_resource {

=pod	=pod

=item &ProblemSelector($AcceptedResponseTypes)	=item &get_resources

	=cut

	####################################################
	####################################################
	sub get_resources {
	my ($navmap,$sequence) = @_;
	my @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	Input: scalar containing regular expression which matches response
types to show. '.' will yield all, '(option\|radiobutton)' will match	types to show. '.' will yield all, '(option\|radiobutton)' will match
Line 114 Skips 'survey' problems.	Line 131 Skips 'survey' problems.

####################################################	####################################################
####################################################	####################################################
sub ProblemSelector {	sub problem_selector {
my ($AcceptedResponseTypes) = @_;	my ($AcceptedResponseTypes,$sequence_addendum) = @_;
my $Str;	my $Str;
$Str = "\n<table>\n";	$Str = "\n<table>\n";
foreach my $seq (&Apache::lonstatistics::Sequences_with_Assess('all')) {	my $rb_count =0;
next if ($seq->{'num_assess'}<1);	my ($navmap,@sequences) =
	&Apache::lonstatistics::selected_sequences_with_assessments('all');
	return $navmap if (! ref($navmap)); # error
	foreach my $seq (@sequences) {
my $seq_str = '';	my $seq_str = '';
foreach my $res (@{$seq->{'contents'}}) {	foreach my $res (&get_resources($navmap,$seq)) {
next if ($res->{'type'} ne 'assessment');	foreach my $part (@{$res->parts}) {
foreach my $part (@{$res->{'parts'}}) {	my @response_ids = $res->responseIds($part);
my $partdata = $res->{'partdata'}->{$part};	my @response_types = $res->responseType($part);
for (my $i=0;$i<scalar(@{$partdata->{'ResponseTypes'}});$i++){	for (my $i=0;$i<scalar(@response_types);$i++){
my $respid = $partdata->{'ResponseIds'}->[$i];	my $respid = $response_ids[$i];
my $resptype = $partdata->{'ResponseTypes'}->[$i];	my $resptype = $response_types[$i];
if ($resptype =~ m/$AcceptedResponseTypes/) {	if ($resptype =~ m/$AcceptedResponseTypes/) {
my $value = &make_target_id({symb=>$res->{'symb'},	my $value = &make_target_id({symb=>$res->symb,
part=>$part,	part=>$part,
respid=>$respid,	respid=>$respid,
resptype=>$resptype});	resptype=>$resptype});
my $checked = '';	my $checked = '';
if ($ENV{'form.problemchoice'} eq $value) {	if ($env{'form.problemchoice'} eq $value) {
$checked = 'checked ';	$checked = 'checked ';
}	}
my $title = $res->{'title'};	my $title = $res->compTitle;
if (! defined($title) \|\| $title eq '') {	if (! defined($title) \|\| $title eq '') {
($title) = ($res->{'src'} =~ m:/([^/]*)$:);	($title) = ($res->src =~ m:/([^/]*)$:);
}	}
$seq_str .= '<tr><td>'.	$seq_str .= '<tr>'.
'<input type="radio" name="problemchoice" value="'.$value.'" '.$checked.'/>'.	qq{<td><input type="radio" id="$rb_count" name="problemchoice" value="$value" $checked /></td>}.
'</td><td>'.	'<td><label for="'.$rb_count.'">'.$resptype.'</label></td>'.
$resptype.'</td><td>'.	'<td><label for="'.$rb_count.'">'.$title.'</label>';
'<a href="'.$res->{'src'}.'">'.$title.'</a> ';	if (scalar(@response_ids) > 1) {
# '<a href="'.$res->{'src'}.'">'.$resptype.' '.$res->{'title'}.'</a> ';
if (scalar(@{$partdata->{'ResponseIds'}}) > 1) {
$seq_str .= &mt('response').' '.$respid;	$seq_str .= &mt('response').' '.$respid;
}	}
	my $link = $res->src.'?symb='.
	&Apache::lonnet::escape($res->symb);
	$seq_str .= (' 'x2).
	qq{<a target="preview" href="$link">view</a>};
$seq_str .= "</td></tr>\n";	$seq_str .= "</td></tr>\n";
	$rb_count++;
}	}
}	}
}	}
}	}
if ($seq_str ne '') {	if ($seq_str ne '') {
$Str .= '<tr><td>&nbsp</td><td colspan="2"><b>'.$seq->{'title'}.'</b></td>'.	$Str .= '<tr><td>&nbsp</td>'.
	'<td colspan="2"><b>'.$seq->compTitle.'</b></td>'.
"</tr>\n".$seq_str;	"</tr>\n".$seq_str;
	if (defined($sequence_addendum)) {
	$Str .= '<tr>'.
	('<td>&nbsp</td>'x2).
	'<td align="right">'.$sequence_addendum.'</td>'.
	"</tr>\n";
	}
}	}
}	}
$Str .= "</table>\n";	$Str .= "</table>\n";
Line 169 sub ProblemSelector {	Line 199 sub ProblemSelector {

=pod	=pod

=item &MultpleProblemSelector($navmap,$ResponseTypes,$selected,$inputname)	=item &MultipleProblemSelector($navmap,$selected,$inputname)

Generate HTML with checkboxes for problem selection.	Generate HTML with checkboxes for problem selection.

Line 178 Input:	Line 208 Input:
$navmap: a navmap object. If undef, navmaps will be called to create a	$navmap: a navmap object. If undef, navmaps will be called to create a
new object.	new object.

$ResponseTypes: scalar containing regular expression which matches response
types. Only those problems which contain the given response type will be
shown.

$selected: Scalar, Array, or hash reference of currently selected items.	$selected: Scalar, Array, or hash reference of currently selected items.

$inputname: The name of the form elements to use for the checkboxs.	$inputname: The name of the form elements to use for the checkboxs.
Line 194 and their contents. A checkbox is provi	Line 220 and their contents. A checkbox is provi
####################################################	####################################################
####################################################	####################################################
sub MultipleProblemSelector {	sub MultipleProblemSelector {
my ($navmap,$ReponseTypes,$inputname,$formname)=@_;	my ($navmap,$inputname,$formname)=@_;
my $cid = $ENV{'request.course.id'};	my $cid = $env{'request.course.id'};
my $Str;	my $Str;
# Massage the input as needed.	# Massage the input as needed.
if (! defined($navmap)) {	if (! defined($navmap)) {
Line 209 sub MultipleProblemSelector {	Line 235 sub MultipleProblemSelector {
my $selected = {map { ($_,1) } (&get_selected_symbs($inputname))};	my $selected = {map { ($_,1) } (&get_selected_symbs($inputname))};
# Header	# Header
$Str .= <<"END";	$Str .= <<"END";
<script>	<script language="JavaScript" type="text/javascript">
function checkall(value, checkName) {	function checkall(value,seqid) {
for (i=0; i<document.forms.$formname.elements.length; i++) {	for (i=0; i<document.forms.$formname.elements.length; i++) {
ele = document.forms.$formname.elements[i];	ele = document.forms.$formname.elements[i];
if (ele.name == '$inputname') {	if (ele.name == '$inputname') {
document.forms.$formname.elements[i].checked=value;	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;
	}
}	}
}	}
}	}
Line 227 END	Line 261 END
$Str .= $/.'<table>'.$/;	$Str .= $/.'<table>'.$/;
my $iterator = $navmap->getIterator(undef, undef, undef, 1);	my $iterator = $navmap->getIterator(undef, undef, undef, 1);
my $sequence_string;	my $sequence_string;
my @Accumulator = (&new_accumulator($ENV{'course.'.$cid.'.description'},	my $seq_id = 0;
	my @Accumulator = (&new_accumulator($env{'course.'.$cid.'.description'},
'',	'',
'',	'',
	$seq_id++,
$inputname));	$inputname));
my @Sequence_Data;	my @Sequence_Data;
while (my $curRes = $iterator->next()) {	while (my $curRes = $iterator->next()) {
if ($curRes == $iterator->END_MAP) {	if ($curRes == $iterator->END_MAP) {
if (ref($Accumulator[-1]) eq 'CODE') {	if (ref($Accumulator[-1]) eq 'CODE') {
push(@Sequence_Data,&{$Accumulator[-1]}());	my $old_accumulator = pop(@Accumulator);
pop(@Accumulator);	push(@Sequence_Data,&{$old_accumulator}());
}	}
} elsif ($curRes == $iterator->BEGIN_MAP) {	} elsif ($curRes == $iterator->BEGIN_MAP) {
# Not much to do here.	# Not much to do here.
}	}
next if (! ref($curRes));	next if (! ref($curRes));
if ($curRes->is_map) {	if ($curRes->is_map) {
push(@Accumulator,&new_accumulator($curRes->title,	push(@Accumulator,&new_accumulator($curRes->compTitle,
$curRes->src,	$curRes->src,
$curRes->symb,	$curRes->symb,
	$seq_id++,
$inputname));	$inputname));
} elsif ($curRes->is_problem) {	} elsif ($curRes->is_problem) {
if (@Accumulator && $Accumulator[-1] ne '') {	if (@Accumulator && $Accumulator[-1] ne '') {
Line 259 END	Line 296 END
#my $seq = pop(@Sequence_Data);	#my $seq = pop(@Sequence_Data);
next if (! defined($seq) \|\| ref($seq) ne 'HASH');	next if (! defined($seq) \|\| ref($seq) ne 'HASH');
$Str.= '<tr><td colspan="2">'.	$Str.= '<tr><td colspan="2">'.
'<b>'.&get_title($seq->{'title'},$seq->{'src'}).'</b>'.	'<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>'.$/;	'</td></tr>'.$/;
$Str.= $seq->{'html'};	$Str.= $seq->{'html'};
}	}
Line 267 END	Line 308 END
return $Str;	return $Str;
}	}

sub get_title {
my ($title,$src) = @_;
if ($title eq '') {
($title) = ($src =~ m\|/([^/]+)$\|);
} else {
$title =~ s/\&colon;/:/g;
}
return $title;
}

sub new_accumulator {	sub new_accumulator {
my ($title,$src,$symb,$inputname) = @_;	my ($title,$src,$symb,$seq_id,$inputname) = @_;
my $target;	my $target;
	my $item_id=0;
return	return
sub {	sub {
if (@_) {	if (@_) {
my ($res,$checked) = @_;	my ($res,$checked) = @_;
$target.='<tr><td>'.	$target.='<tr><td><label>'.
'<input type="checkbox" name="'.$inputname.'" ';	'<input type="checkbox" name="'.$inputname.'" ';
if ($checked) {	if ($checked) {
$target .= 'checked ';	$target .= 'checked ';
}	}
	$target .= 'id="'.$seq_id.':'.$item_id++.'" ';
$target.=	$target.=
'value="'.&Apache::lonnet::escape($res->symb).'" />'.	'value="'.&Apache::lonnet::escape($res->symb).'" />'.
'</td><td>'.&get_title($res->title,$res->symb).'</td>'.	' '.$res->compTitle.'</label>'.
'</tr>'.$/;	(' 'x2).'<a target="preview" '.
	'href="'.$res->src.'?symb='.
	&Apache::lonnet::escape($res->symb).'">view</a>'.
	'</td></tr>'.$/;
} else {	} else {
if (defined($target)) {	if (defined($target)) {
return { title => $title,	return { title => $title,
symb => $symb,	symb => $symb,
src => $src,	src => $src,
	id => $seq_id,
html => $target, };	html => $target, };
}	}
return undef;	return undef;
Line 308 sub new_accumulator {	Line 345 sub new_accumulator {
sub get_selected_symbs {	sub get_selected_symbs {
my ($inputfield) = @_;	my ($inputfield) = @_;
my $field = 'form.'.$inputfield;	my $field = 'form.'.$inputfield;
my @Symbs;	my @symbs = (map {
if (exists($ENV{$field})) {	&Apache::lonnet::unescape($_);
if (! ref($ENV{$field})) {	} &Apache::loncommon::get_env_multiple($field));
@Symbs = (&Apache::lonnet::unescape($ENV{$field}));	return @symbs;
} else {
@Symbs = (map {&Apache::lonnet::unescape($_);} @{$ENV{$field}});
}
}
return @Symbs;
}	}

####################################################	####################################################
Line 422 sub get_prev_curr_next {	Line 454 sub get_prev_curr_next {
#	#
# Build an array with the data we need to search through	# Build an array with the data we need to search through
my @Resource;	my @Resource;
foreach my $seq (&Apache::lonstatistics::Sequences_with_Assess('all')) {	my ($navmap,@sequences) =
foreach my $res (@{$seq->{'contents'}}) {	&Apache::lonstatistics::selected_sequences_with_assessments('all');
next if ($res->{'type'} ne 'assessment');	return $navmap if (! ref($navmap));
foreach my $part (@{$res->{'parts'}}) {	foreach my $seq (@sequences) {
my $partdata = $res->{'partdata'}->{$part};	my @resources = &get_resources($navmap,$seq);
if ($partdata->{'Survey'} && ($granularity eq 'part_survey')){	foreach my $res (@resources) {
	foreach my $part (@{$res->parts}) {
	if ($res->is_survey($part) && ($granularity eq 'part_survey')){
push (@Resource,	push (@Resource,
{ symb => $res->{symb},	{ symb => $res->symb,
part => $part,	part => $part,
resource => $res,	resource => $res,
} );	} );
} elsif ($granularity eq 'part') {	} elsif ($granularity eq 'part') {
push (@Resource,	push (@Resource,
{ symb => $res->{symb},	{ symb => $res->symb,
part => $part,	part => $part,
resource => $res,	resource => $res,
} );	} );
} elsif ($granularity eq 'response') {	} elsif ($granularity eq 'response') {
	my @response_ids = $res->responseIds($part);
	my @response_types = $res->responseType($part);
for (my $i=0;	for (my $i=0;
$i<scalar(@{$partdata->{'ResponseTypes'}});	$i<scalar(@response_ids);
$i++){	$i++){
my $respid = $partdata->{'ResponseIds'}->[$i];	my $respid = $response_ids[$i];
my $resptype = $partdata->{'ResponseTypes'}->[$i];	my $resptype = $response_types[$i];
next if ($resptype !~ m/$AcceptableResponseTypes/);	next if ($resptype !~ m/$AcceptableResponseTypes/);
push (@Resource,	push (@Resource,
{ symb => $res->{symb},	{ symb => $res->symb,
part => $part,	part => $part,
respid => $partdata->{'ResponseIds'}->[$i],	respid => $respid,
	resptype => $resptype,
resource => $res,	resource => $res,
resptype => $resptype
} );	} );
}	}
}	}
Line 509 sub get_prev_curr_next {	Line 545 sub get_prev_curr_next {
$curr = $Resource[$curr_idx ];	$curr = $Resource[$curr_idx ];
$next = $Resource[$curr_idx+1];	$next = $Resource[$curr_idx+1];
}	}
return ($prev,$curr,$next);	return ($navmap,$prev,$curr,$next);
}	}


Line 537 Returns: nothing	Line 573 Returns: nothing
#####################################################	#####################################################
sub GetStudentAnswers {	sub GetStudentAnswers {
my ($r,$problem,$Students,$formname,$inputname) = @_;	my ($r,$problem,$Students,$formname,$inputname) = @_;
	my %answers;
my $status_type;	my $status_type;
if (defined($formname)) {	if (defined($formname)) {
$status_type = 'inline';	$status_type = 'inline';
Line 560 sub GetStudentAnswers {	Line 597 sub GetStudentAnswers {
last if ($c->aborted());	last if ($c->aborted());
my $sname = $student->{'username'};	my $sname = $student->{'username'};
my $sdom = $student->{'domain'};	my $sdom = $student->{'domain'};
my $answer = &Apache::lonstathelpers::analyze_problem_as_student	my $answer = &Apache::lonstathelpers::get_student_answer
($resource,$sname,$sdom,$partid,$respid);	($resource,$sname,$sdom,$partid,$respid);
&Apache::lonhtmlcommon::Increment_PrgWin($r,\%prog_state,	&Apache::lonhtmlcommon::Increment_PrgWin($r,\%prog_state,
&mt('last student'));	&mt('last student'));
	$answers{$answer}++;
$student->{'answer'} = $answer;	$student->{'answer'} = $answer;
}	}
&Apache::lonstathelpers::write_answer_cache();	&Apache::lonstathelpers::write_analysis_cache();
return if ($c->aborted());	return if ($c->aborted());
$r->rflush();	$r->rflush();
# close progress window	# close progress window
&Apache::lonhtmlcommon::Close_PrgWin($r,\%prog_state);	&Apache::lonhtmlcommon::Close_PrgWin($r,\%prog_state);
return;	return \%answers;
}	}

#####################################################	#####################################################
Line 581 sub GetStudentAnswers {	Line 619 sub GetStudentAnswers {

=item analyze_problem_as_student	=item analyze_problem_as_student

Analyzes a homework problem for a student and returns the correct answer	Analyzes a homework problem for a student
for the student. Attempts to put together an answer for problem types
that do not natively support it.

Inputs: $resource: a resource object	Inputs: $resource: a resource object
$sname, $sdom, $partid, $respid	$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	Returns: $answer

If $partid and $respid are specified, $answer is simply a scalar containing	If $partid and $respid are specified, $answer is simply a scalar containing
Line 600 keys $partid.'.'.$respid.'.answer'.	Line 686 keys $partid.'.'.$respid.'.answer'.

#####################################################	#####################################################
#####################################################	#####################################################
sub analyze_problem_as_student {	sub get_student_answer {
my ($resource,$sname,$sdom,$partid,$respid) = @_;	my ($resource,$sname,$sdom,$partid,$respid) = @_;
my $returnvalue;
my $url = $resource->{'src'};
my $symb = $resource->{'symb'};
my $answer = &get_from_answer_cache($sname,$sdom,$symb,$partid,$respid);
if (defined($answer)) {
return($answer);
}
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);
#	#
undef($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)];
	}
	}
	#
	my $analysis =
	&analyze_problem_as_student($resource,$sname,$sdom);
	my $answer;
foreach my $partid (@{$resource->{'parts'}}) {	foreach my $partid (@{$resource->{'parts'}}) {
my $partdata = $resource->{'partdata'}->{$partid};	my $partdata = $resource->{'partdata'}->{$partid};
foreach my $respid (@{$partdata->{'ResponseIds'}}) {	foreach my $respid (@{$partdata->{'ResponseIds'}}) {
my $prefix = $partid.'.'.$respid;	my $prefix = $partid.'.'.$respid;
my $key = $prefix.'.answer';	my $key = $prefix.'.answer';
$answer->{$partid}->{$respid} = &get_answer($prefix,$key,%Answer);	$answer->{$partid}->{$respid} =
	&get_answer($prefix,$key,%$analysis);
}	}
}	}
&store_answer($sname,$sdom,$symb,undef,undef,$answer);	my $returnvalue;
if (! defined($partid)) {	if (! defined($partid)) {
$returnvalue = $answer;	$returnvalue = $answer;
} elsif (! defined($respid)) {	} elsif (! defined($respid)) {
Line 672 sub get_answer {	Line 757 sub get_answer {
return $returnvalue;	return $returnvalue;
}	}


#####################################################	#####################################################
#####################################################	#####################################################

Line 682 sub get_answer {	Line 766 sub get_answer {

=over 4	=over 4

=item &load_answer_cache($symb)	=item &load_analysis_cache($symb)

Loads the cache for the given symb into memory from disk.	Loads the cache for the given symb into memory from disk.
Requires the cache filename be set.	Requires the cache filename be set.
Line 697 Only should be called by &ensure_proper_	Line 781 Only should be called by &ensure_proper_
my $current_symb = undef;	my $current_symb = undef;
my %cache;	my %cache;

sub load_answer_cache {	sub load_analysis_cache {
my ($symb) = @_;	my ($symb) = @_;
return if (! defined($cache_filename));	return if (! defined($cache_filename));
if (! defined($current_symb) \|\| $current_symb ne $symb) {	if (! defined($current_symb) \|\| $current_symb ne $symb) {
Line 720 sub load_answer_cache {	Line 804 sub load_answer_cache {

=pod	=pod

=item &get_from_answer_cache($sname,$sdom,$symb,$partid,$respid)	=item &get_from_analysis_cache($sname,$sdom,$symb,$partid,$respid)

Returns the appropriate data from the cache, or undef if no data exists.	Returns the appropriate data from the cache, or undef if no data exists.
If $respid is undefined, a hash ref containing the answers for the given
$partid is returned. If $partid is undefined, a hash ref containing answers
for all of the parts is returned.

=cut	=cut

#####################################################	#####################################################
#####################################################	#####################################################
sub get_from_answer_cache {	sub get_from_analysis_cache {
my ($sname,$sdom,$symb,$partid,$respid) = @_;	my ($sname,$sdom,$symb) = @_;
&ensure_proper_cache($symb);	&ensure_proper_cache($symb);
my $returnvalue;	my $returnvalue;
if (exists($cache{$sname.':'.$sdom}) &&	if (exists($cache{$sname.':'.$sdom})) {
ref($cache{$sname.':'.$sdom}) eq 'HASH') {	$returnvalue = $cache{$sname.':'.$sdom};
if (defined($partid) &&
exists($cache{$sname.':'.$sdom}->{$partid})) {
if (defined($respid) &&
exists($cache{$sname.':'.$sdom}->{$partid}->{$respid})) {
$returnvalue = $cache{$sname.':'.$sdom}->{$partid}->{$respid};
} else {
$returnvalue = $cache{$sname.':'.$sdom}->{$partid};
}
} else {
$returnvalue = $cache{$sname.':'.$sdom};
}
} else {	} else {
$returnvalue = undef;	$returnvalue = undef;
}	}
Line 759 sub get_from_answer_cache {	Line 829 sub get_from_answer_cache {

=pod	=pod

=item &write_answer_cache($symb)	=item &write_analysis_cache($symb)

Writes the in memory cache to disk so that it can be read in with	Writes the in memory cache to disk so that it can be read in with
&load_answer_cache($symb).	&load_analysis_cache($symb).

=cut	=cut

#####################################################	#####################################################
#####################################################	#####################################################
sub write_answer_cache {	sub write_analysis_cache {
return if (! defined($current_symb) \|\| ! defined($cache_filename));	return if (! defined($current_symb) \|\| ! defined($cache_filename));
my %cache_db;	my %cache_db;
my $key = &Apache::lonnet::escape($current_symb);	my $key = &Apache::lonnet::escape($current_symb);
Line 792 sub write_answer_cache {	Line 862 sub write_answer_cache {
=item &ensure_proper_cache($symb)	=item &ensure_proper_cache($symb)

Called to make sure we have the proper cache set up. This is called	Called to make sure we have the proper cache set up. This is called
prior to every answer lookup.	prior to every analysis lookup.

=cut	=cut

Line 800 prior to every answer lookup.	Line 870 prior to every answer lookup.
#####################################################	#####################################################
sub ensure_proper_cache {	sub ensure_proper_cache {
my ($symb) = @_;	my ($symb) = @_;
my $cid = $ENV{'request.course.id'};	my $cid = $env{'request.course.id'};
my $new_filename = '/home/httpd/perl/tmp/'.	my $new_filename = '/home/httpd/perl/tmp/'.
'problemanalysis_'.$cid.'_answer_cache.db';	'problemanalysis_'.$cid.'_analysis_cache.db';
if (! defined($cache_filename) \|\|	if (! defined($cache_filename) \|\|
$cache_filename ne $new_filename \|\|	$cache_filename ne $new_filename \|\|
! defined($current_symb) \|\|	! defined($current_symb) \|\|
$current_symb ne $symb) {	$current_symb ne $symb) {
$cache_filename = $new_filename;	$cache_filename = $new_filename;
# Notice: $current_symb is not set to $symb until after the cache is	# Notice: $current_symb is not set to $symb until after the cache is
# loaded. This is what tells &load_answer_cache to load in a new	# loaded. This is what tells &load_analysis_cache to load in a new
# symb cache.	# symb cache.
&load_answer_cache($symb);	&load_analysis_cache($symb);
$current_symb = $symb;	$current_symb = $symb;
}	}
}	}
Line 821 sub ensure_proper_cache {	Line 891 sub ensure_proper_cache {

=pod	=pod

=item &store_answer($sname,$sdom,$symb,$partid,$respid,$dataset)	=item &store_analysis($sname,$sdom,$symb,$partid,$respid,$dataset)

Stores the answer data in the in memory cache.	Stores the analysis data in the in memory cache.

=cut	=cut

#####################################################	#####################################################
#####################################################	#####################################################
sub store_answer {	sub store_analysis {
my ($sname,$sdom,$symb,$partid,$respid,$dataset) = @_;	my ($sname,$sdom,$symb,$dataset) = @_;
return if ($symb ne $current_symb);	return if ($symb ne $current_symb);
if (defined($partid)) {	$cache{$sname.':'.$sdom}=$dataset;
if (defined($respid)) {
$cache{$sname.':'.$sdom}->{$partid}->{$respid} = $dataset;
} else {
$cache{$sname.':'.$sdom}->{$partid} = $dataset;
}
} else {
$cache{$sname.':'.$sdom}=$dataset;
}
return;	return;
}	}

Line 1073 sub get_problem_data {	Line 1135 sub get_problem_data {
}	}
}	}
# End of logging code	# End of logging code
next if ($key !~ /^$part/);	next if ($key !~ /^\Q$part\E/);
$key =~ s/^$part\.//;	$key =~ s/^\Q$part\E\.//;
if (ref($value) eq 'ARRAY') {	if (ref($value) eq 'ARRAY') {
if ($key eq 'options') {	if ($key eq 'options') {
$Partdata{$part}->{'_Options'}=$value;	$Partdata{$part}->{'_Options'}=$value;
} elsif ($key eq 'concepts') {	} elsif ($key eq 'concepts') {
$Partdata{$part}->{'_Concepts'}=$value;	$Partdata{$part}->{'_Concepts'}=$value;
	} elsif ($key eq 'items') {
	$Partdata{$part}->{'_Items'}=$value;
} elsif ($key =~ /^concept\.(.*)$/) {	} elsif ($key =~ /^concept\.(.*)$/) {
my $concept = $1;	my $concept = $1;
foreach my $foil (@$value) {	foreach my $foil (@$value) {
$Partdata{$part}->{'_Foils'}->{$foil}->{'_Concept'}=	$Partdata{$part}->{'_Foils'}->{$foil}->{'_Concept'}=
$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;	$Partdata{$part}->{$key}=$value;
}	}
} else {	} else {
Line 1098 sub get_problem_data {	Line 1162 sub get_problem_data {
} elsif ($key =~ /^foil\.value\.(.*)$/) {	} elsif ($key =~ /^foil\.value\.(.*)$/) {
my $foil = $1;	my $foil = $1;
$Partdata{$part}->{'_Foils'}->{$foil}->{'value'}=$value;	$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;	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.'"');
	}
	}
	}
####################################################	####################################################
####################################################	####################################################

Line 1157 sub limit_by_time_form {	Line 1259 sub limit_by_time_form {
}	}
$timecheckbox .= 'OnChange="javascript:toggle_limitby_activity(this.checked);" ';	$timecheckbox .= 'OnChange="javascript:toggle_limitby_activity(this.checked);" ';
$timecheckbox .= ' />';	$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('Start Time: [_1]',$startdateform).'<br />';
$Str .= &mt(' End Time: [_1]',$enddateform).'<br />';	$Str .= &mt(' End Time: [_1]',$enddateform).'<br />';
$Str .= '</fieldset>';	$Str .= '</fieldset>';
Line 1165 sub limit_by_time_form {	Line 1267 sub limit_by_time_form {
}	}

sub limit_by_time {	sub limit_by_time {
if (exists($ENV{'form.limit_by_time'}) &&	if (exists($env{'form.limit_by_time'}) &&
$ENV{'form.limit_by_time'} ne '' ) {	$env{'form.limit_by_time'} ne '' ) {
return 1;	return 1;
} else {	} else {
return 0;	return 0;
Line 1181 sub get_time_limits {	Line 1283 sub get_time_limits {
return ($starttime,$endtime);	return ($starttime,$endtime);
}	}



####################################################
####################################################

=pod

=item sections_description

Inputs: @Sections, an array of sections

Returns: A text description of the sections selected.

=cut

####################################################
####################################################
sub sections_description {
my @Sections = @_;
my $sectionstring = '';
if (scalar(@Sections) > 1) {
if (scalar(@Sections) > 2) {
my $last = pop(@Sections);
$sectionstring = "Sections ".join(', ',@Sections).', and '.$last;
} else {
$sectionstring = "Sections ".join(' and ',@Sections);
}
} else {
if ($Sections[0] eq 'all') {
$sectionstring = "All sections";
} else {
$sectionstring = "Section ".$Sections[0];
}
}
return $sectionstring;
}

####################################################	####################################################
####################################################	####################################################

Line 1234 Returns: An array of scalars containing	Line 1299 Returns: An array of scalars containing
####################################################	####################################################
####################################################	####################################################
sub manage_caches {	sub manage_caches {
my ($r,$formname,$inputname) = @_;	my ($r,$formname,$inputname,$update_message) = @_;
&Apache::loncoursedata::clear_internal_caches();	&Apache::loncoursedata::clear_internal_caches();
my $sectionkey =	my $sectionkey =
join(',',	join(',',
map {	map {
&Apache::lonnet::escape($_);	&Apache::lonnet::escape($_);
} sort(@Apache::lonstatistics::SelectedSections)	} sort(&Apache::lonstatistics::get_selected_sections())
);	);
my $statuskey = $Apache::lonstatistics::enrollment_status;	my $statuskey = $Apache::lonstatistics::enrollment_status;
if (exists($ENV{'form.ClearCache'}) \|\|	if (exists($env{'form.ClearCache'}) \|\|
exists($ENV{'form.updatecaches'}) \|\|	exists($env{'form.updatecaches'}) \|\|
(exists($ENV{'form.firstrun'}) && $ENV{'form.firstrun'} ne 'no') \|\|	(exists($env{'form.firstrun'}) && $env{'form.firstrun'} ne 'no') \|\|
(exists($ENV{'form.prevsection'}) &&	(exists($env{'form.prevsection'}) &&
$ENV{'form.prevsection'} ne $sectionkey) \|\|	$env{'form.prevsection'} ne $sectionkey) \|\|
(exists($ENV{'form.prevenrollstatus'}) &&	(exists($env{'form.prevenrollstatus'}) &&
$ENV{'form.prevenrollstatus'} ne $statuskey)	$env{'form.prevenrollstatus'} ne $statuskey)
) {	) {
&Apache::lonstatistics::Gather_Full_Student_Data($r,$formname,	if (defined($update_message)) {
$inputname);	$r->print($update_message);
	}
	if (0) {
	&Apache::lonnet::logthis('Updating mysql student data caches');
	}
	&gather_full_student_data($r,$formname,$inputname);
}	}
#	#
my @Buttons =	my @Buttons =
Line 1265 sub manage_caches {	Line 1335 sub manage_caches {
'<input type="hidden" name="prevenrollstatus" value="'.$statuskey.'" />'	'<input type="hidden" name="prevenrollstatus" value="'.$statuskey.'" />'
);	);
#	#
if (! exists($ENV{'form.firstrun'})) {	if (! exists($env{'form.firstrun'})) {
$r->print('<input type="hidden" name="firstrun" value="yes" />');	$r->print('<input type="hidden" name="firstrun" value="yes" />');
} else {	} else {
$r->print('<input type="hidden" name="firstrun" value="no" />');	$r->print('<input type="hidden" name="firstrun" value="no" />');
Line 1274 sub manage_caches {	Line 1344 sub manage_caches {
return @Buttons;	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,&mt('Student Data Compilation Status'),
	&mt('Student Data Compilation Progress'), scalar(@Students),
	$status_type,undef,$formname,$inputname);
	#
	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">'.
	"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
	}

####################################################	####################################################
####################################################	####################################################

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

Removed from v.1.21
changed lines
	Added in v.1.51