loncom/homework/lonhomework.pm - diff

Return to lonhomework.pm CVS log

Up to [LON-CAPA] / loncom / homework

Diff for /loncom/homework/lonhomework.pm between versions 1.188 and 1.203

version 1.188, 2004/12/20 12:16:47	version 1.203, 2005/04/04 18:13:16
Line 54 use Apache::loncommon();	Line 54 use Apache::loncommon();
use Apache::lonlocal;	use Apache::lonlocal;
use Time::HiRes qw( gettimeofday tv_interval );	use Time::HiRes qw( gettimeofday tv_interval );
use Apache::lonnet();	use Apache::lonnet();
#
# FIXME!!!!!!!
# Be nice if someone
# - Took credit/blame for this module.
# - At least commented the purpose of each major
# sub
# - Even better commented the major blocks.
#
# I'll have a go at it for what I need.
# ?'s- mean maybe this is right.
# The number of ?'s represents the rough level
# of doubt I have about rightness, with ??? representing
# uncertainty based on the first blush interpretation.
# ?? - I have some code to back up this interpretation.
# ? - I"m pretty sure I understand the code that backs up this
# interpretation.
# ???? - Absolutely clueless.
# . - I'm pretty sure the interpretation is correct.
# RF.


# 'Exported' Variables:

# viewgrades is 'F' if users are not allowed to view the grades.. T otherwise.

$Apache::lonhomework::viewgrades = 'F'; # By default cannot.

# Internal variables.	# FIXME - improve commenting

my $DEBUG=0; # set nonzero to enable debugging.

BEGIN {	BEGIN {
&Apache::lonxml::register_insert();	&Apache::lonxml::register_insert();
}	}

#
# Issue debug log messages.
# Parameters:
# The log message to issue.
# Implicit Inputs:
# DEBUG - If non zero the message is issued, otherwise not.
#
sub Debug {
my ($message) = @_;

if($DEBUG) {
my @call_context = caller(1);
my $prefix = "$call_context[3]:$call_context[2]:: ";
&Apache::lonnet::logthis($prefix.$message);
}
}

