File:
[LON-CAPA] /
loncom /
xml /
lonxml.pm
Revision
1.132:
download - view:
text,
annotated -
select for diffs
Mon Oct 1 20:06:45 2001 UTC (22 years, 7 months ago) by
albertel
Branches:
MAIN
CVS tags:
HEAD
- added get_param_var (Will also evaluate paramater values that look like variable references inside the safe spacebefore returning them, should successfully handle both arrays, and hashes.) (Should the extra code be integrated back into get_param?)
# The LearningOnline Network with CAPA
# XML Parser Module
#
# last modified 06/26/00 by Alexander Sakharuk
# 11/6 Gerd Kortemeyer
# 6/1/1 Gerd Kortemeyer
# 2/21,3/13 Guy
# 3/29,5/4 Gerd Kortemeyer
# 5/10 Scott Harrison
# 5/26 Gerd Kortemeyer
# 5/27 H. K. Ng
# 6/2,6/3,6/8,6/9 Gerd Kortemeyer
# 6/12,6/13 H. K. Ng
# 6/16 Gerd Kortemeyer
# 7/27 H. K. Ng
# 8/7,8/9,8/10,8/11,8/15,8/16,8/17,8/18,8/20,8/23,8/24 Gerd Kortemeyer
# Guy Albertelli
# 9/26 Gerd Kortemeyer
package Apache::lonxml;
use vars
qw(@pwd @outputstack $redirection $import @extlinks $metamode $evaluate %insertlist @namespace);
use strict;
use HTML::TokeParser;
use HTML::TreeBuilder;
use Safe;
use Safe::Hole;
use Math::Cephes qw(:trigs :hypers :bessels erf erfc);
use Math::Random qw(:all);
use Opcode;
sub register {
my $space;
my @taglist;
my $temptag;
($space,@taglist) = @_;
foreach $temptag (@taglist) {
$Apache::lonxml::alltags{$temptag}=$space;
}
}
use Apache::Constants qw(:common);
use Apache::lontexconvert;
use Apache::style;
use Apache::run;
use Apache::londefdef;
use Apache::scripttag;
use Apache::edit;
use Apache::lonnet;
use Apache::File;
#================================================== Main subroutine: xmlparse
#debugging control, to turn on debugging modify the correct handler
$Apache::lonxml::debug=0;
#path to the directory containing the file currently being processed
@pwd=();
#these two are used for capturing a subset of the output for later processing,
#don't touch them directly use &startredirection and &endredirection
@outputstack = ();
$redirection = 0;
#controls wheter the <import> tag actually does
$import = 1;
@extlinks=();
# meta mode is a bit weird only some output is to be turned off
#<output> tag turns metamode off (defined in londefdef.pm)
$metamode = 0;
# turns on and of run::evaluate actually derefencing var refs
$evaluate = 1;
# data structure for eidt mode, determines what tags can go into what other tags
%insertlist=();
# stores the list of active tag namespaces
@namespace=();
# has the dynamic menu been updated to know about this resource
$Apache::lonxml::registered=0;
sub xmlbegin {
my $output='';
if ($ENV{'browser.mathml'}) {
$output='<?xml version="1.0"?>'
.'<?xml-stylesheet type="text/css" href="/adm/MathML/mathml.css"?>'
.'<!DOCTYPE html SYSTEM "/adm/MathML/mathml.dtd" '
.'[<!ENTITY mathns "http://www.w3.org/1998/Math/MathML">]>'
.'<html xmlns:math="http://www.w3.org/1998/Math/MathML" '
.'xmlns="http://www.w3.org/TR/REC-html40">';
} else {
$output='<html>';
}
return $output;
}
sub xmlend {
my $discussion='';
if ($ENV{'request.course.id'}) {
my $crs='/'.$ENV{'request.course.id'};
if ($ENV{'request.course.sec'}) {
$crs.='_'.$ENV{'request.course.sec'};
}
$crs=~s/\_/\//g;
my $seeid=&Apache::lonnet::allowed('rin',$crs);
my $symb=&Apache::lonnet::symbread();
if ($symb) {
my %contrib=&Apache::lonnet::restore($symb,$ENV{'request.course.id'},
$ENV{'course.'.$ENV{'request.course.id'}.'.domain'},
$ENV{'course.'.$ENV{'request.course.id'}.'.num'});
if ($contrib{'version'}) {
$discussion.=
'<address><hr /><h2>Course Discussion of Resource</h2>';
my $idx;
for ($idx=1;$idx<=$contrib{'version'};$idx++) {
my $hidden=($contrib{'hidden'}=~/\.$idx\./);
unless (($hidden) && (!$seeid)) {
my $message=$contrib{$idx.':message'};
$message=~s/\n/\<br \/\>/g;
if ($message) {
if ($hidden) {
$message='<font color="#888888">'.$message.'</font>';
}
my $sender='Anonymous';
if ((!$contrib{$idx.':anonymous'}) || ($seeid)) {
$sender=$contrib{$idx.':sendername'}.' at '.
$contrib{$idx.':senderdomain'};
if ($contrib{$idx.':anonymous'}) {
$sender.=' (anonymous)';
}
if ($seeid) {
if ($hidden) {
$sender.=' <a href="/adm/feedback?unhide='.
$symb.':::'.$idx.'">Make Visible</a>';
} else {
$sender.=' <a href="/adm/feedback?hide='.
$symb.':::'.$idx.'">Hide</a>';
}
}
}
$discussion.='<p><b>'.$sender.'</b> ('.
localtime($contrib{$idx.':timestamp'}).
'):<blockquote>'.$message.
'</blockquote></p>';
}
}
}
$discussion.='</address>';
}
}
}
return $discussion.'</html>';
}
sub tokeninputfield {
my $defhost=$Apache::lonnet::perlvar{'lonHostID'};
$defhost=~tr/a-z/A-Z/;
return (<<ENDINPUTFIELD)
<script>
function updatetoken() {
var comp=new Array;
var barcode=unescape(document.tokeninput.barcode.value);
comp=barcode.split('*');
if (typeof(comp[0])!="undefined") {
document.tokeninput.codeone.value=comp[0];
}
if (typeof(comp[1])!="undefined") {
document.tokeninput.codetwo.value=comp[1];
}
if (typeof(comp[2])!="undefined") {
comp[2]=comp[2].toUpperCase();
document.tokeninput.codethree.value=comp[2];
}
document.tokeninput.barcode.value='';
}
</script>
<form method="post" name="tokeninput">
<table border="2" bgcolor="#FFFFBB">
<tr><th>DocID Checkin</th></tr>
<tr><td>
<table>
<tr>
<td>Scan in Barcode</td>
<td><input type="text" size="22" name="barcode"
onChange="updatetoken()"/></td>
</tr>
<tr><td><i>or</i> Type in DocID</td>
<td>
<input type="text" size="5" name="codeone" />
<b><font size="+2">*</font></b>
<input type="text" size="5" name="codetwo" />
<b><font size="+2">*</font></b>
<input type="text" size="10" name="codethree" value="$defhost"
onChange="this.value=this.value.toUpperCase()" />
</td></tr>
</table>
</td></tr>
<tr><td><input type="submit" value="Check in DocID" /></td></tr>
</table>
</form>
ENDINPUTFIELD
}
sub maketoken {
my ($symb,$tuname,$tudom,$tcrsid)=@_;
unless ($symb) {
$symb=&Apache::lonnet::symbread();
}
unless ($tuname) {
$tuname=$ENV{'user.name'};
$tudom=$ENV{'user.domain'};
$tcrsid=$ENV{'request.course.id'};
}
return &Apache::lonnet::checkout($symb,$tuname,$tudom,$tcrsid);
}
sub printtokenheader {
my ($target,$token,$symb,$tuname,$tudom,$tcrsid)=@_;
unless ($token) { return ''; }
unless ($symb) {
$symb=&Apache::lonnet::symbread();
}
unless ($tuname) {
$tuname=$ENV{'user.name'};
$tudom=$ENV{'user.domain'};
$tcrsid=$ENV{'request.course.id'};
}
my %reply=&Apache::lonnet::get('environment',
['firstname','middlename','lastname','generation'],
$tudom,$tuname);
my $plainname=$reply{'firstname'}.' '.
$reply{'middlename'}.' '.
$reply{'lastname'}.' '.
$reply{'generation'};
if ($target eq 'web') {
return
'<img align="right" src="/cgi-bin/barcode.gif?encode='.$token.'" />'.
'Checked out for '.$plainname.
'<br />User: '.$tuname.' at '.$tudom.
'<br />CourseID: '.$tcrsid.
'<br />DocID: '.$token.
'<br />Time: '.localtime().'<hr />';
} else {
return $token;
}
}
sub fontsettings() {
my $headerstring='';
if (($ENV{'browser.os'} eq 'mac') && (!$ENV{'browser.mathml'})) {
$headerstring.=
'<meta Content-Type="text/html; charset=x-mac-roman">';
}
return $headerstring;
}
sub registerurl {
my $forcereg=shift;
if ($ENV{'request.publicaccess'}) {
return
'<script>function LONCAPAreg(){} function LONCAPAstale(){}</script>';
}
if ($Apache::lonxml::registered && !$forcereg) { return ''; }
$Apache::lonxml::registered=1;
if (($ENV{'REQUEST_URI'}!~/^\/(res\/)*adm\//) || ($forcereg)) {
my $hwkadd='';
if ($ENV{'REQUEST_URI'}=~/\.(problem|exam|quiz|assess|survey|form)$/) {
if (&Apache::lonnet::allowed('vgr',$ENV{'request.course.id'})) {
$hwkadd.=(<<ENDSUBM);
menu.switchbutton
(7,1,'subm.gif','view sub','missions',
'gocmd("/adm/grades","submission")');
ENDSUBM
}
if (&Apache::lonnet::allowed('mgr',$ENV{'request.course.id'})) {
$hwkadd.=(<<ENDGRDS);
menu.switchbutton
(7,2,'pgrd.gif','problem','grades',
'gocmd("/adm/grades","viewgrades")');
ENDGRDS
}
if (&Apache::lonnet::allowed('opa',$ENV{'request.course.id'})) {
$hwkadd.=(<<ENDPARM);
menu.switchbutton
(7,3,'pparm.gif','problem','parms',
'gocmd("/adm/parmset","set")');
ENDPARM
}
}
return (<<ENDREGTHIS);
<script language="JavaScript">
// BEGIN LON-CAPA Internal
function LONCAPAreg() {
menu=window.open("","LONCAPAmenu");
menu.clearTimeout(menu.menucltim);
menu.currentURL=window.location.pathname;
menu.currentStale=0;
menu.clearbut(3,1);
menu.switchbutton
(6,3,'catalog.gif','catalog','info','catalog_info()');
menu.switchbutton
(8,1,'eval.gif','evaluate','this','gopost("/adm/evaluate",currentURL)');
menu.switchbutton
(8,2,'fdbk.gif','feedback','on this','gopost("/adm/feedback",currentURL)');
menu.switchbutton
(8,3,'prt.gif','prepare','printout','gopost("/adm/printout",currentURL)');
menu.switchbutton
(2,1,'back.gif','backward','','gopost("/adm/flip","back:"+currentURL)');
menu.switchbutton
(2,3,'forw.gif','forward','','gopost("/adm/flip","forward:"+currentURL)');
menu.switchbutton
(9,1,'sbkm.gif','set','bookmark','set_bookmark()');
menu.switchbutton
(9,2,'vbkm.gif','view','bookmark','edit_bookmarks()');
menu.switchbutton
(9,3,'anot.gif','anno-','tations','annotate()');
$hwkadd
}
function LONCAPAstale() {
menu=window.open("","LONCAPAmenu");
menu.currentStale=1;
menu.switchbutton
(3,1,'reload.gif','return','location','go(currentURL)');
menu.clearbut(7,1);
menu.clearbut(7,2);
menu.clearbut(7,3);
menu.menucltim=menu.setTimeout(
'clearbut(2,1);clearbut(2,3);clearbut(8,1);clearbut(8,2);clearbut(8,3);'+
'clearbut(9,1);clearbut(9,2);clearbut(9,3);clearbut(6,3)',
2000);
}
// END LON-CAPA Internal
</script>
ENDREGTHIS
} else {
return (<<ENDDONOTREGTHIS);
<script language="JavaScript">
// BEGIN LON-CAPA Internal
function LONCAPAreg() {
menu=window.open("","LONCAPAmenu");
menu.currentStale=1;
menu.clearbut(2,1);
menu.clearbut(2,3);
menu.clearbut(8,1);
menu.clearbut(8,2);
menu.clearbut(8,3);
if (menu.currentURL) {
menu.switchbutton
(3,1,'reload.gif','return','location','go(currentURL)');
} else {
menu.clearbut(3,1);
}
}
function LONCAPAstale() {
}
// END LON-CAPA Internal
</script>
ENDDONOTREGTHIS
}
}
sub loadevents() {
return 'LONCAPAreg();';
}
sub unloadevents() {
return 'LONCAPAstale();';
}
sub printalltags {
my $temp;
foreach $temp (sort keys %Apache::lonxml::alltags) {
&Apache::lonxml::debug("$temp -- $Apache::lonxml::alltags{$temp}");
}
}
sub xmlparse {
my ($target,$content_file_string,$safeinit,%style_for_target) = @_;
&setup_globals($target);
#&printalltags();
my @pars = ();
my $pwd=$ENV{'request.filename'};
$pwd =~ s:/[^/]*$::;
&newparser(\@pars,\$content_file_string,$pwd);
my $safeeval = new Safe;
my $safehole = new Safe::Hole;
&init_safespace($target,$safeeval,$safehole,$safeinit);
#-------------------- Redefinition of the target in the case of compound target
($target, my @tenta) = split('&&',$target);
my @stack = ();
my @parstack = ();
&initdepth;
my $finaloutput = &inner_xmlparse($target,\@stack,\@parstack,\@pars,
$safeeval,\%style_for_target);
if ($ENV{'request.uri'}) {
&writeallows($ENV{'request.uri'});
}
return $finaloutput;
}
sub htmlclean {
my ($raw,$full)=@_;
my $tree = HTML::TreeBuilder->new;
$tree->ignore_unknown(0);
$tree->parse($raw);
my $output= $tree->as_HTML(undef,' ');
$output=~s/\<(br|hr|img|meta|allow)([^\>\/]*)\>/\<$1$2 \/\>/gis;
$output=~s/\<\/(br|hr|img|meta|allow)\>//gis;
unless ($full) {
$output=~s/\<[\/]*(body|head|html)\>//gis;
}
$tree = $tree->delete;
return $output;
}
sub inner_xmlparse {
my ($target,$stack,$parstack,$pars,$safeeval,$style_for_target)=@_;
my $finaloutput = '';
my $result;
my $token;
while ( $#$pars > -1 ) {
while ($token = $$pars['-1']->get_token) {
if (($token->[0] eq 'T') || ($token->[0] eq 'C') || ($token->[0] eq 'D') ) {
if ($metamode<1) {
$result=$token->[1];
}
} elsif ($token->[0] eq 'PI') {
if ($metamode<1) {
$result=$token->[2];
}
} elsif ($token->[0] eq 'S') {
# add tag to stack
push (@$stack,$token->[1]);
# add parameters list to another stack
push (@$parstack,&parstring($token));
&increasedepth($token);
if (exists $$style_for_target{$token->[1]}) {
if ($Apache::lonxml::redirection) {
$Apache::lonxml::outputstack['-1'] .=
&recurse($$style_for_target{$token->[1]},$target,$safeeval,
$style_for_target,@$parstack);
} else {
$finaloutput .= &recurse($$style_for_target{$token->[1]},$target,
$safeeval,$style_for_target,@$parstack);
}
} else {
$result = &callsub("start_$token->[1]", $target, $token, $stack,
$parstack, $pars, $safeeval, $style_for_target);
}
} elsif ($token->[0] eq 'E') {
#clear out any tags that didn't end
while ($token->[1] ne $$stack['-1'] && ($#$stack > -1)) {
&Apache::lonxml::warning("Unbalanced tags in resource $$stack['-1']");
&end_tag($stack,$parstack,$token);
}
if (exists $$style_for_target{'/'."$token->[1]"}) {
if ($Apache::lonxml::redirection) {
$Apache::lonxml::outputstack['-1'] .=
&recurse($$style_for_target{'/'."$token->[1]"},
$target,$safeeval,$style_for_target,@$parstack);
} else {
$finaloutput .= &recurse($$style_for_target{'/'."$token->[1]"},
$target,$safeeval,$style_for_target,
@$parstack);
}
} else {
$result = &callsub("end_$token->[1]", $target, $token, $stack,
$parstack, $pars,$safeeval, $style_for_target);
}
} else {
&Apache::lonxml::error("Unknown token event :$token->[0]:$token->[1]:");
}
#evaluate variable refs in result
if ($result ne "") {
if ( $#$parstack > -1 ) {
if ($Apache::lonxml::redirection) {
$Apache::lonxml::outputstack['-1'] .=
&Apache::run::evaluate($result,$safeeval,$$parstack['-1']);
} else {
$finaloutput .= &Apache::run::evaluate($result,$safeeval,
$$parstack['-1']);
}
} else {
$finaloutput .= &Apache::run::evaluate($result,$safeeval,'');
}
$result = '';
}
if ($token->[0] eq 'E') {
&end_tag($stack,$parstack,$token);
}
}
pop @$pars;
pop @Apache::lonxml::pwd;
}
# if ($target eq 'meta') {
# $finaloutput.=&endredirection;
# }
if (($ENV{'QUERY_STRING'}) && ($target eq 'web')) {
$finaloutput=&afterburn($finaloutput);
}
return $finaloutput;
}
sub recurse {
my @innerstack = ();
my @innerparstack = ();
my ($newarg,$target,$safeeval,$style_for_target,@parstack) = @_;
my @pat = ();
&newparser(\@pat,\$newarg);
my $tokenpat;
my $partstring = '';
my $output='';
my $decls='';
while ( $#pat > -1 ) {
while ($tokenpat = $pat[$#pat]->get_token) {
if (($tokenpat->[0] eq 'T') || ($tokenpat->[0] eq 'C') || ($tokenpat->[0] eq 'D') ) {
if ($metamode<1) { $partstring=$tokenpat->[1]; }
} elsif ($tokenpat->[0] eq 'PI') {
if ($metamode<1) { $partstring=$tokenpat->[2]; }
} elsif ($tokenpat->[0] eq 'S') {
push (@innerstack,$tokenpat->[1]);
push (@innerparstack,&parstring($tokenpat));
&increasedepth($tokenpat);
$partstring = &callsub("start_$tokenpat->[1]", $target, $tokenpat,
\@innerstack, \@innerparstack, \@pat,
$safeeval, $style_for_target);
} elsif ($tokenpat->[0] eq 'E') {
#clear out any tags that didn't end
while ($tokenpat->[1] ne $innerstack[$#innerstack]
&& ($#innerstack > -1)) {
&Apache::lonxml::warning("Unbalanced tags in resource $innerstack['-1']");
&end_tag(\@innerstack,\@innerparstack,$tokenpat);
}
$partstring = &callsub("end_$tokenpat->[1]", $target, $tokenpat,
\@innerstack, \@innerparstack, \@pat,
$safeeval, $style_for_target);
} else {
&Apache::lonxml::error("Unknown token event :$tokenpat->[0]:$tokenpat->[1]:");
}
#pass both the variable to the style tag, and the tag we
#are processing inside the <definedtag>
if ( $partstring ne "" ) {
if ( $#parstack > -1 ) {
if ( $#innerparstack > -1 ) {
$decls= $parstack[$#parstack].$innerparstack[$#innerparstack];
} else {
$decls= $parstack[$#parstack];
}
} else {
if ( $#innerparstack > -1 ) {
$decls=$innerparstack[$#innerparstack];
} else {
$decls='';
}
}
$output .= &Apache::run::evaluate($partstring,$safeeval,$decls);
$partstring = '';
}
if ($tokenpat->[0] eq 'E') { pop @innerstack;pop @innerparstack;
&decreasedepth($tokenpat);}
}
pop @pat;
pop @Apache::lonxml::pwd;
}
return $output;
}
sub callsub {
my ($sub,$target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
my $currentstring='';
my $nodefault;
{
my $sub1;
no strict 'refs';
my $tag=$token->[1];
my $space=$Apache::lonxml::alltags{$tag};
if (!$space) {
$tag=~tr/A-Z/a-z/;
$sub=~tr/A-Z/a-z/;
$space=$Apache::lonxml::alltags{$tag}
}
my $deleted=0;
$Apache::lonxml::curdepth=join('_',@Apache::lonxml::depthcounter);
if (($token->[0] eq 'S') && ($target eq 'modified')) {
$deleted=&Apache::edit::handle_delete($space,$target,$token,$tagstack,
$parstack,$parser,$safeeval,
$style);
}
if (!$deleted) {
if ($space) {
#&Apache::lonxml::debug("Calling sub $sub in $space $metamode<br />\n");
$sub1="$space\:\:$sub";
($currentstring,$nodefault) = &$sub1($target,$token,$tagstack,
$parstack,$parser,$safeeval,
$style);
} else {
#&Apache::lonxml::debug("NOT Calling sub $sub in $space $metamode<br />\n");
if ($metamode <1) {
if (defined($token->[4]) && ($metamode < 1)) {
$currentstring = $token->[4];
} else {
$currentstring = $token->[2];
}
}
}
# &Apache::lonxml::debug("nodefalt:$nodefault:");
if ($currentstring eq '' && $nodefault eq '') {
if ($target eq 'edit') {
&Apache::lonxml::debug("doing default edit for $token->[1]");
if ($token->[0] eq 'S') {
$currentstring = &Apache::edit::tag_start($target,$token);
} elsif ($token->[0] eq 'E') {
$currentstring = &Apache::edit::tag_end($target,$token);
}
} elsif ($target eq 'modified') {
if ($token->[0] eq 'S') {
$currentstring = $token->[4];
$currentstring.=&Apache::edit::handle_insert();
} else {
$currentstring = $token->[2];
}
}
}
}
use strict 'refs';
}
return $currentstring;
}
sub setup_globals {
my ($target)=@_;
$Apache::lonxml::registered = 0;
@Apache::lonxml::pwd=();
@Apache::lonxml::extlinks=();
if ($target eq 'meta') {
$Apache::lonxml::redirection = 0;
$Apache::lonxml::metamode = 1;
$Apache::lonxml::evaluate = 1;
$Apache::lonxml::import = 0;
} elsif ($target eq 'answer') {
$Apache::lonxml::redirection = 0;
$Apache::lonxml::metamode = 1;
$Apache::lonxml::evaluate = 1;
$Apache::lonxml::import = 1;
} elsif ($target eq 'grade') {
&startredirection;
$Apache::lonxml::metamode = 0;
$Apache::lonxml::evaluate = 1;
$Apache::lonxml::import = 1;
} elsif ($target eq 'modified') {
$Apache::lonxml::redirection = 0;
$Apache::lonxml::metamode = 0;
$Apache::lonxml::evaluate = 0;
$Apache::lonxml::import = 0;
} elsif ($target eq 'edit') {
$Apache::lonxml::redirection = 0;
$Apache::lonxml::metamode = 0;
$Apache::lonxml::evaluate = 0;
$Apache::lonxml::import = 0;
} else {
$Apache::lonxml::redirection = 0;
$Apache::lonxml::metamode = 0;
$Apache::lonxml::evaluate = 1;
$Apache::lonxml::import = 1;
}
}
sub init_safespace {
my ($target,$safeeval,$safehole,$safeinit) = @_;
$safeeval->permit("entereval");
$safeeval->permit(":base_math");
$safeeval->permit("sort");
$safeeval->deny(":base_io");
$safehole->wrap(\&Apache::scripttag::xmlparse,$safeeval,'&xmlparse');
$safehole->wrap(\&Apache::lonnet::EXT,$safeeval,'&EXT');
$safehole->wrap(\&Math::Cephes::asin,$safeeval,'&asin');
$safehole->wrap(\&Math::Cephes::acos,$safeeval,'&acos');
$safehole->wrap(\&Math::Cephes::atan,$safeeval,'&atan');
$safehole->wrap(\&Math::Cephes::sinh,$safeeval,'&sinh');
$safehole->wrap(\&Math::Cephes::cosh,$safeeval,'&cosh');
$safehole->wrap(\&Math::Cephes::tanh,$safeeval,'&tanh');
$safehole->wrap(\&Math::Cephes::asinh,$safeeval,'&asinh');
$safehole->wrap(\&Math::Cephes::acosh,$safeeval,'&acosh');
$safehole->wrap(\&Math::Cephes::atanh,$safeeval,'&atanh');
$safehole->wrap(\&Math::Cephes::erf,$safeeval,'&erf');
$safehole->wrap(\&Math::Cephes::erfc,$safeeval,'&erfc');
$safehole->wrap(\&Math::Cephes::j0,$safeeval,'&j0');
$safehole->wrap(\&Math::Cephes::j1,$safeeval,'&j1');
$safehole->wrap(\&Math::Cephes::jn,$safeeval,'&jn');
$safehole->wrap(\&Math::Cephes::jv,$safeeval,'&jv');
$safehole->wrap(\&Math::Cephes::y0,$safeeval,'&y0');
$safehole->wrap(\&Math::Cephes::y1,$safeeval,'&y1');
$safehole->wrap(\&Math::Cephes::yn,$safeeval,'&yn');
$safehole->wrap(\&Math::Cephes::yv,$safeeval,'&yv');
$safehole->wrap(\&Math::Random::random_beta,$safeeval,'&math_random_beta');
$safehole->wrap(\&Math::Random::random_chi_square,$safeeval,'&math_random_chi_square');
$safehole->wrap(\&Math::Random::random_exponential,$safeeval,'&math_random_exponential');
$safehole->wrap(\&Math::Random::random_f,$safeeval,'&math_random_f');
$safehole->wrap(\&Math::Random::random_gamma,$safeeval,'&math_random_gamma');
$safehole->wrap(\&Math::Random::random_multivariate_normal,$safeeval,'&math_random_multivariate_normal');
$safehole->wrap(\&Math::Random::random_multinomial,$safeeval,'&math_random_multinomial');
$safehole->wrap(\&Math::Random::random_noncentral_chi_square,$safeeval,'&math_random_noncentral_chi_square');
$safehole->wrap(\&Math::Random::random_noncentral_f,$safeeval,'&math_random_noncentral_f');
$safehole->wrap(\&Math::Random::random_normal,$safeeval,'&math_random_normal');
$safehole->wrap(\&Math::Random::random_permutation,$safeeval,'&math_random_permutation');
$safehole->wrap(\&Math::Random::random_permuted_index,$safeeval,'&math_random_permuted_index');
$safehole->wrap(\&Math::Random::random_uniform,$safeeval,'&math_random_uniform');
$safehole->wrap(\&Math::Random::random_poisson,$safeeval,'&math_random_poisson');
$safehole->wrap(\&Math::Random::random_uniform_integer,$safeeval,'&math_random_uniform_integer');
$safehole->wrap(\&Math::Random::random_negative_binomial,$safeeval,'&math_random_negative_binomial');
$safehole->wrap(\&Math::Random::random_binomial,$safeeval,'&math_random_binomial');
$safehole->wrap(\&Math::Random::random_seed_from_phrase,$safeeval,'&random_seed_from_phrase');
$safehole->wrap(\&Math::Random::random_set_seed_from_phrase,$safeeval,'&random_set_seed_from_phrase');
$safehole->wrap(\&Math::Random::random_get_seed,$safeeval,'&random_get_seed');
$safehole->wrap(\&Math::Random::random_set_seed,$safeeval,'&random_set_seed');
#need to inspect this class of ops
# $safeeval->deny(":base_orig");
$safeinit .= ';$external::target="'.$target.'";';
my $rndseed;
my ($symb,$courseid,$domain,$name) = &Apache::lonxml::whichuser();
$rndseed=&Apache::lonnet::rndseed($symb,$courseid,$domain,$name);
$safeinit .= ';$external::randomseed='.$rndseed.';';
&Apache::run::run($safeinit,$safeeval);
}
sub startredirection {
$Apache::lonxml::redirection++;
push (@Apache::lonxml::outputstack, '');
}
sub endredirection {
if (!$Apache::lonxml::redirection) {
&Apache::lonxml::error("Endredirection was called, before a startredirection, perhaps you have unbalanced tags. Some debuging information:".join ":",caller);
return '';
}
$Apache::lonxml::redirection--;
pop @Apache::lonxml::outputstack;
}
sub end_tag {
my ($tagstack,$parstack,$token)=@_;
pop(@$tagstack);
pop(@$parstack);
&decreasedepth($token);
}
sub initdepth {
@Apache::lonxml::depthcounter=();
$Apache::lonxml::depth=-1;
$Apache::lonxml::olddepth=-1;
}
sub increasedepth {
my ($token) = @_;
$Apache::lonxml::depth++;
$Apache::lonxml::depthcounter[$Apache::lonxml::depth]++;
if ($Apache::lonxml::depthcounter[$Apache::lonxml::depth]==1) {
$Apache::lonxml::olddepth=$Apache::lonxml::depth;
}
my $curdepth=join('_',@Apache::lonxml::depthcounter);
&Apache::lonxml::debug("s $Apache::lonxml::depth : $Apache::lonxml::olddepth : $curdepth : $token->[1]\n");
#print "<br />s $Apache::lonxml::depth : $Apache::lonxml::olddepth : $curdepth : $token->[1]\n";
}
sub decreasedepth {
my ($token) = @_;
$Apache::lonxml::depth--;
if ($Apache::lonxml::depth<$Apache::lonxml::olddepth-1) {
$#Apache::lonxml::depthcounter--;
$Apache::lonxml::olddepth=$Apache::lonxml::depth+1;
}
if ( $Apache::lonxml::depth < -1) {
&Apache::lonxml::warning("Unbalanced tags in resource");
$Apache::lonxml::depth='-1';
}
my $curdepth=join('_',@Apache::lonxml::depthcounter);
&Apache::lonxml::debug("e $Apache::lonxml::depth : $Apache::lonxml::olddepth : $token->[1] : $curdepth\n");
#print "<br />e $Apache::lonxml::depth : $Apache::lonxml::olddepth : $token->[1] : $curdepth\n";
}
sub get_all_text {
my($tag,$pars)= @_;
my $depth=0;
my $token;
my $result='';
if ( $tag =~ m:^/: ) {
my $tag=substr($tag,1);
# &Apache::lonxml::debug("have:$tag:");
while (($depth >=0) && ($token = $pars->get_token)) {
# &Apache::lonxml::debug("e token:$token->[0]:$depth:$token->[1]");
if (($token->[0] eq 'T')||($token->[0] eq 'C')||($token->[0] eq 'D')) {
$result.=$token->[1];
} elsif ($token->[0] eq 'PI') {
$result.=$token->[2];
} elsif ($token->[0] eq 'S') {
if ($token->[1] eq $tag) { $depth++; }
$result.=$token->[4];
} elsif ($token->[0] eq 'E') {
if ( $token->[1] eq $tag) { $depth--; }
#skip sending back the last end tag
if ($depth > -1) { $result.=$token->[2]; } else {
$pars->unget_token($token);
}
}
}
} else {
while ($token = $pars->get_token) {
# &Apache::lonxml::debug("s token:$token->[0]:$depth:$token->[1]");
if (($token->[0] eq 'T')||($token->[0] eq 'C')||($token->[0] eq 'D')) {
$result.=$token->[1];
} elsif ($token->[0] eq 'PI') {
$result.=$token->[2];
} elsif ($token->[0] eq 'S') {
if ( $token->[1] eq $tag) {
$pars->unget_token($token); last;
} else {
$result.=$token->[4];
}
} elsif ($token->[0] eq 'E') {
$result.=$token->[2];
}
}
}
# &Apache::lonxml::debug("Exit:$result:");
return $result
}
sub newparser {
my ($parser,$contentref,$dir) = @_;
push (@$parser,HTML::TokeParser->new($contentref));
$$parser['-1']->xml_mode('1');
if ( $dir eq '' ) {
push (@Apache::lonxml::pwd, $Apache::lonxml::pwd[$#Apache::lonxml::pwd]);
} else {
push (@Apache::lonxml::pwd, $dir);
}
# &Apache::lonxml::debug("pwd:$#Apache::lonxml::pwd");
# &Apache::lonxml::debug("pwd:$Apache::lonxml::pwd[$#Apache::lonxml::pwd]");
}
sub parstring {
my ($token) = @_;
my $temp='';
map {
unless ($_=~/\W/) {
my $val=$token->[2]->{$_};
$val =~ s/([\%\@\\])/\\$1/g;
#if ($val =~ m/^[\%\@]/) { $val="\\".$val; }
$temp .= "my \$$_=\"$val\";"
}
} @{$token->[3]};
return $temp;
}
sub writeallows {
unless ($#extlinks>=0) { return; }
my $thisurl='/res/'.&Apache::lonnet::declutter(shift);
if ($ENV{'httpref.'.$thisurl}) {
$thisurl=$ENV{'httpref.'.$thisurl};
}
my $thisdir=$thisurl;
$thisdir=~s/\/[^\/]+$//;
my %httpref=();
map {
$httpref{'httpref.'.
&Apache::lonnet::hreflocation($thisdir,$_)}=$thisurl;
} @extlinks;
@extlinks=();
&Apache::lonnet::appenv(%httpref);
}
#
# Afterburner handles anchors, highlights and links
#
sub afterburn {
my $result=shift;
map {
my ($name, $value) = split(/=/,$_);
$value =~ tr/+/ /;
$value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
if (($name eq 'highlight')||($name eq 'anchor')||($name eq 'link')) {
unless ($ENV{'form.'.$name}) {
$ENV{'form.'.$name}=$value;
}
}
} (split(/&/,$ENV{'QUERY_STRING'}));
if ($ENV{'form.highlight'}) {
map {
my $anchorname=$_;
my $matchthis=$anchorname;
$matchthis=~s/\_+/\\s\+/g;
$result=~s/($matchthis)/\<font color=\"red\"\>$1\<\/font\>/gs;
} split(/\,/,$ENV{'form.highlight'});
}
if ($ENV{'form.link'}) {
map {
my ($anchorname,$linkurl)=split(/\>/,$_);
my $matchthis=$anchorname;
$matchthis=~s/\_+/\\s\+/g;
$result=~s/($matchthis)/\<a href=\"$linkurl\"\>$1\<\/a\>/gs;
} split(/\,/,$ENV{'form.link'});
}
if ($ENV{'form.anchor'}) {
my $anchorname=$ENV{'form.anchor'};
my $matchthis=$anchorname;
$matchthis=~s/\_+/\\s\+/g;
$result=~s/($matchthis)/\<a name=\"$anchorname\"\>$1\<\/a\>/s;
$result.=(<<"ENDSCRIPT");
<script>
document.location.hash='$anchorname';
</script>
ENDSCRIPT
}
return $result;
}
sub storefile {
my ($file,$contents)=@_;
if (my $fh=Apache::File->new('>'.$file)) {
print $fh $contents;
$fh->close();
}
}
sub inserteditinfo {
my ($result,$filecontents)=@_;
unless ($filecontents) {
$filecontents=(<<SIMPLECONTENT);
<html>
<head>
<title>
Title of Document Goes Here
</title>
</head>
<body bgcolor="#FFFFFF">
Body of Document Goes Here
</body>
</html>
SIMPLECONTENT
}
my $editheader='<a href="#editsection">Edit below</a><hr />';
my $editfooter=(<<ENDFOOTER);
<hr />
<a name="editsection" />
<form method="post">
<textarea cols="80" rows="40" name="filecont">$filecontents</textarea>
<br />
<input type="submit" name="attemptclean"
value="Save and then attempt to clean HTML" />
<input type="submit" name="savethisfile" value="Save this" />
</form>
ENDFOOTER
$result=~s/(\<body[^\>]*\>)/$1$editheader/is;
$result=~s/(\<\/body\>)/$editfooter/is;
return $result;
}
sub handler {
my $request=shift;
my $target='web';
$Apache::lonxml::debug=0;
if ($ENV{'browser.mathml'}) {
$request->content_type('text/xml');
} else {
$request->content_type('text/html');
}
$request->send_http_header;
return OK if $request->header_only;
my $file=&Apache::lonnet::filelocation("",$request->uri);
#
# Edit action? Save file.
#
unless ($ENV{'request.state'} eq 'published') {
if (($ENV{'form.savethisfile'}) || ($ENV{'form.attemptclean'})) {
&storefile($file,$ENV{'form.filecont'});
}
}
my %mystyle;
my $result = '';
my $filecontents=&Apache::lonnet::getfile($file);
if ($filecontents == -1) {
$result=(<<ENDNOTFOUND);
<html>
<head>
<title>File not found</title>
</head>
<body bgcolor="#FFFFFF">
<b>File not found: $file</b>
</body>
</html>
ENDNOTFOUND
$filecontents='';
} else {
unless ($ENV{'request.state'} eq 'published') {
if ($ENV{'form.attemptclean'}) {
$filecontents=&htmlclean($filecontents,1);
}
}
$result = &Apache::lonxml::xmlparse($target,$filecontents,'',%mystyle);
}
#
# Edit action? Insert editing commands
#
unless ($ENV{'request.state'} eq 'published') {
$result=&inserteditinfo($result,$filecontents);
}
writeallows($request->uri);
$request->print($result);
return OK;
}
sub debug {
if ($Apache::lonxml::debug eq 1) {
print("DEBUG:".$_[0]."<br />\n");
}
}
sub error {
if (($Apache::lonxml::debug eq 1) || ($ENV{'request.state'} eq 'construct') ) {
print "<b>ERROR:</b>".$_[0]."<br />\n";
} else {
print "<b>An Error occured while processing this resource. The instructor has been notified.</b> <br />";
#notify author
&Apache::lonmsg::author_res_msg($ENV{'request.filename'},$_[0]);
#notify course
if ( $ENV{'request.course.id'} ) {
my $users=$ENV{'course.'.$ENV{'request.course.id'}.'.comment.email'};
foreach my $user (split /\,/, $users) {
($user,my $domain) = split /:/, $user;
&Apache::lonmsg::user_normal_msg($user,$domain,"Error in $ENV{'request.filename'}",$_[0]);
}
}
#FIXME probably shouldn't have me get everything forever.
&Apache::lonmsg::user_normal_msg('albertel','msu',"Error in $ENV{'request.filename'}",$_[0]);
#&Apache::lonmsg::user_normal_msg('albertel','103',"Error in $ENV{'request.filename'}",$_[0]);
}
}
sub warning {
if ($ENV{'request.state'} eq 'construct') {
print "<b>W</b>ARNING<b>:</b>".$_[0]."<br />\n";
}
}
sub get_param {
my ($param,$parstack,$safeeval,$context) = @_;
if ( ! $context ) { $context = -1; }
my $args ='';
if ( $#$parstack > (-2-$context) ) { $args=$$parstack[$context]; }
if ( $args =~ /my \$$param=\"/ ) {
return &Apache::run::run("{$args;".'return $'.$param.'}',$safeeval); #'
} else {
return undef;
}
}
sub get_param_var {
my ($param,$parstack,$safeeval,$context) = @_;
if ( ! $context ) { $context = -1; }
my $args ='';
if ( $#$parstack > (-2-$context) ) { $args=$$parstack[$context]; }
if ( $args !~ /my \$$param=\"/ ) { return undef; }
my $value=&Apache::run::run("{$args;".'return $'.$param.'}',$safeeval); #'
if ($value =~ /^[\$\@\%]/) {
return &Apache::run::run("return $value",$safeeval,1);
} else {
return $value;
}
}
sub register_insert {
my @data = split /\n/, &Apache::lonnet::getfile('/home/httpd/lonTabs/insertlist.tab');
my $i;
my $tagnum=0;
my @order;
for ($i=0;$i < $#data; $i++) {
my $line = $data[$i];
if ( $line =~ /^\#/ || $line =~ /^\s*\n/) { next; }
if ( $line =~ /TABLE/ ) { last; }
my ($tag,$descrip,$color,$function,$show) = split(/,/, $line);
$insertlist{"$tagnum.tag"} = $tag;
$insertlist{"$tagnum.description"} = $descrip;
$insertlist{"$tagnum.color"} = $color;
$insertlist{"$tagnum.function"} = $function;
$insertlist{"$tagnum.show"}= $show;
$insertlist{"$tag.num"}=$tagnum;
$tagnum++;
}
$i++; #skipping TABLE line
$tagnum = 0;
for (;$i < $#data;$i++) {
my $line = $data[$i];
my ($mnemonic,@which) = split(/ +/,$line);
my $tag = $insertlist{"$tagnum.tag"};
for (my $j=0;$j <$#which;$j++) {
if ( $which[$j] eq 'Y' ) {
if ($insertlist{"$j.show"} ne 'no') {
push(@{ $insertlist{"$tag.which"} },$j);
}
}
}
$tagnum++;
}
}
sub description {
my ($token)=@_;
return $insertlist{$insertlist{"$token->[1].num"}.'.description'};
}
# ----------------------------------------------------------------- whichuser
# returns a list of $symb, $courseid, $domain, $name that is correct for
# calls to lonnet functions for this setup.
# - looks for form.grade_ parameters
sub whichuser {
my $symb=&Apache::lonnet::symbread();
my $courseid=$ENV{'request.course.id'};
my $domain=$ENV{'user.domain'};
my $name=$ENV{'user.name'};
if (defined($ENV{'form.grade_symb'})) {
my $tmp_courseid=$ENV{'form.grade_courseid'};
my $allowed=&Apache::lonnet::allowed('mgr',$tmp_courseid);
if ($allowed) {
$symb=$ENV{'form.grade_symb'};
$courseid=$ENV{'form.grade_courseid'};
$domain=$ENV{'form.grade_domain'};
$name=$ENV{'form.grade_username'};
}
}
return ($symb,$courseid,$domain,$name);
}
1;
__END__
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/back.gif){kind=icon}
Return to lonxml.pm CVS log ![[TXT]](/icons/text.gif){kind=icon}
![[DIR]](/icons/dir.gif){kind=icon}
Up to [LON-CAPA] / loncom / xml