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.81 and 1.114

version 1.81, 2002/06/26 17:20:38	version 1.114, 2003/03/10 20:03:55
Line 28	Line 28
# Guy Albertelli	# Guy Albertelli
# 11/30 Gerd Kortemeyer	# 11/30 Gerd Kortemeyer
# 6/1,8/17,8/18 Gerd Kortemeyer	# 6/1,8/17,8/18 Gerd Kortemeyer
	# 7/18 Jeremy Bowers

package Apache::lonhomework;	package Apache::lonhomework;
use strict;	use strict;
Line 41 use Apache::randomlabel();	Line 42 use Apache::randomlabel();
use Apache::response();	use Apache::response();
use Apache::hint();	use Apache::hint();
use Apache::outputtags();	use Apache::outputtags();
	use Apache::caparesponse();
	use Apache::radiobuttonresponse();
	use Apache::optionresponse();
	use Apache::imageresponse();
	use Apache::essayresponse();
	use Apache::externalresponse();
	use Apache::rankresponse();
	use Apache::matchresponse();
use Apache::Constants qw(:common);	use Apache::Constants qw(:common);
use HTML::Entities();	use HTML::Entities();
	use Apache::loncommon();
#use Time::HiRes qw( gettimeofday tv_interval );	#use Time::HiRes qw( gettimeofday tv_interval );