#	#
# I believe this sub defines how to render the	# Decides what targets to render for.
# problem based on the context of the rendering?
# Implicit inputs:	# Implicit inputs:
# Various session environment variables:	# Various session environment variables:
# request.state - State of the resource actually ??	# request.state - published - is a /res/ resource
# published - Examining in resource space.	# uploaded - is a /uploaded/ resource
# uploaded - Not sure how this happens?????	# contruct - is a /priv/ resource
# contruct - Rendering in construction space for viewing.	# form.grade_target - a form parameter requesting a specific target
# form.grade_target -
sub get_target {	sub get_target {
&Debug("request.state = $ENV{'request.state'}");	&Apache::lonxml::debug("request.state = $ENV{'request.state'}");
if( defined($ENV{'form.grade_target'})) {	if( defined($ENV{'form.grade_target'})) {
&Debug("form.grade_target = $ENV{'form.grade_target'}");	&Apache::lonxml::debug("form.grade_target= $ENV{'form.grade_target'}");
} else {	} else {
&Debug("form.grade_target <undefined>");	&Apache::lonxml::debug("form.grade_target <undefined>");
}	}
if (($ENV{'request.state'} eq "published") \|\|	if (($ENV{'request.state'} eq "published") \|\|
($ENV{'request.state'} eq "uploaded")) {	($ENV{'request.state'} eq "uploaded")) {
Line 160 sub get_target {	Line 115 sub get_target {
} else {	} else {
return ('web','answer');	return ('web','answer');
}	}
} elsif ( $ENV{'form.problemmode'} eq &mt('Edit') ) {	} elsif ( $ENV{'form.problemmode'} eq &mt('Edit') \|\|
	$ENV{'form.problemmode'} eq 'Edit') {
if ( $ENV{'form.submitted'} eq 'edit' ) {	if ( $ENV{'form.submitted'} eq 'edit' ) {
if ( $ENV{'form.submit'} eq &mt('Submit Changes and View') ) {	if ( $ENV{'form.submit'} eq &mt('Submit Changes and View') ) {
return ('modified','web','answer');	return ('modified','web','answer');
Line 206 sub send_footer {	Line 162 sub send_footer {
$request->print(&Apache::lontexconvert::footer());	$request->print(&Apache::lontexconvert::footer());
}	}

$Apache::lonxml::browse='';	sub proctor_checked_in {
	my ($slot)=@_;
	my @allowed=split(",",$slot->{'proctor'});
	foreach my $possible (@allowed) {
	if ($Apache::lonhomework::history{'resource.checkedin'} eq $possible) {
	return 1;
	}
	}
	return 0;
	}

	$Apache::lonxml::browse='';
sub check_ip_acc {	sub check_ip_acc {
my ($acc)=@_;	my ($acc)=@_;
if (!defined($acc) \|\| $acc =~ /^\s*$/) { return 1; }	if (!defined($acc) \|\| $acc =~ /^\s*$/) { return 1; }
Line 253 sub check_ip_acc {	Line 219 sub check_ip_acc {
}	}
return $allowed;	return $allowed;
}	}

	sub check_task_access {
	#does it pass normal muster
	my ($status,$datemsg)=&check_access;
	if ($status eq 'SHOW_ANSWER' \|\|
	$status eq 'CLOSED' \|\|
	$status eq 'CANNOT_ANSWER' \|\|
	$status eq 'INVALID_ACCESS' \|\|
	$status eq 'UNAVAILABLE') {
	return ($status,$datemsg);
	}
	if ($ENV{'request.state'} eq "construct") {
	return ($status,$datemsg);
	}

	my ($id)=@_;
	my @slots=split(':',&Apache::lonnet::EXT("resource.$id.available"));
	# if (!@slots) {
	# return ($status,$datemsg);
	# }
	my $slotstatus='NOT_IN_A_SLOT';
	my $returned_slot;
	foreach my $slot (@slots) {
	&Apache::lonxml::debug("getting $slot");
	my %slot=&Apache::lonnet::get_slot($slot);
	&Apache::lonhomework::showhash(%slot);
	if ($slot{'starttime'} < time &&
	$slot{'endtime'} > time &&
	&check_ip_acc($slot{'ip'})) {
	&Apache::lonxml::debug("$slot is good");
	$slotstatus='NEEDS_CHECKIN';
	$returned_slot=\%slot;
	last;
	}
	}
	if ($slotstatus eq 'NEEDS_CHECKIN' &&
	&proctor_checked_in($returned_slot)) {
	&Apache::lonxml::debug("protoctor checked in");
	$slotstatus='CAN_ANSWER';
	}
	return ($slotstatus,$datemsg,$returned_slot);
	}

# JB, 9/24/2002: Any changes in this function may require a change	# JB, 9/24/2002: Any changes in this function may require a change
# in lonnavmaps::resource::getDateStatus.	# in lonnavmaps::resource::getDateStatus.
sub check_access {	sub check_access {
Line 364 sub check_access {	Line 373 sub check_access {
&Apache::lonxml::debug("looking for accesstime $first_access");	&Apache::lonxml::debug("looking for accesstime $first_access");
if (!$first_access) {	if (!$first_access) {
$status='NOT_YET_VIEWED';	$status='NOT_YET_VIEWED';
$datemsg=' '.$interval.' seconds';	$datemsg=&seconds_to_human_length($interval);
} else {	} else {
my $newdate=localtime($first_access+$interval);	my $newdate=localtime($first_access+$interval);
if (time > ($first_access+$interval)) {	if (time > ($first_access+$interval)) {
Line 392 sub check_access {	Line 401 sub check_access {
return ($status,$datemsg);	return ($status,$datemsg);
}	}

	sub seconds_to_human_length {
	my ($length)=@_;

	my $seconds=$length%60; $length=int($length/60);
	my $minutes=$length%60; $length=int($length/60);
	my $hours=$length%24; $length=int($length/24);
	my $days=$length;

	my $timestr;
	if ($days > 0) { $timestr.=&mt('[quant,_1,day]',$days); }
	if ($hours > 0) { $timestr.=($timestr?", ":"").
	&mt('[quant,_1,hour]',$hours); }
	if ($minutes > 0) { $timestr.=($timestr?", ":"").
	&mt('[quant,_1,minute]',$minutes); }
	if ($seconds > 0) { $timestr.=($timestr?", ":"").
	&mt('[quant,_1,second]',$seconds); }
	return $timestr;
	}

sub showhash {	sub showhash {
my (%hash) = @_;	my (%hash) = @_;
&showhashsubset(\%hash,'.');	&showhashsubset(\%hash,'.');
Line 402 sub showarray {	Line 430 sub showarray {
my ($array)=@_;	my ($array)=@_;
my $string="(";	my $string="(";
foreach my $elm (@{ $array }) {	foreach my $elm (@{ $array }) {
if (ref($elm)) {	if (ref($elm) eq 'ARRAY') {
if ($elm =~ /ARRAY/ ) {	$string.=&showarray($elm);
$string.=&showarray($elm);	} elsif (ref($elm) eq 'HASH') {
}	$string.= "HASH --- \n<br />";
	$string.= &showhashsubset($elm,'.');
} else {	} else {
$string.="$elm,"	$string.="$elm,"
}	}
Line 419 sub showhashsubset {	Line 448 sub showhashsubset {
my ($hash,$keyre) = @_;	my ($hash,$keyre) = @_;
my $resultkey;	my $resultkey;
foreach $resultkey (sort keys %$hash) {	foreach $resultkey (sort keys %$hash) {
if ($resultkey =~ /$keyre/) {	if ($resultkey !~ /$keyre/) { next; }
if (ref($$hash{$resultkey})) {	if (ref($$hash{$resultkey}) eq 'ARRAY' ) {
if ($$hash{$resultkey} =~ /ARRAY/ ) {	&Apache::lonxml::debug("$resultkey ---- ".
&Apache::lonxml::debug("$resultkey ---- ".	&showarray($$hash{$resultkey}));
&showarray($$hash{$resultkey}));	} elsif (ref($$hash{$resultkey}) eq 'HASH' ) {
} elsif ($$hash{$resultkey} =~ /HASH/ ) {	&Apache::lonxml::debug("$resultkey ---- $$hash{$resultkey}");
&Apache::lonxml::debug("$resultkey ---- $$hash{$resultkey}");	&showhashsubset($$hash{$resultkey},'.');
&showhashsubset($$hash{$resultkey},'.');	} else {
} else {	&Apache::lonxml::debug("$resultkey ---- $$hash{$resultkey}");
&Apache::lonxml::debug("$resultkey ---- $$hash{$resultkey}");
}
} else {
&Apache::lonxml::debug("$resultkey ---- $$hash{$resultkey}");
}
}	}
}	}
&Apache::lonxml::debug("\n<br />restored values^</br>\n");	&Apache::lonxml::debug("\n<br />restored values^</br>\n");
Line 460 sub setuppermissions {	Line 484 sub setuppermissions {

sub setupheader {	sub setupheader {
my $request=$_[0];	my $request=$_[0];
if ($ENV{'browser.mathml'}) {	&Apache::loncommon::content_type($request,'text/html');
&Apache::loncommon::content_type($request,'text/xml');
} else {
&Apache::loncommon::content_type($request,'text/html');
}
if (!$Apache::lonxml::debug && ($ENV{'REQUEST_METHOD'} eq 'GET')) {	if (!$Apache::lonxml::debug && ($ENV{'REQUEST_METHOD'} eq 'GET')) {
&Apache::loncommon::no_cache($request);	&Apache::loncommon::no_cache($request);
}	}
	# $request->set_last_modified(&Apache::lonnet::metadata($request->uri,
	# 'lastrevisiondate'));
$request->send_http_header;	$request->send_http_header;
return OK if $request->header_only;	return OK if $request->header_only;
return ''	return ''
Line 523 sub analyze_header {	Line 545 sub analyze_header {
if ($ENV{'environment.remote'} eq 'off') {	if ($ENV{'environment.remote'} eq 'off') {
$bodytag=&Apache::loncommon::bodytag();	$bodytag=&Apache::loncommon::bodytag();
}	}
my $result.='<html>	my $html=&Apache::lonxml::xmlbegin();
	my $result.=$html.'
<head><title>'.&mt("Analyzing a problem").'</title></head>	<head><title>'.&mt("Analyzing a problem").'</title></head>
'.$bodytag.&Apache::lonxml::message_location().'	'.$bodytag.&Apache::lonxml::message_location().'
<form name="lonhomework" method="POST" action="'.	<form name="lonhomework" method="POST" action="'.
Line 650 sub editxmlmode {	Line 673 sub editxmlmode {
if ($ENV{'environment.remote'} eq 'off') {	if ($ENV{'environment.remote'} eq 'off') {
$bodytag=&Apache::loncommon::bodytag();	$bodytag=&Apache::loncommon::bodytag();
}	}
$result.='<html>'.$bodytag.&Apache::lonxml::message_location().'	my $html=&Apache::lonxml::xmlbegin();
	$result.=$html.$bodytag.&Apache::lonxml::message_location().'
<form name="lonhomework" method="POST" action="'.	<form name="lonhomework" method="POST" action="'.
&HTML::Entities::encode($ENV{'request.uri'},'<>&"').'">'.	&HTML::Entities::encode($ENV{'request.uri'},'<>&"').'">'.
&Apache::structuretags::remember_problem_state().'	&Apache::structuretags::remember_problem_state().'
Line 663 sub editxmlmode {	Line 687 sub editxmlmode {
<input type="submit" name="Undo" accesskey="u" value="'.&mt('undo').'" />	<input type="submit" name="Undo" accesskey="u" value="'.&mt('undo').'" />
<hr />	<hr />
' . $xml_help . '	' . $xml_help . '
<textarea rows="'.$rows.'" cols="'.$cols.'" name="editxmltext">'.	<textarea style="width:100%" rows="'.$rows.'" cols="'.$cols.'" name="editxmltext">'.
&HTML::Entities::encode($problem,'<>&"').'</textarea>	&HTML::Entities::encode($problem,'<>&"').'</textarea>
</form></body></html>';	</form></body></html>';
&Apache::lonxml::add_messages(\$result);	&Apache::lonxml::add_messages(\$result);
Line 671 sub editxmlmode {	Line 695 sub editxmlmode {
}	}
return '';	return '';
}	}

#	#
# Render the page in whatever target desired.	# Render the page in whatever target desired.
#	#

sub renderpage {	sub renderpage {
my ($request,$file) = @_;	my ($request,$file) = @_;

Line 843 sub handler {	Line 867 sub handler {
$Apache::lonxml::debug=$ENV{'user.debug'};	$Apache::lonxml::debug=$ENV{'user.debug'};
$ENV{'request.uri'}=$request->uri;	$ENV{'request.uri'}=$request->uri;
&setuppermissions();	&setuppermissions();
&Apache::lonxml::debug("Permissions:$Apache::lonhomework::browse:$Apache::lonhomework::viewgrades:");
# some times multiple problemmodes are submitted, need to select	# some times multiple problemmodes are submitted, need to select
# the last one	# the last one
&Apache::lonxml::debug("Problem Mode ".$ENV{'form.problemmode'});	if ( defined($ENV{'form.problemmode'}) && ref($ENV{'form.problemmode'}) ) {
if ( defined($ENV{'form.problemmode'}) &&
ref($ENV{'form.problemmode'}) ) {
&Apache::lonxml::debug("Problem Mode ".join(",",@$ENV{'form.problemmode'}));
my $mode=$ENV{'form.problemmode'}->[-1];	my $mode=$ENV{'form.problemmode'}->[-1];
undef $ENV{'form.problemmode'};	undef $ENV{'form.problemmode'};
$ENV{'form.problemmode'}=$mode;	$ENV{'form.problemmode'}=$mode;
}	}
&Apache::lonxml::debug("Problem Mode ".$ENV{'form.problemmode'});
my $file=&Apache::lonnet::filelocation("",$request->uri);	my $file=&Apache::lonnet::filelocation("",$request->uri);

#check if we know where we are	#check if we know where we are
Line 866 sub handler {	Line 886 sub handler {
if ( &Apache::lonnet::mod_perl_version() == 2 ) {	if ( &Apache::lonnet::mod_perl_version() == 2 ) {
&Apache::lonnet::cleanenv();	&Apache::lonnet::cleanenv();
}	}
$request->internal_redirect('/adm/ambiguous'); return;	&Apache::lonnet::logthis(&Apache::lonnet::mod_perl_version());
	$request->internal_redirect('/adm/ambiguous'); return OK;
}	}
}	}
if (&setupheader($request)) { return OK; }	if (&setupheader($request)) { return OK; }
	&Apache::lonxml::debug("Permissions:$Apache::lonhomework::browse:$Apache::lonhomework::viewgrades:");
	&Apache::lonxml::debug("Problem Mode ".$ENV{'form.problemmode'});
my ($symb) = &Apache::lonxml::whichuser();	my ($symb) = &Apache::lonxml::whichuser();
&Apache::lonxml::debug('symb is '.$symb);	&Apache::lonxml::debug('symb is '.$symb);
if ($ENV{'request.state'} eq "construct" \|\| $symb eq '') {	if ($ENV{'request.state'} eq "construct" \|\| $symb eq '') {
Line 891 sub handler {	Line 913 sub handler {
#&view_or_edit_menu($request);	#&view_or_edit_menu($request);
$ENV{'form.problemmode'}='View';	$ENV{'form.problemmode'}='View';
&renderpage($request,$file);	&renderpage($request,$file);
} elsif ($ENV{'form.problemmode'} eq &mt('EditXML')) {	} elsif ($ENV{'form.problemmode'} eq &mt('EditXML') \|\|
	$ENV{'form.problemmode'} eq 'EditXML') {
&editxmlmode($request,$file);	&editxmlmode($request,$file);
} elsif ($ENV{'form.problemmode'} eq &mt('Calculate answers')) {	} elsif ($ENV{'form.problemmode'} eq &mt('Calculate answers')) {
&analyze($request,$file);	&analyze($request,$file);

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

Removed from v.1.188
changed lines
	Added in v.1.203