--- loncom/xml/lonxml.pm 2000/07/20 15:37:54 1.12
+++ loncom/xml/lonxml.pm 2002/01/07 18:11:57 1.146
@@ -1,169 +1,714 @@
# The LearningOnline Network with CAPA
# XML Parser Module
#
+# $Id: lonxml.pm,v 1.146 2002/01/07 18:11:57 albertel Exp $
+#
+# Copyright Michigan State University Board of Trustees
+#
+# This file is part of the LearningOnline Network with CAPA (LON-CAPA).
+#
+# LON-CAPA is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# LON-CAPA is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with LON-CAPA; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+#
+# /home/httpd/html/adm/gpl.txt
+#
+# http://www.lon-capa.org/
+#
+# Copyright for TtHfunc and TtMfunc by Ian Hutchinson.
+# TtHfunc and TtMfunc (the "Code") may be compiled and linked into
+# binary executable programs or libraries distributed by the
+# Michigan State University (the "Licensee"), but any binaries so
+# distributed are hereby licensed only for use in the context
+# of a program or computational system for which the Licensee is the
+# primary author or distributor, and which performs substantial
+# additional tasks beyond the translation of (La)TeX into HTML.
+# The C source of the Code may not be distributed by the Licensee
+# to any other parties under any circumstances.
+#
# 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
+# Dec Guy Albertelli
+# YEAR=2002
+# 1/1 Gerd Kortemeyer
+# 1/2 Matthew Hall
+# 1/3 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;
+ my ($space,@taglist) = @_;
+ foreach my $temptag (@taglist) {
+ push(@{ $Apache::lonxml::alltags{$temptag} },$space);
}
}
-
-use Apache::style;
+
+sub deregister {
+ my ($space,@taglist) = @_;
+ foreach my $temptag (@taglist) {
+ my $tempspace = $Apache::lonxml::alltags{$temptag}[-1];
+ if ($tempspace eq $space) {
+ pop(@{ $Apache::lonxml::alltags{$temptag} });
+ }
+ }
+ #&printalltags();
+}
+
+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;
+use Apache::loncommon;
+
#================================================== 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,$tsymb,$tcrsid,$tudom,$tuname)=@_;
+ unless ($token) { return ''; }
+
+ my ($symb,$courseid,$domain,$name) = &Apache::lonxml::whichuser();
+ unless ($tsymb) {
+ $tsymb=$symb;
+ }
+ unless ($tuname) {
+ $tuname=$name;
+ $tudom=$domain;
+ $tcrsid=$courseid;
+ }
+
+ 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') {
+ my %idhash=&Apache::lonnet::idrget($tudom,($tuname));
+ return
+ '<img align="right" src="/cgi-bin/barcode.gif?encode='.$token.'" />'.
+ 'Checked out for '.$plainname.
+ '<br />User: '.$tuname.' at '.$tudom.
+ '<br />ID: '.$idhash{$tuname}.
+ '<br />CourseID: '.$tcrsid.
+ '<br />Course: '.$ENV{'course.'.$tcrsid.'.description'}.
+ '<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 -- ".
+ join(',',@{ $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 ($target,$content_file_string,%style_for_target) = @_;
- my $pars = HTML::TokeParser->new(\$content_file_string);
- my $currentstring = '';
- my $finaloutput = '';
- my $newarg = '';
my $safeeval = new Safe;
- $safeeval->permit("entereval");
+ 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);
-#------------------------- Stack definition (in stack we have all current tags)
-
my @stack = ();
my @parstack = ();
+ &initdepth;
-#------------------------------------- Parse input string (content_file_string)
-
- my $token;
-
- while ($token = $pars->get_token) {
- if ($token->[0] eq 'T') {
- $finaloutput .= &Apache::run::evaluate($token->[1],$safeeval,'');
- } elsif ($token->[0] eq 'S') {
- # add tag to stack
- push (@stack,$token->[1]);
- # add parameters list to another stack
- push (@parstack,&parstring($token));
-
- if (exists $style_for_target{$token->[1]}) {
- #basically recurse, but we never got more than one level down so just
- #create the new context here
- my @innerstack = ();
- my @innerparstack = ();
- # use style file definition
- $newarg = $style_for_target{$token->[1]};
- my $pat = HTML::TokeParser->new(\$newarg);
- my $tokenpat = '';
- my $partstring = '';
-
- while ($tokenpat = $pat->get_token) {
- if ($tokenpat->[0] eq 'T') {
- $partstring = $tokenpat->[1];
- } elsif ($tokenpat->[0] eq 'S') {
- push (@innerstack,$tokenpat->[1]);
- push (@innerparstack,&parstring($tokenpat));
- $partstring = &callsub("start_$tokenpat->[1]",
- $target, $tokenpat, \@innerparstack,
- $pat, $safeeval);
- } elsif ($tokenpat->[0] eq 'E') {
- #clear out any tags that didn't end
- while ($tokenpat->[1] ne $innerstack[$#innerstack]
- && ($#innerstack > 0)) {pop @innerstack;pop @innerparstack;}
- $partstring = &callsub("end_$tokenpat->[1]",
- $target, $tokenpat, \@innerparstack,
- $pat, $safeeval);
- }
- #pass both the variable to the style tag, and the tag we
- #are processing inside the <definedtag>
- $finaloutput .= &Apache::run::evaluate($partstring,$safeeval,
- $parstack[$#parstack].$innerparstack[$#innerparstack]);
- if ($tokenpat->[0] eq 'E') { pop @innerstack;pop @innerparstack; }
- }
- } else {
- my $result = &callsub("start_$token->[1]", $target, $token,\@parstack,
- $pars, $safeeval);
- $finaloutput .= &Apache::run::evaluate($result,$safeeval,
- $parstack[$#parstack]);
- }
- } elsif ($token->[0] eq 'E') {
- #clear out any tags that didn't end
- while ($token->[1] ne $stack[$#stack]
- && ($#stack > 0)) {pop @stack;pop @parstack;}
-
- if (exists $style_for_target{'/'."$token->[1]"}) {
- my @innerstack = ();
- my @innerparstack = ();
- $newarg = $style_for_target{'/'."$token->[1]"};
-
-# print "qqq: $token->[1],$newarg\n";
-
- my $pat = HTML::TokeParser->new(\$newarg);
- my $tokenpat;
- my $partstring = '';
-
- while ($tokenpat = $pat->get_token) {
- if ($tokenpat->[0] eq 'T') {
- $partstring = $tokenpat->[1];
- } elsif ($tokenpat->[0] eq 'S') {
- push (@innerstack,$tokenpat->[1]);
- push (@innerparstack,&parstring($tokenpat));
- $partstring = &callsub("start_$tokenpat->[1]",
- $target, $tokenpat, \@innerparstack,
- $pat, $safeeval);
- } elsif ($tokenpat->[0] eq 'E') {
- #clear out any tags that didn't end
- while ($tokenpat->[1] ne $innerstack[$#innerstack]
- && ($#innerstack > 0)) {pop @innerstack;pop @innerparstack;}
- $partstring = &callsub("end_$tokenpat->[1]",
- $target, $tokenpat, \@innerparstack,
- $pat, $safeeval);
- }
- #pass both the variable to the style tag, and the tag we
- #are processing inside the <definedtag>
- $finaloutput .= &Apache::run::evaluate($partstring,$safeeval,
- $parstack[$#parstack].$innerparstack[$#innerparstack]);
- if ($tokenpat->[0] eq 'E') { pop @innerstack;pop @innerparstack; }
- }
- } else {
- my $result = &callsub("end_$token->[1]", $target, $token, \@parstack,
- $pars,$safeeval);
- $finaloutput .= &Apache::run::evaluate($result,$safeeval,
- $parstack[$#parstack]);
- }
- pop @stack;
- pop @parstack;
- }
+ 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('Missing tag </'.$$stack['-1'].'> in file');
+ &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='';
+ &Apache::lonxml::debug("Recursing");
+ 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('Missing tag </'.$innerstack['-1'].'> in style');
+ &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;
+ }
+ &Apache::lonxml::debug("Exiting Recursing");
+ return $output;
+}
+
sub callsub {
- my ($sub,$target,$token,$parstack,$parser,$safeeval)=@_;
+ my ($sub,$target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
my $currentstring='';
+ my $nodefault;
{
+ my $sub1;
no strict 'refs';
- if (my $space=$Apache::lonxml::alltags{$token->[1]}) {
- #print "Calling sub $sub in $space \n";
- $sub="$space\:\:$sub";
- $currentstring = &$sub($target,$token,\@$parstack,$parser,$safeeval);
- } else {
- #print "NOT Calling sub $sub\n";
- if (defined($token->[4])) {
- $currentstring = $token->[4];
+ my $tag=$token->[1];
+ my $space=$Apache::lonxml::alltags{$tag}[-1];
+ if (!$space) {
+ $tag=~tr/A-Z/a-z/;
+ $sub=~tr/A-Z/a-z/;
+ $space=$Apache::lonxml::alltags{$tag}[-1]
+ }
+
+ 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 {
- $currentstring = $token->[2];
+ #&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';
@@ -171,16 +716,543 @@ sub callsub {
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("Missing tags, unable to properly run file.");
+ $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 {$temp .= "my \$$_=\"$token->[2]->{$_}\";"} @{$token->[3]};
+ foreach (@{$token->[3]}) {
+ unless ($_=~/\W/) {
+ my $val=$token->[2]->{$_};
+ $val =~ s/([\%\@\\])/\\$1/g;
+ #if ($val =~ m/^[\%\@]/) { $val="\\".$val; }
+ $temp .= "my \$$_=\"$val\";"
+ }
+ }
return $temp;
}
-1;
-__END__
+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=();
+ foreach (@extlinks) {
+ $httpref{'httpref.'.
+ &Apache::lonnet::hreflocation($thisdir,$_)}=$thisurl;
+ }
+ @extlinks=();
+ &Apache::lonnet::appenv(%httpref);
+}
+
+#
+# Afterburner handles anchors, highlights and links
+#
+sub afterburn {
+ my $result=shift;
+ foreach (split(/&/,$ENV{'QUERY_STRING'})) {
+ 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;
+ }
+ }
+ }
+ if ($ENV{'form.highlight'}) {
+ foreach (split(/\,/,$ENV{'form.highlight'})) {
+ my $anchorname=$_;
+ my $matchthis=$anchorname;
+ $matchthis=~s/\_+/\\s\+/g;
+ $result=~s/($matchthis)/\<font color=\"red\"\>$1\<\/font\>/gs;
+ }
+ }
+ if ($ENV{'form.link'}) {
+ foreach (split(/\,/,$ENV{'form.link'})) {
+ my ($anchorname,$linkurl)=split(/\>/,$_);
+ my $matchthis=$anchorname;
+ $matchthis=~s/\_+/\\s\+/g;
+ $result=~s/($matchthis)/\<a href=\"$linkurl\"\>$1\<\/a\>/gs;
+ }
+ }
+ 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');
+ }
+ &Apache::loncommon::no_cache($request);
+ $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) {
+ $|=1;
+ print("DEBUG:".join('<br />',@_)."<br />\n");
+ }
+}
+
+sub error {
+ if (($Apache::lonxml::debug eq 1) || ($ENV{'request.state'} eq 'construct') ) {
+ print "<b>ERROR:</b>".join('<br />',@_)."<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'},join('<br />',@_));
+ #notify course
+ if ( $ENV{'request.course.id'} ) {
+ my $users=$ENV{'course.'.$ENV{'request.course.id'}.'.comment.email'};
+ my $declutter=&Apache::lonnet::declutter($ENV{'request.filename'});
+ foreach my $user (split /\,/, $users) {
+ ($user,my $domain) = split /:/, $user;
+ &Apache::lonmsg::user_normal_msg($user,$domain,
+ "Error [$declutter]",join('<br />',@_));
+ }
+ }
+
+ #FIXME probably shouldn't have me get everything forever.
+ &Apache::lonmsg::user_normal_msg('albertel','msu',"Error in $ENV{'request.filename'}",join('<br />',@_));
+ #&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>".join('<br />',@_)."<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);
+ if ($tag) {
+ $insertlist{"$tagnum.tag"} = $tag;
+ $insertlist{"$tagnum.description"} = $descrip;
+ $insertlist{"$tagnum.color"} = $color;
+ $insertlist{"$tagnum.function"} = $function;
+ if (!defined($show)) { $show='yes'; }
+ $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)=@_;
+ my $tagnum;
+ my $tag=$token->[1];
+ foreach my $namespace (reverse @Apache::lonxml::namespace) {
+ my $testtag=$namespace.'::'.$tag;
+ $tagnum=$insertlist{"$testtag.num"};
+ if (defined($tagnum)) { last; }
+ }
+ if (!defined ($tagnum)) { $tagnum=$Apache::lonxml::insertlist{"$tag.num"}; }
+ return $insertlist{$tagnum.'.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,$courseid,$domain,$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'};
+ }
+ } else {
+ $symb=&Apache::lonnet::symbread();
+ $courseid=$ENV{'request.course.id'};
+ $domain=$ENV{'user.domain'};
+ $name=$ENV{'user.name'};
+ }
+ return ($symb,$courseid,$domain,$name);
+}
+
+1;
+__END__