Return to lonhomework.pm CVS log

Up to [LON-CAPA] / loncom / homework

Diff for /loncom/homework/lonhomework.pm between versions 1.92 and 1.115

version 1.92, 2002/09/26 16:54:36	version 1.115, 2003/03/11 18:43:08
Line 48 use Apache::optionresponse();	Line 48 use Apache::optionresponse();
use Apache::imageresponse();	use Apache::imageresponse();
use Apache::essayresponse();	use Apache::essayresponse();
use Apache::externalresponse();	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 Apache::loncommon();
Line 144 $Apache::lonxml::browse='';	Line 146 $Apache::lonxml::browse='';
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");	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 ($thistype eq 'date_interval') {
if ($temp eq 'opendate') {	if ($temp eq 'opendate') {
$date=&Apache::lonnet::EXT("resource.$id.duedate")-$date;	$date=&Apache::lonnet::EXT("resource.$id.duedate")-$date;
Line 210 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 231 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 309 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 339 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 = Apache::loncommon::help_open_topic("Problem_Editor_XML_Index");	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 ($cols < 70) { $cols = 70; }
if ($rows < 20) { $rows = 20; }	if ($rows < 20) { $rows = 20; }
Line 354 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 . ' Problem Help<br>	' . $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 378 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 'analyze') { %Apache::lonhomework::anaylze=(); }
if ($target eq 'web') {
my ($symb)=&Apache::lonxml::whichuser();
if ($symb eq '') {
if ($ENV{'request.state'} eq "construct") {
} else {
my $help = Apache::loncommon::help_open_topic("Ambiguous_Reference");
$request->print("Browsing or <a href=\"/adm/ambiguous\">ambiguous</a> reference, submissions ignored $help<br />");
}
}
#if ($Apache::lonhomework::viewgrades eq 'F') {&createmenu('grade',$request); }
}
if ($target eq 'answer') { &showhash(%Apache::lonhomework::history); }	if ($target eq 'answer') { &showhash(%Apache::lonhomework::history); }
if ($target eq 'web') {&Apache::lonhomework::showhashsubset(\%ENV,'^form');}	if ($target eq 'web') {&Apache::lonhomework::showhashsubset(\%ENV,'^form');}

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 418 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 437 sub get_template_list {	Line 527 sub get_template_list {
$result=$file;	$result=$file;
last;	last;
} else {	} else {
push (@allnames, $name);	if ($name) { push (@allnames, $name); }
}	}
}	}
if (@allnames && !$result) {	if (@allnames && !$result) {
$result="<option>Select a $extension type</option>\n<option>".	$result="<option>Select a $extension template</option>\n<option>".
join('</option><option>',sort(@allnames)).'</option>';	join('</option><option>',sort(@allnames)).'</option>';
}	}
return $result;	return $result;
Line 473 sub newproblem {	Line 563 sub newproblem {
my $url=$request->uri;	my $url=$request->uri;
my $dest = &Apache::lonnet::filelocation("",$request->uri);	my $dest = &Apache::lonnet::filelocation("",$request->uri);
my $instructions;	my $instructions;
if ($templatelist) { $instructions=", select a template from the pull-down menu below. Then";}	if ($templatelist) { $instructions=", select a template from the pull-down menu below.<br />Then";}
$request->print(<<ENDNEWPROBLEM);	$request->print(<<ENDNEWPROBLEM);
<body bgcolor="#FFFFFF">	<body bgcolor="#FFFFFF">
The requested file $url doesn\'t exist. <br />	<h1>Creating a new $extension resource</h1>
To create a new $extension$instructions click on the Create $extension button.	The requested file <tt>$url</tt> currently does not exist.
<form action="$url" method="POST">	<p>
	To create a new $extension$instructions click on the "Create $extension" button.
	</p>
	<p><form action="$url" method="POST">
ENDNEWPROBLEM	ENDNEWPROBLEM
if (defined($templatelist)) {	if (defined($templatelist)) {
$request->print("<select name=\"template\">$templatelist</select>");	$request->print("<select name=\"template\">$templatelist</select>");
}	}
$request->print("<br /><input type=\"submit\" name=\"newfile\" value=\"Create $extension\" />");	$request->print("<br /><input type=\"submit\" name=\"newfile\" value=\"Create $extension\" />");
$request->print("</form></body>");	$request->print("</form></p></body>");
}	}
return '';	return '';
}	}
Line 507 sub handler {	Line 600 sub handler {
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>

500 Internal Server Error

Internal Server Error

The server encountered an internal error or misconfiguration and was unable to complete your request.

Please contact the server administrator at root@localhost to inform them of the time this error occurred, and the actions you performed just before this error.

More information about this error may be available in the server error log.

Removed from v.1.92
changed lines
	Added in v.1.115