Return to lonsimpleproblemedit.pm CVS log

Up to [LON-CAPA] / loncom / homework

Diff for /loncom/homework/lonsimpleproblemedit.pm between versions 1.6 and 1.26

version 1.6, 2003/09/21 21:40:06	version 1.26, 2009/09/24 00:50:03
Line 33 use Apache::Constants qw(:common :http);	Line 33 use Apache::Constants qw(:common :http);
use Apache::loncommon;	use Apache::loncommon;
use Apache::lonnet;	use Apache::lonnet;
use Apache::lonlocal;	use Apache::lonlocal;
	use Apache::lonnavmaps;
	use lib '/home/httpd/lib/perl/';
	use LONCAPA;


my %qparms;	my %qparms;
my $prefix;	my $prefix;
	my $weightprefix;
my $qtype;	my $qtype;

sub evaloptionhash {	sub evaloptionhash {
Line 50 sub evaloptionhash {	Line 55 sub evaloptionhash {
}	}

sub rawrendering {	sub rawrendering {
my ($request,$uri)=@_;	my ($symb)=@_;
my $problem=&Apache::lonnet::getfile	my %data=('show_errors'=>'on',
(&Apache::lonnet::filelocation('',$uri));	'simple_edit_button' => 'off',
&Apache::lonnet::devalidatecourseresdata(	'devalidatecourseresdata'=>'on');
$ENV{'course.'.$ENV{'request.course.id'}.'.num'},	return &Apache::loncommon::get_student_view($symb,time,time,
$ENV{'course.'.$ENV{'request.course.id'}.'.domain'});	$env{'request.course.id'},
my $uname=$ENV{'user.name'};	'web',\%data);
my $udom=$ENV{'user.domain'};
$ENV{'user.name'}=time;
$ENV{'user.domain'}=time;
my $result = &Apache::lonxml::xmlparse($request,'web', $problem);
$ENV{'user.name'}=$uname;
$ENV{'user.domain'}=$udom;
$result=~s/^.\<body[^\>]\>//si;
$result=~s/\<\/body[^\>]\>.$//si;
return $result;
}	}

sub questiontext {	sub questiontext {
my $text=$qparms{$prefix.'questiontext'};	my $text=$qparms{$prefix.'questiontext'};
	my $qt=&mt('Question Text');
	my $spell_link=
	&Apache::lonhtmlcommon::spelllink('simpleedit','questiontext');
return (<<ENDQUESTION);	return (<<ENDQUESTION);
<table bgcolor="#dddd22" cellspacing="4" cellpadding="2">	<table bgcolor="#dddd22" cellspacing="4" cellpadding="2" style="width:100%">
<tr><td><b>Question Text</b><br />	<tr><td><b>$qt</b><br />
<textarea name="questiontext" cols="80" rows="8">$text</textarea>	<textarea style="width:100%" name="questiontext" cols="80" rows="8">$text</textarea>
	<br />$spell_link
</td></tr>	</td></tr>
</table>	</table>
<br />	<br />
Line 82 ENDQUESTION	Line 82 ENDQUESTION

sub hint {	sub hint {
my $text=$qparms{$prefix.'hinttext'};	my $text=$qparms{$prefix.'hinttext'};
	my $ht=&mt('Hint Text');
	my $spell_link=
	&Apache::lonhtmlcommon::spelllink('simpleedit','hinttext');
return (<<ENDHINT);	return (<<ENDHINT);
<table bgcolor="#accacc" cellspacing="4" cellpadding="2">	<table bgcolor="#accacc" cellspacing="4" cellpadding="2">
<tr><td><b>Hint Text</b><br />	<tr><td><b>$ht</b><br />
<textarea name="hinttext" cols="80" rows="4">$text</textarea>	<textarea style="width:100%" name="hinttext" cols="80" rows="4">$text</textarea>
	<br />$spell_link
</td></tr>	</td></tr>
</table>	</table>
<br />	<br />
ENDHINT	ENDHINT
}	}

	sub script {
	my $text=$qparms{$prefix.'numericalscript'};
	my $ht=&mt('Scripting (optional)');
	return (<<ENDSCRIPT);
	<table bgcolor="#ccccaa" cellspacing="4" cellpadding="2">
	<tr><td><b>$ht</b><br />
	<textarea style="width:100%" name="numericalscript" cols="80" rows="4">$text</textarea>
	</td></tr>
	</table>
	<br />
	ENDSCRIPT
	}

sub foil {	sub foil {
my $number=shift;	my $number=shift;
my %values='';	my %values='';
Line 117 sub foil {	Line 134 sub foil {
my $selectposition=&Apache::loncommon::select_form	my $selectposition=&Apache::loncommon::select_form
($position,'position'.$number,%positions);	($position,'position'.$number,%positions);
my $text=$qparms{$prefix.'text'.$number};	my $text=$qparms{$prefix.'text'.$number};
	my %lt=&Apache::lonlocal::texthash('foil' => 'Foil',
	'value' => 'Value',
	'pos' => 'Position',
	'text' => 'Text');

	my $spell_link=
	&Apache::lonhtmlcommon::spelllink('simpleedit',"text$number");
return (<<ENDFOIL);	return (<<ENDFOIL);
<table bgcolor="#dd55ff" cellspacing="4" cellpadding="2">	<table bgcolor="#dd55ff" cellspacing="4" cellpadding="2">
<tr><td colspan="2"><b>Foil</b></td></tr>	<tr><td colspan="2"><b>$lt{'foil'}</b></td></tr>
<tr><td>Value: $selectvalue</td><td>Position: $selectposition</td></tr>	<tr><td>$lt{'value'}: $selectvalue</td><td>$lt{'pos'}: $selectposition</td></tr>
<tr><td colspan="2">Text:<br />	<tr><td colspan="2">$lt{'text'}:<br />
<textarea name="text$number" cols="80" rows="4">$text</textarea>	<textarea style="width:100%" name="text$number" cols="80" rows="4">$text</textarea>
	<br />$spell_link
</td></tr>	</td></tr>
</table>	</table>
<br />	<br />
ENDFOIL	ENDFOIL
}	}

	sub get_parent_uri {
	my ($cur_symb)=@_;
	my $navmap = Apache::lonnavmaps::navmap->new();
	if (defined($navmap)) {
	my $it = $navmap->getIterator(undef, undef, undef, 1);
	while ( my $res=$it->next()) {
	if (ref($res) && $res->symb() eq $cur_symb) { last; }
	}
	my ($src,$symb,$anchor)=&Apache::lonnavmaps::getLinkForResource($it->getStack());
	if (defined($anchor)) { $anchor='#'.$anchor; }
	return $src.'?symb='.&escape($symb).$anchor;
	}
	return;
	}

sub handler {	sub handler {
my $r = shift;	my $r = shift;

Line 139 sub handler {	Line 179 sub handler {
}	}

# -------------------------------------------------------------------- Allowed?	# -------------------------------------------------------------------- Allowed?
unless (&Apache::lonnet::allowed('mdc',$ENV{'request.course.id'})) {	unless (&Apache::lonnet::allowed('mdc',$env{'request.course.id'})) {
return HTTP_NOT_ACCEPTABLE;	return HTTP_NOT_ACCEPTABLE;
}	}
# ----------------------------------------------------------------- Send header	# ----------------------------------------------------------------- Send header
Line 148 sub handler {	Line 188 sub handler {
# ----------------------------------------------------- Figure out where we are	# ----------------------------------------------------- Figure out where we are
my $uri=$r->uri;	my $uri=$r->uri;
$uri=~s/\/smpedit$//;	$uri=~s/\/smpedit$//;
my $symb=&Apache::lonnet::symbread($uri);	my $symb=&Apache::lonnet::symbread();

# ------------------------------------------------ Prefix for everything stored	# ------------------------------------------------ Prefix for everything stored
$prefix=$ENV{'request.course.id'}.'.'.$symb.'.0.';	$prefix=$env{'request.course.id'}.'.'.$symb.'.0.';
	#------------------------------------------------- Prefix for storing weight of Problem Parts
	$weightprefix=$env{'request.course.id'}.'.'.$symb.'.';

# ---------------------------------------------------------- Anything to store?	# ---------------------------------------------------------- Anything to store?

if (($symb) && (defined($ENV{'form.questiontype'}))) {	if (($symb) && (defined($env{'form.questiontype'}))) {
my %storecontent=();	my %storecontent=();
undef %storecontent;	undef %storecontent;
if ($ENV{'form.questiontype'} eq 'option') {	if ($env{'form.questiontype'} eq 'option') {
my %curoptions=&evaloptionhash($ENV{'form.options'});	my %curoptions=&evaloptionhash($env{'form.options'});
if ($ENV{'form.delopt'}) {	if ($env{'form.delopt'}) {
delete $curoptions{$ENV{'form.delopt'}};	delete $curoptions{$env{'form.delopt'}};
}	}
if ($ENV{'form.newopt'}) {	if ($env{'form.newopt'}) {
$ENV{'form.newopt'}=~s/\'/\\\'/g;	$env{'form.newopt'}=~s/\'/\\\'/g;
$curoptions{$ENV{'form.newopt'}}=$ENV{'form.newopt'};	$curoptions{$env{'form.newopt'}}=$env{'form.newopt'};
}	}
$ENV{'form.options'}="('".join("','",keys %curoptions)."')";	$env{'form.options'}="('".join("','",keys %curoptions)."')";
}	}
foreach (keys %ENV) {	$env{'form.hiddenparts'}='!'.$env{'form.questiontype'};
	foreach (keys %env) {
if ($_=~/^form\.(\w+)$/) {	if ($_=~/^form\.(\w+)$/) {
my $parm=$1;	my $parm=$1;
$storecontent{$prefix.$parm}=$ENV{'form.'.$parm};	$storecontent{$prefix.$parm}=$env{'form.'.$parm};
$storecontent{$prefix.$parm}=~s/^\s+//s;	$storecontent{$prefix.$parm}=~s/^\s+//s;
$storecontent{$prefix.$parm}=~s/\s+$//s;	$storecontent{$prefix.$parm}=~s/\s+$//s;
}	}
}	}
	# ---------------------------------------------------- Set weights of hidden parts to zero
	# ------------------------------------------------------ and used part to 1
	$storecontent{$weightprefix.'essay.weight'}=0;
	$storecontent{$weightprefix.'numerical.weight'}=0;
	$storecontent{$weightprefix.'option.weight'}=0;
	$storecontent{$weightprefix.'radio.weight'}=0;
	$storecontent{$weightprefix.'string.weight'}=0;
	$storecontent{$weightprefix.$env{'form.questiontype'}.'.weight'}=1;


my $reply=&Apache::lonnet::cput	my $reply=&Apache::lonnet::cput
('resourcedata',\%storecontent,	('resourcedata',\%storecontent,
$ENV{'course.'.$ENV{'request.course.id'}.'.domain'},	$env{'course.'.$env{'request.course.id'}.'.domain'},
$ENV{'course.'.$ENV{'request.course.id'}.'.num'});	$env{'course.'.$env{'request.course.id'}.'.num'});

	&Apache::lonnet::devalidatecourseresdata(
	$env{'course.'.$env{'request.course.id'}.'.num'},
	$env{'course.'.$env{'request.course.id'}.'.domain'});

}	}
# ------------------------------------------------------------------- Read Data	# ------------------------------------------------------------------- Read Data

%qparms=&Apache::lonnet::dump('resourcedata',	%qparms=&Apache::lonnet::dump('resourcedata',
$ENV{'course.'.$ENV{'request.course.id'}.'.domain'},	$env{'course.'.$env{'request.course.id'}.'.domain'},
$ENV{'course.'.$ENV{'request.course.id'}.'.num'},	$env{'course.'.$env{'request.course.id'}.'.num'},
$ENV{'request.course.id'}.'.'.$symb);	$env{'request.course.id'}.'.'.$symb);

# ------------------------------------------------------------ Print the screen	# ------------------------------------------------------------ Print the screen
$r->print(<<ENDDOCUMENT);	my $spell_header=&Apache::lonhtmlcommon::spellheader();
<html>	$r->print(&Apache::loncommon::start_page('Simple Problem Editor',
<head>	$spell_header));
<title>The LearningOnline Network with CAPA</title>
ENDDOCUMENT
$r->print(&Apache::loncommon::bodytag('Simple Problem Editor'));
if ($symb) {	if ($symb) {
$r->print('<h1>'.&Apache::lonnet::gettitle($symb).'</h1>');	$r->print('<h1>'.&Apache::lonnet::gettitle($symb).'</h1>');
	my $displaylink = &get_parent_uri($symb);
	if ($displaylink ne '') {
	my $functions=&Apache::lonhtmlcommon::start_funclist()
	.&Apache::lonhtmlcommon::add_item_funclist(
	'<a href="'.$displaylink.'">'
	.&mt('Student View').'</a>')
	.&Apache::lonhtmlcommon::end_funclist();
	$r->print(&Apache::loncommon::head_subbox($functions));
	} else {
	$r->print('<p class="LC_error">'
	.&mt('An error occurred retrieving the link to this problem.')
	.'<br />'
	.&mt('You may need to [_1]re-select the course[_2] and then return to this resource to view it.'
	,'<a href="/adm/roles">','</a>')
	.'</p>'
	);
	}
	$r->print('<p class="LC_warning">'
	.&mt('Note: it can take up to 10 minutes for changes to take effect for all users.')
	.&Apache::loncommon::help_open_topic('Caching')
	.'</p>'
	);

$r->print('<table border="2" bgcolor="#FFFFFF" width="100%"><tr><td>'.	$r->print('<table border="2" bgcolor="#FFFFFF" width="100%"><tr><td>'.
&rawrendering($r,$uri).	&rawrendering($symb).
'</td></tr></table><br />');	'</td></tr></table><br />');
$r->print('<form method="post">');	$r->print('<form name="simpleedit" method="post">');
# Question Type	# Question Type
my %questiontypes=('radio' =>	my %questiontypes=('radio' =>
'1 out of N multiple choice (radio button)',	'1 out of N multiple choice (radio button)',
'option' => 'Option response',	'option' => 'Option response',
'string' => 'Short string response',	'string' => 'Short string response',
'essay' => 'Essay, open end');	'essay' => 'Essay, open end',
	'numerical' => 'Numerical response');
$qtype=$qparms{$prefix.'questiontype'};	$qtype=$qparms{$prefix.'questiontype'};
unless (defined($qtype)) { $qtype='radio'; }	unless (defined($qtype)) { $qtype='radio'; }
unless ($questiontypes{$qtype}) { $qtype='radio'; }	unless ($questiontypes{$qtype}) { $qtype='radio'; }
$r->print('<b>Question Type: '.&Apache::loncommon::select_form	$r->print('<b>'.&mt('Question Type').
	': '.&Apache::loncommon::select_form
($qtype,'questiontype',%questiontypes).	($qtype,'questiontype',%questiontypes).
'</b><br /><input type="submit" value="'.&mt('Store Changes').	'</b><br /><input type="submit" value="'.&mt('Save and Edit').
'" /><p> </p>');	'" /><p> </p>');
	# Script
	if ($qtype eq 'numerical') {
	$r->print(&script());
	}
# Question Text	# Question Text
$r->print(&questiontext());	$r->print(&questiontext());
# Radio, Option ===	# Radio, Option ===
Line 244 ENDDOCUMENT	Line 328 ENDDOCUMENT
$r->print(	$r->print(
'<table bgcolor="#ffcc22" cellspacing="4" cellpadding="2">'.	'<table bgcolor="#ffcc22" cellspacing="4" cellpadding="2">'.
'<tr><td><input type="hidden" name="options" value="'.	'<tr><td><input type="hidden" name="options" value="'.
$options.'" />Add new option: '.	$options.'" />'.&mt('Add new option').': '.
'<input type="text" name="newopt" size="15" />'.	'<input type="text" name="newopt" size="15" />'.
&mt('Delete an option').': '.	&mt('Delete an option').': '.
&Apache::loncommon::select_form('','delopt',('' => '',%optionshash)).	&Apache::loncommon::select_form('','delopt',('' => '',%optionshash)).
Line 276 ENDDOCUMENT	Line 360 ENDDOCUMENT
unless ($stringtypes{$stringtype}) { $stringtype='cs'; }	unless ($stringtypes{$stringtype}) { $stringtype='cs'; }
$r->print(	$r->print(
'<table bgcolor="#00ee44" cellspacing="4" cellpadding="2">'.	'<table bgcolor="#00ee44" cellspacing="4" cellpadding="2">'.
'<tr><td>'.&mt('Correct answer').': <input type="text" size="20" name="stringanswer" value="'.$stringanswer.'" />  '.	'<tr><td><label>'.&mt('Correct answer').': <input type="text" size="20" name="stringanswer" value="'.$stringanswer.'" /></label>  '.
&Apache::loncommon::select_form	&Apache::loncommon::select_form
($stringtype,'stringtype',%stringtypes).	($stringtype,'stringtype',%stringtypes).
'</td></tr></table><br />');	'</td></tr></table><br />');
# Hint	# Hint
$r->print(&hint());	$r->print(&hint());
}	}
	if ($qtype eq 'numerical') {
	my $numericalanswer=$qparms{$prefix.'numericalanswer'};
	unless (defined($numericalanswer)) { $numericalanswer=''; }
	my $numericaltolerance=$qparms{$prefix.'numericaltolerance'};
	unless (defined($numericaltolerance)) { $numericaltolerance='5%'; }
	my $numericalsigfigs=$qparms{$prefix.'numericalsigfigs'};
	unless (defined($numericalsigfigs)) { $numericalsigfigs='1,15'; }

	$r->print(
	'<table bgcolor="#00ee44" cellspacing="4" cellpadding="2">'.
	'<tr><td><label>'.&mt('Correct answer').': <input type="text" size="20" name="numericalanswer" value="'.$numericalanswer.'" /></label>  '.
	'<label>'.&mt('Unit').': <input type="text" size="5" name="numericalunit" value="'.$qparms{$prefix.'numericalunit'}.'" /></label>  '.
	'<label>'.&mt('Format').': <input type="text" size="5" name="numericalformat" value="'.$qparms{$prefix.'numericalformat'}.'" /></label>  '.
	'<label>'.&mt('Tolerance').': <input type="text" size="5" name="numericaltolerance" value="'.$numericaltolerance.'" /></label>  '.
	'<label>'.&mt('Significant digits').': <input type="text" size="5" name="numericalsigfigs" value="'.$numericalsigfigs.'" /></label>'.
	'</td></tr></table><br />');
	$r->print(&hint());
	}
# Store Button	# Store Button
$r->print(	$r->print(
'<input type="submit" value="'.&mt('Store Changes').'" /></form>');	'<input type="submit" value="'.&mt('Save and Edit').'" /></form>');
} else {	} else {
$r->print(&mt('Could not identify problem.'));	$r->print(&mt('Could not identify problem.'));
}	}
$r->print('</body></html>');	$r->print(&Apache::loncommon::end_page());
return OK;	return OK;
}	}

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.6
changed lines
	Added in v.1.26