BEGIN {	BEGIN {
Line 51 BEGIN {	Line 61 BEGIN {

sub get_target {	sub get_target {
if ( $ENV{'request.state'} eq "published") {	if ( $ENV{'request.state'} eq "published") {
if ( defined($ENV{'form.grade_target'})	if ( defined($ENV{'form.grade_target'} )
	&& ($ENV{'form.grade_target'} eq 'tex')) {
	return ($ENV{'form.grade_target'});
	} elsif ( defined($ENV{'form.grade_target'} )
&& ($Apache::lonhomework::viewgrades == 'F' )) {	&& ($Apache::lonhomework::viewgrades == 'F' )) {
return ($ENV{'form.grade_target'});	return ($ENV{'form.grade_target'});
}	}

if ( defined($ENV{'form.submitted'})) {	if ( defined($ENV{'form.submitted'})) {
return ('grade', 'web');	return ('grade', 'web');
} else {	} else {
Line 71 sub get_target {	Line 85 sub get_target {
return ('web');	return ('web');
}	}
} else {	} else {
if ( $ENV{'form.problemmode'} eq 'View' ) {	if ( $ENV{'form.problemmode'} eq 'View' \|\|
	$ENV{'form.problemmode'} eq 'Discard Edits and View') {
if ( defined($ENV{'form.submitted'}) &&	if ( defined($ENV{'form.submitted'}) &&
(!defined($ENV{'form.resetdata'})) ) {	(!defined($ENV{'form.resetdata'})) ) {
return ('grade', 'web','answer');	return ('grade', 'web','answer');
Line 126 sub send_footer {	Line 141 sub send_footer {

$Apache::lonxml::browse='';	$Apache::lonxml::browse='';

	# JB, 9/24/2002: Any changes in this function may require a change
	# in lonnavmaps::resource::getDateStatus.
sub check_access {	sub check_access {
my ($id) = @_;	my ($id) = @_;
my $date ='';	my $date ='';
my $status = '';	my $status;
my $datemsg = '';	my $datemsg = '';
my $lastdate = '';	my $lastdate = '';
my $temp;	my $temp;
my $type;	my $type;
my $passed;	my $passed;

	if ($ENV{'request.state'} eq "construct") {
	&Apache::lonxml::debug("in construction ignoring dates");
	$status='CAN_ANSWER';
	$datemsg='is in under construction';
	return ($status,$datemsg);
	}

&Apache::lonxml::debug("checking for part :$id:");	&Apache::lonxml::debug("checking for part :$id:");
&Apache::lonxml::debug("time:".time);	&Apache::lonxml::debug("time:".time);
foreach $temp ("opendate","duedate","answerdate") {	foreach $temp ("opendate","duedate","answerdate") {
$lastdate = $date;	$lastdate = $date;
$date = &Apache::lonnet::EXT("resource.$id.$temp");	$date = &Apache::lonnet::EXT("resource.$id.$temp");
	my $thistype = &Apache::lonnet::EXT("resource.$id.$temp.type");
	if ($thistype =~ /^(con_lost\|no_such_host)/ \|\|
	$date =~ /^(con_lost\|no_such_host)/) {
	$status='UNAVAILABLE';
	$date="may open later.";
	return($status,$date);
	}
	if ($thistype eq 'date_interval') {
	if ($temp eq 'opendate') {
	$date=&Apache::lonnet::EXT("resource.$id.duedate")-$date;
	}
	if ($temp eq 'answerdate') {
	$date=&Apache::lonnet::EXT("resource.$id.duedate")+$date;
	}
	}
&Apache::lonxml::debug("found :$date: for :$temp:");	&Apache::lonxml::debug("found :$date: for :$temp:");
if ($date eq '') {	if ($date eq '') {
$date = "an unknown date"; $passed = 0;	$date = "an unknown date"; $passed = 0;
Line 186 sub check_access {	Line 226 sub check_access {
$status='CAN_ANSWER';	$status='CAN_ANSWER';
$datemsg='is closed but you are allowed to view it';	$datemsg='is closed but you are allowed to view it';
}	}
if ($ENV{'request.state'} eq "construct") {
&Apache::lonxml::debug("in construction ignoring dates");
$status='CAN_ANSWER';
$datemsg='is in under construction';
}
return ($status,$datemsg);	return ($status,$datemsg);
}	}

sub showhash {	sub showhash {
my (%hash) = @_;	my (%hash) = @_;
&showhashsubset(\%hash,'');	&showhashsubset(\%hash,'.');
return '';	return '';
}	}

	sub showarray {
	my ($array)=@_;
	my $string="(";
	foreach my $elm (@{ $array }) {
	if (ref($elm)) {
	if ($elm =~ /ARRAY/ ) {
	$string.=&showarray($elm);
	}
	} else {
	$string.="$elm,"
	}
	}
	chop($string);
	$string.=")";
	return $string;
	}

sub showhashsubset {	sub showhashsubset {
my ($hash,$keyre) = @_;	my ($hash,$keyre) = @_;
my $resultkey;	my $resultkey;
Line 207 sub showhashsubset {	Line 260 sub showhashsubset {
if ($resultkey =~ /$keyre/) {	if ($resultkey =~ /$keyre/) {
if (ref($$hash{$resultkey})) {	if (ref($$hash{$resultkey})) {
if ($$hash{$resultkey} =~ /ARRAY/ ) {	if ($$hash{$resultkey} =~ /ARRAY/ ) {
my $string="$resultkey ---- (";	&Apache::lonxml::debug("$resultkey ---- ".
foreach my $elm (@{ $$hash{$resultkey} }) {	&showarray($$hash{$resultkey}));
$string.="$elm,";	} elsif ($$hash{$resultkey} =~ /HASH/ ) {
}	&Apache::lonxml::debug("$resultkey ---- $$hash{$resultkey}");
chop($string);	&showhashsubset($$hash{$resultkey},'.');
&Apache::lonxml::debug("$string)");
} else {	} else {
&Apache::lonxml::debug("$resultkey ---- $$hash{$resultkey}");	&Apache::lonxml::debug("$resultkey ---- $$hash{$resultkey}");
}	}
} else {	} else {
&Apache::lonxml::debug("$resultkey ---- $$hash{$resultkey}");	&Apache::lonxml::debug("$resultkey ---- $$hash{$resultkey}");
Line 285 sub handle_save_or_undo {	Line 337 sub handle_save_or_undo {
return $error;	return $error;
}	}

	sub analyze_header {
	my ($request) = @_;
	my $result.='<html>
	<head><title>Analyzing a problem</title></head>
	<body bgcolor="#FFFFFF">
	<form name="lonhomework" method="POST" action="'.
	$ENV{'request.uri'}.'">
	<input type="submit" name="problemmode" value="EditXML" />
	<input type="submit" name="problemmode" value="Edit" />
	<hr />
	<input type="submit" name="submit" value="View" />
	<hr />
	List of possible answers:
	</form>';
	$request->print($result);
	$request->rflush();
	}

	sub analyze_footer {
	my ($request) = @_;
	my $result='</body></html>';
	$request->print($result);
	$request->rflush();
	}

sub analyze {	sub analyze {
my ($request,$file) = @_;	my ($request,$file) = @_;
&Apache::lonxml::debug("Analyze");	&Apache::lonxml::debug("Analyze");
my $result=&Apache::lonnet::ssi($request->uri,('grade_target' => 'analyze'));	my $result;
&Apache::lonxml::debug(":$result:");	my %overall;
(my $garbage,$result)=split(/_HASH_REF__/,$result,2);	my %allparts;
&showhash(&Apache::lonnet::str2hash($result));	my $rndseed=$ENV{'form.rndseed'};
return $result;	&analyze_header($request);
	my %prog_state=
	&Apache::lonhtmlcommon::Create_PrgWin($request,'Analyze Progress',
	'Getting Problem Variants',
	$ENV{'form.numtoanalyze'});
	for(my $i=1;$i<$ENV{'form.numtoanalyze'}+1;$i++) {
	&Apache::lonhtmlcommon::Increment_PrgWin($request,\%prog_state,
	'last problem');
	my $subresult=&Apache::lonnet::ssi($request->uri,
	('grade_target' => 'analyze'),
	('rndseed' => $i));
	&Apache::lonxml::debug(":$subresult:");
	(my $garbage,$subresult)=split(/_HASH_REF__/,$subresult,2);
	my %analyze=&Apache::lonnet::str2hash($subresult);
	my @parts;
	if (defined(@{ $analyze{'parts'} })) {
	@parts=@{ $analyze{'parts'} };
	}
	foreach my $part (@parts) {
	if (!exists($allparts{$part})) {$allparts{$part}=1;};
	if ($analyze{$part.'.type'} eq 'numericalresponse' \|\|
	$analyze{$part.'.type'} eq 'stringresponse' \|\|
	$analyze{$part.'.type'} eq 'formularesponse' ) {
	push( @{ $overall{$part.'.answer'} },
	[@{ $analyze{$part.'.answer'} }]);
	}
	}
	}
	&Apache::lonhtmlcommon::Update_PrgWin($request,\%prog_state,
	'Analyzing Results');
	foreach my $part (keys(%allparts)) {
	if (defined(@{ $overall{$part.'.answer'} })) {
	$request->print('<table><tr><td>Part '.$part.'</td></tr>');
	foreach my $answer (sort {$a->[0] <=> $b->[0]} (@{ $overall{$part.'.answer'} })) {
	$request->print('<tr><td>'.join('</td><td>',@{ $answer }).
	'</td></tr>');
	}
	$request->print('</table>');
	} else {
	$request->print('<p>Part '.$part.
	' is not analyzabale at this time</p>');
	}
	}
	&Apache::lonhtmlcommon::Close_PrgWin($request,\%prog_state);
	&analyze_footer($request);
	&Apache::lonhomework::showhash(%overall);
	return $result;
}	}

sub editxmlmode {	sub editxmlmode {
Line 315 sub editxmlmode {	Line 438 sub editxmlmode {
&renderpage($request,$file);	&renderpage($request,$file);
} else {	} else {
my ($rows,$cols) = &Apache::edit::textarea_sizes(\$problem);	my ($rows,$cols) = &Apache::edit::textarea_sizes(\$problem);
	my $xml_help = '<table><tr><td>'.
	&Apache::loncommon::help_open_topic("Problem_Editor_XML_Index",'Problem Editing Help')
	.'</td><td>'.
	&Apache::loncommon::help_open_topic("Greek_Symbols",'Greek Symbols',
	undef,undef,600)
	.'</td><td>'.
	&Apache::loncommon::help_open_topic("Other_Symbols",'Other Symbols',
	undef,undef,600)
	.'</td></tr></table>';
if ($cols > 80) { $cols = 80; }	if ($cols > 80) { $cols = 80; }
	if ($cols < 70) { $cols = 70; }
	if ($rows < 20) { $rows = 20; }
$result.='<html><body bgcolor="#FFFFFF">	$result.='<html><body bgcolor="#FFFFFF">
<form name="lonhomework" method="POST" action="'.	<form name="lonhomework" method="POST" action="'.
$ENV{'request.uri'}.'">	$ENV{'request.uri'}.'">
Line 327 sub editxmlmode {	Line 461 sub editxmlmode {
<input type="submit" name="submit" value="Submit Changes and View" />	<input type="submit" name="submit" value="Submit Changes and View" />
<input type="submit" name="Undo" value="undo" />	<input type="submit" name="Undo" value="undo" />
<hr />	<hr />
	' . $xml_help . '
<textarea rows="'.$rows.'" cols="'.$cols.'" name="editxmltext">'.	<textarea rows="'.$rows.'" cols="'.$cols.'" name="editxmltext">'.
&HTML::Entities::encode($problem).'</textarea>	&HTML::Entities::encode($problem).'</textarea>
</form></body></html>';	</form></body></html>';
Line 350 sub renderpage {	Line 485 sub renderpage {

my %mystyle;	my %mystyle;
my $result = '';	my $result = '';
&Apache::inputtags::initialize_inputtags;	if ($target eq 'analyze') { %Apache::lonhomework::analyze=(); }
&Apache::edit::initialize_edit;	if ($target eq 'answer') { &showhash(%Apache::lonhomework::history); }
if ($target eq 'analyze') { %Apache::lonhomework::anaylze=(); }	if ($target eq 'web') {&Apache::lonhomework::showhashsubset(\%ENV,'^form');}
if ($target eq 'web') {
my ($symb)=&Apache::lonxml::whichuser();
if ($symb eq '') {
if ($ENV{'request.state'} eq "construct") {
} else {
$request->print("Browsing or <a href=\"/adm/ambiguous\">ambiguous</a> reference, submissions ignored<br />");
}
}
#if ($Apache::lonhomework::viewgrades eq 'F') {&createmenu('grade',$request); }
}
#if ($target eq 'grade') { &showhash(%Apache::lonhomework::history); }
#if ($target eq 'web') { &showhash(%ENV); }

my $default=&Apache::lonnet::getfile('/home/httpd/html/res/adm/includes/default_homework.lcpm');
if ($default == -1) {
&Apache::lonxml::error("<b>Unable to find <i>default_homework.lcpm</i></b>");
$default='';
}
&Apache::lonxml::debug("Should be parsing now");	&Apache::lonxml::debug("Should be parsing now");
$result = &Apache::lonxml::xmlparse($request, $target, $problem,	$result = &Apache::lonxml::xmlparse($request, $target, $problem,
$default.&setup_vars($target),%mystyle);	&setup_vars($target),%mystyle);
	undef($Apache::lonhomework::parsing_a_problem);
#$request->print("Result follows:");	#$request->print("Result follows:");
if ($target eq 'modified') {	if ($target eq 'modified') {
&handle_save_or_undo($request,\$problem,\$result);	&handle_save_or_undo($request,\$problem,\$result);
Line 389 sub renderpage {	Line 507 sub renderpage {
#$result.="<br />Spent $td seconds processing target $target\n</body>";	#$result.="<br />Spent $td seconds processing target $target\n</body>";
#}	#}
$request->print($result);	$request->print($result);
	$request->rflush();
}	}
#$request->print(":Result ends");	#$request->print(":Result ends");
#my $td=&tv_interval($t0);	#my $td=&tv_interval($t0);
Line 400 sub renderpage {	Line 519 sub renderpage {
sub get_template_list {	sub get_template_list {
my ($namewanted,$extension) = @_;	my ($namewanted,$extension) = @_;
my $result;	my $result;
	my @allnames;
&Apache::lonxml::debug("Looking for :$extension:");	&Apache::lonxml::debug("Looking for :$extension:");
foreach my $file (</home/httpd/html/res/adm/includes/templates/*.$extension>) {	foreach my $file (</home/httpd/html/res/adm/includes/templates/*.$extension>) {
my $name=&Apache::lonnet::metadata($file,'title');	my $name=&Apache::lonnet::metadata($file,'title');
Line 407 sub get_template_list {	Line 527 sub get_template_list {
$result=$file;	$result=$file;
last;	last;
} else {	} else {
$result.="<option>$name</option>";	if ($name) { push (@allnames, $name); }
}	}
}	}
	if (@allnames && !$result) {
	$result="<option>Select a $extension type</option>\n<option>".
	join('</option><option>',sort(@allnames)).'</option>';
	}
return $result;	return $result;
}	}

Line 418 sub newproblem {	Line 542 sub newproblem {
my $extension=$request->uri;	my $extension=$request->uri;
$extension=~s:^.*\.([\w]+)$:$1:;	$extension=~s:^.*\.([\w]+)$:$1:;
&Apache::lonxml::debug("Looking for :$extension:");	&Apache::lonxml::debug("Looking for :$extension:");
if ($ENV{'form.template'}) {	if ($ENV{'form.template'} &&
	$ENV{'form.template'} ne "Select a $extension type") {
use File::Copy;	use File::Copy;
my $file = &get_template_list($ENV{'form.template'},$extension);	my $file = &get_template_list($ENV{'form.template'},$extension);
my $dest = &Apache::lonnet::filelocation("",$request->uri);	my $dest = &Apache::lonnet::filelocation("",$request->uri);
Line 433 sub newproblem {	Line 558 sub newproblem {
my $dest = &Apache::lonnet::filelocation("",$request->uri);	my $dest = &Apache::lonnet::filelocation("",$request->uri);
copy($templatefilename,$dest);	copy($templatefilename,$dest);
&renderpage($request,$dest);	&renderpage($request,$dest);
}else {	} else {
my $templatelist=&get_template_list('',$extension);	my $templatelist=&get_template_list('',$extension);
my $url=$request->uri;	my $url=$request->uri;
my $dest = &Apache::lonnet::filelocation("",$request->uri);	my $dest = &Apache::lonnet::filelocation("",$request->uri);
if (!defined($templatelist)) {	my $instructions;
# We didn't find a template, so just create a blank problem.	if ($templatelist) { $instructions=", select a template from the pull-down menu below.<br />Then";}
$request->print(<<ENDNEWPROBLEM);
<body bgcolor="#FFFFFF">
The requested file $url doesn\'t exist. You can create a new $extension <br />
<form action="$url" method="POST">
<input type="submit" name="newfile" value="New $extension"><br />
</form>
</body>
ENDNEWPROBLEM
return '';
}
$request->print(<<ENDNEWPROBLEM);	$request->print(<<ENDNEWPROBLEM);
<body bgcolor="#FFFFFF">	<body bgcolor="#FFFFFF">
The requested file $url doesn\'t exist. You can create a new $extension <br />	<h1>Creating a new $extension resource</h1>
<form action="$url" method="POST">	The requested file <tt>$url</tt> currently does not exist.
<input type="submit" value="New $extension"><br />	<p>
<select name="template">	To create a new $extension$instructions click on the "Create $extension" button.
$templatelist	</p>
</select>	<p><form action="$url" method="POST">
</form>
</body>
ENDNEWPROBLEM	ENDNEWPROBLEM
	if (defined($templatelist)) {
	$request->print("<select name=\"template\">$templatelist</select>");
	}
	$request->print("<br /><input type=\"submit\" name=\"newfile\" value=\"Create $extension\" />");
	$request->print("</form></p></body>");
}	}
return '';	return '';
}	}
Line 481 sub handler {	Line 599 sub handler {
#my $t0 = [&gettimeofday()];	#my $t0 = [&gettimeofday()];
my $request=$_[0];	my $request=$_[0];

if ( $ENV{'user.name'} eq 'albertel' ) {$Apache::lonxml::debug=1;}	# if ( $ENV{'user.name'} eq 'albertel' ) {$Apache::lonxml::debug=1;}
	$Apache::lonxml::debug=$ENV{'user.debug'};

if (&setupheader($request)) { return OK; }	if (&setupheader($request)) { return OK; }
$ENV{'request.uri'}=$request->uri;	$ENV{'request.uri'}=$request->uri;

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

Removed from v.1.81
changed lines
	Added in v.1.114