--- loncom/xml/lonxml.pm 2001/08/15 14:03:03 1.112
+++ loncom/xml/lonxml.pm 2002/09/11 13:36:50 1.195
@@ -1,6 +1,41 @@
# The LearningOnline Network with CAPA
# XML Parser Module
#
+# $Id: lonxml.pm,v 1.195 2002/09/11 13:36:50 www 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
@@ -13,39 +48,57 @@
# 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 Gerd Kortemeyer
+# 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);
+qw(@pwd @outputstack $redirection $import @extlinks $metamode $evaluate %insertlist @namespace $prevent_entity_encode);
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;
+use HTML::LCParser();
+use HTML::TreeBuilder();
+use HTML::Entities();
+use Safe();
+use Safe::Hole();
+use Math::Cephes();
+use Math::Random();
+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);
}
}
+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::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
@@ -76,9 +129,15 @@ $evaluate = 1;
# stores the list of active tag namespaces
@namespace=();
+# if 0 all high ASCII characters will be encoded into HTML Entities
+$prevent_entity_encode=0;
+
# has the dynamic menu been updated to know about this resource
$Apache::lonxml::registered=0;
+# a pointer the the Apache request object
+$Apache::lonxml::request='';
+
sub xmlbegin {
my $output='';
if ($ENV{'browser.mathml'}) {
@@ -95,6 +154,7 @@ sub xmlbegin {
}
sub xmlend {
+ my ($discussiononly,$symb)=@_;
my $discussion='';
if ($ENV{'request.course.id'}) {
my $crs='/'.$ENV{'request.course.id'};
@@ -103,30 +163,40 @@ sub xmlend {
}
$crs=~s/\_/\//g;
my $seeid=&Apache::lonnet::allowed('rin',$crs);
- my $symb=&Apache::lonnet::symbread();
+ unless ($symb) {
+ $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>';
+ unless ($discussiononly) {
+ $discussion.=
+ '<address><hr />';
+ }
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;
+ $message=&Apache::lontexconvert::msgtexconverted($message);
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'};
+ $sender=&Apache::loncommon::aboutmewrapper(
+ $contrib{$idx.':plainname'},
+ $contrib{$idx.':sendername'},
+ $contrib{$idx.':senderdomain'}).' ('.
+ $contrib{$idx.':sendername'}.' at '.
+ $contrib{$idx.':senderdomain'}.')';
if ($contrib{$idx.':anonymous'}) {
- $sender.=' (anonymous)';
+ $sender.=' [anonymous] '.
+ $contrib{$idx.':screenname'};
}
if ($seeid) {
if ($hidden) {
@@ -137,6 +207,10 @@ sub xmlend {
$symb.':::'.$idx.'">Hide</a>';
}
}
+ } else {
+ if ($contrib{$idx.':screenname'}) {
+ $sender='<i>'.$contrib{$idx.':screenname'}.'</i>';
+ }
}
$discussion.='<p><b>'.$sender.'</b> ('.
localtime($contrib{$idx.':timestamp'}).
@@ -145,15 +219,80 @@ sub xmlend {
}
}
}
- $discussion.='</address>';
+ unless ($discussiononly) {
+ $discussion.='</address>';
+ }
+ }
+ if ($discussiononly) {
+ $discussion.=(<<ENDDISCUSS);
+<form action="/adm/feedback" method="post">
+<input type="submit" name="discuss" value="Post Discussion" />
+<input type="submit" name="anondiscuss" value="Post Anonymous Discussion" />
+<input type="hidden" name="symb" value="$symb" />
+<input type="hidden" name="sendit" value="true" />
+<br />
+<font size="1">Note: in anonymous discussion, your name is visible only to
+course faculty</font><br />
+<textarea name=comment cols=60 rows=10 wrap=hard></textarea>
+</form>
+ENDDISCUSS
}
}
}
- return $discussion.'</html>';
+ return $discussion.($discussiononly?'':'</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 checkout {
- my ($target,$symb,$tuname,$tudom,$tcrsid)=@_;
+sub maketoken {
+ my ($symb,$tuname,$tudom,$tcrsid)=@_;
unless ($symb) {
$symb=&Apache::lonnet::symbread();
}
@@ -162,26 +301,45 @@ sub checkout {
$tudom=$ENV{'user.domain'};
$tcrsid=$ENV{'request.course.id'};
}
- my $lonhost = $Apache::lonnet::perlvar{'lonHostID'};
- my $infostr=&Apache::lonnet::escape(
- $tuname.'&'.
- $tudom.'&'.
- $tcrsid.'&'.
- $symb.'&'.
- time.'&'.$ENV{'REMOTE_ADDR'});
- my $token=Apache::lonnet::reply('tmpput:'.$infostr,$lonhost);
- if ($token=~/^error\:/) { return ''; }
- $token=~s/^(\d+)\_.*\_(\d+)$/$1\_$2\_$lonhost/;
- if (&Apache::lonnet::log($tudom,$tuname,
- &Apache::lonnet::homeserver($tuname,$tudom),
- &Apache::lonnet::escape('Checkout '.$infostr.' - '.
- $token)) ne 'ok') {
- return '';
+
+ 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') {
- return '<img src="/cgi-bin/barcode.gif?encode='.$token.'" />';
+ 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;
+ return $token;
}
}
@@ -196,42 +354,55 @@ sub fontsettings() {
sub registerurl {
my $forcereg=shift;
- if ($Apache::lonxml::registered) { return ''; }
+ my $target = shift;
+ my $result = '';
+ if ($target eq 'edit') {
+ $result .="<script>\n".
+ "if (typeof menu != 'undefined') {menu.currentURL=null;}\n".
+ &Apache::loncommon::browser_and_searcher_javascript().
+ "\n</script>\n";
+ }
+ if ((($ENV{'request.publicaccess'}) ||
+ (!&Apache::lonnet::is_on_map($ENV{'REQUEST_URI'}))) &&
+ (!$forcereg)) {
+ return $result.
+ '<script>function LONCAPAreg(){} function LONCAPAstale(){}</script>';
+ }
+ if ($Apache::lonxml::registered && !$forcereg) { return ''; }
$Apache::lonxml::registered=1;
+ my $nothing='';
+ if ($ENV{'browser.type'} eq 'explorer') { $nothing='javascript:void(0);'; }
+ my $timesync='menu.syncclock(1000*'.time.');';
if (($ENV{'REQUEST_URI'}!~/^\/(res\/)*adm\//) || ($forcereg)) {
my $hwkadd='';
- if ($ENV{'REQUEST_URI'}=~/\.(problem|exam|quiz|assess|survey|form)$/) {
+ if ($ENV{'request.filename'}=~/\.(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")');
+ 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")');
+ menu.switchbutton(7,2,'pgrd.gif','problem','grades','gocmd("/adm/grades","gradingmenu")');
ENDGRDS
}
if (&Apache::lonnet::allowed('opa',$ENV{'request.course.id'})) {
$hwkadd.=(<<ENDPARM);
- menu.switchbutton
- (7,3,'pparm.gif','problem','parms',
- 'gocmd("/adm/parmset","set")');
+ menu.switchbutton(7,3,'pparm.gif','problem','parms','gocmd("/adm/parmset","set")');
ENDPARM
}
}
- return (<<ENDREGTHIS);
+ $result = (<<ENDREGTHIS);
<script language="JavaScript">
// BEGIN LON-CAPA Internal
function LONCAPAreg() {
- menu=window.open("","LONCAPAmenu");
+ menu=window.open("$nothing","LONCAPAmenu","",false);
menu.clearTimeout(menu.menucltim);
+ $timesync
menu.currentURL=window.location.pathname;
+ menu.reloadURL=window.location.pathname;
menu.currentStale=0;
menu.clearbut(3,1);
menu.switchbutton
@@ -239,7 +410,7 @@ ENDPARM
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)');
+ (8,2,'fdbk.gif','feedback','discuss','gopost("/adm/feedback",currentURL)');
menu.switchbutton
(8,3,'prt.gif','prepare','printout','gopost("/adm/printout",currentURL)');
menu.switchbutton
@@ -256,10 +427,12 @@ ENDPARM
}
function LONCAPAstale() {
- menu=window.open("","LONCAPAmenu");
+ menu=window.open("$nothing","LONCAPAmenu","",false);
menu.currentStale=1;
- menu.switchbutton
- (3,1,'reload.gif','return','location','go(currentURL)');
+ if (menu.reloadURL!='' && menu.reloadURL!= null) {
+ menu.switchbutton
+ (3,1,'reload.gif','return','location','go(reloadURL)');
+ }
menu.clearbut(7,1);
menu.clearbut(7,2);
menu.clearbut(7,3);
@@ -275,13 +448,14 @@ ENDPARM
ENDREGTHIS
} else {
- return (<<ENDDONOTREGTHIS);
+ $result = (<<ENDDONOTREGTHIS);
<script language="JavaScript">
// BEGIN LON-CAPA Internal
function LONCAPAreg() {
- menu=window.open("","LONCAPAmenu");
+ menu=window.open("$nothing","LONCAPAmenu","",false);
+ $timesync
menu.currentStale=1;
menu.clearbut(2,1);
menu.clearbut(2,3);
@@ -302,8 +476,8 @@ ENDREGTHIS
// END LON-CAPA Internal
</script>
ENDDONOTREGTHIS
-
}
+ return $result;
}
sub loadevents() {
@@ -317,14 +491,32 @@ sub unloadevents() {
sub printalltags {
my $temp;
foreach $temp (sort keys %Apache::lonxml::alltags) {
- &Apache::lonxml::debug("$temp -- $Apache::lonxml::alltags{$temp}");
+ &Apache::lonxml::debug("$temp -- ".
+ join(',',@{ $Apache::lonxml::alltags{$temp} }));
}
}
sub xmlparse {
- my ($target,$content_file_string,$safeinit,%style_for_target) = @_;
+ my ($request,$target,$content_file_string,$safeinit,%style_for_target) = @_;
+
+ &setup_globals($request,$target);
+#
+# do we have a course style file?
+#
+
+ if ($ENV{'request.course.id'}) {
+ my $bodytext=
+ $ENV{'course.'.$ENV{'request.course.id'}.'.default_xml_style'};
+ if ($bodytext) {
+ my $location=&Apache::lonnet::filelocation('',$bodytext);
+ my $styletext=&Apache::lonnet::getfile($location);
+ if ($styletext ne '-1') {
+ %style_for_target = (%style_for_target,
+ &Apache::style::styleparser($target,$styletext));
+ }
+ }
+ }
- &setup_globals($target);
#&printalltags();
my @pars = ();
my $pwd=$ENV{'request.filename'};
@@ -338,13 +530,15 @@ sub xmlparse {
($target, my @tenta) = split('&&',$target);
- my @stack = ();
+ 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;
}
@@ -353,12 +547,12 @@ sub htmlclean {
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)(.*?)\>/\<$1$2 \/\>/gis;
$output=~s/\<\/(br|hr|img|meta|allow)\>//gis;
unless ($full) {
$output=~s/\<[\/]*(body|head|html)\>//gis;
@@ -369,9 +563,24 @@ sub htmlclean {
return $output;
}
+sub latex_special_symbols {
+ my ($current_token,$stack,$parstack)=@_;
+ $current_token=~s/\\/\\char92 /g;
+ $current_token=~s/\^/\\char94 /g;
+ $current_token=~s/\~/\\char126 /g;
+ $current_token=~s/(&[^a-z#])/\\$1/g;
+ $current_token=~s/([^&]\#)/\\$1/g;
+ $current_token=~s/(\$|_|{|})/\\$1/g;
+ $current_token=~s/\\char92 /\\texttt{\\char92}/g;
+ $current_token=~s/>/\$>\$/g; #more
+ $current_token=~s/</\$<\$/g; #less
+ if ($current_token=~m/\d%/) {$current_token =~ s/(\d)%/$1\\%/g;} #percent after digit
+ if ($current_token=~m/\s%/) {$current_token =~ s/(\s)%/$1\\%/g;} #persent after space
+ return $current_token;
+}
+
sub inner_xmlparse {
my ($target,$stack,$parstack,$pars,$safeeval,$style_for_target)=@_;
- &Apache::lonxml::debug('Reentrant parser starting, again?');
my $finaloutput = '';
my $result;
my $token;
@@ -379,21 +588,26 @@ sub inner_xmlparse {
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];
+ my $text=$token->[1];
+ if ($token->[0] eq 'C' && $target eq 'tex') {
+ $text = '%'.$text;
+ $text =~ s/[\n\r]//g;
+ }
+ $result.=$text;
}
} elsif ($token->[0] eq 'PI') {
if ($metamode<1) {
$result=$token->[2];
}
} elsif ($token->[0] eq 'S') {
- # add tag to stack
+ # add tag to stack
push (@$stack,$token->[1]);
# add parameters list to another stack
push (@$parstack,&parstring($token));
- &increasedepth($token);
+ &increasedepth($token);
if (exists $$style_for_target{$token->[1]}) {
if ($Apache::lonxml::redirection) {
- $Apache::lonxml::outputstack['-1'] .=
+ $Apache::lonxml::outputstack['-1'] .=
&recurse($$style_for_target{$token->[1]},$target,$safeeval,
$style_for_target,@$parstack);
} else {
@@ -403,15 +617,21 @@ sub inner_xmlparse {
} 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);
+ my $lasttag=$$stack[-1];
+ if ($token->[1] =~ /^$lasttag$/i) {
+ &Apache::lonxml::warning('Using tag </'.$token->[1].'> as end tag to <'.$$stack[-1].'>');
+ last;
+ } else {
+ &Apache::lonxml::warning('Found tag </'.$token->[1].'> when looking for </'.$$stack[-1].'> in file');
+ &end_tag($stack,$parstack,$token);
+ }
}
-
- if (exists $$style_for_target{'/'."$token->[1]"}) {
+
+ if (exists($$style_for_target{'/'."$token->[1]"})) {
if ($Apache::lonxml::redirection) {
$Apache::lonxml::outputstack['-1'] .=
&recurse($$style_for_target{'/'."$token->[1]"},
@@ -421,7 +641,6 @@ sub inner_xmlparse {
$target,$safeeval,$style_for_target,
@$parstack);
}
-
} else {
$result = &callsub("end_$token->[1]", $target, $token, $stack,
$parstack, $pars,$safeeval, $style_for_target);
@@ -432,18 +651,28 @@ sub inner_xmlparse {
#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']);
- }
+ $result=&Apache::run::evaluate($result,$safeeval,$$parstack[-1]);
} else {
- $finaloutput .= &Apache::run::evaluate($result,$safeeval,'');
+ $result= &Apache::run::evaluate($result,$safeeval,'');
}
- $result = '';
- }
+ }
+ if (($token->[0] eq 'T') || ($token->[0] eq 'C') || ($token->[0] eq 'D') ) {
+ if ($target eq 'tex') {
+ $result=&latex_special_symbols($result,$stack,$parstack);
+ }
+ }
+
+ # Encode any high ASCII characters
+ if (!$Apache::lonxml::prevent_entity_encode) {
+ $result=&HTML::Entities::encode($result,"\200-\377");
+ }
+ if ($Apache::lonxml::redirection) {
+ $Apache::lonxml::outputstack['-1'] .= $result;
+ } else {
+ $finaloutput.=$result;
+ }
+ $result = '';
+
if ($token->[0] eq 'E') {
&end_tag($stack,$parstack,$token);
}
@@ -456,6 +685,7 @@ sub inner_xmlparse {
# $finaloutput.=&endredirection;
# }
+
if (($ENV{'QUERY_STRING'}) && ($target eq 'web')) {
$finaloutput=&afterburn($finaloutput);
}
@@ -472,6 +702,7 @@ sub recurse {
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') ) {
@@ -487,10 +718,16 @@ sub recurse {
$safeeval, $style_for_target);
} elsif ($tokenpat->[0] eq 'E') {
#clear out any tags that didn't end
- while ($tokenpat->[1] ne $innerstack[$#innerstack]
+ while ($tokenpat->[1] ne $innerstack[$#innerstack]
&& ($#innerstack > -1)) {
- &Apache::lonxml::warning("Unbalanced tags in resource $innerstack['-1']");
- &end_tag(\@innerstack,\@innerparstack,$tokenpat);
+ my $lasttag=$innerstack[-1];
+ if ($tokenpat->[1] =~ /^$lasttag$/i) {
+ &Apache::lonxml::warning('Using tag </'.$tokenpat->[1].'> as end tag to <'.$innerstack[-1].'>');
+ last;
+ } else {
+ &Apache::lonxml::warning('Found tag </'.$tokenpat->[1].'> when looking for </'.$innerstack[-1].'> in file');
+ &end_tag(\@innerstack,\@innerparstack,$tokenpat);
+ }
}
$partstring = &callsub("end_$tokenpat->[1]", $target, $tokenpat,
\@innerstack, \@innerparstack, \@pat,
@@ -523,6 +760,7 @@ sub recurse {
pop @pat;
pop @Apache::lonxml::pwd;
}
+ &Apache::lonxml::debug("Exiting Recursing");
return $output;
}
@@ -534,11 +772,11 @@ sub callsub {
my $sub1;
no strict 'refs';
my $tag=$token->[1];
- my $space=$Apache::lonxml::alltags{$tag};
+ my $space=$Apache::lonxml::alltags{$tag}[-1];
if (!$space) {
- $tag=~tr/A-Z/a-z/;
+ $tag=~tr/A-Z/a-z/;
$sub=~tr/A-Z/a-z/;
- $space=$Apache::lonxml::alltags{$tag}
+ $space=$Apache::lonxml::alltags{$tag}[-1]
}
my $deleted=0;
@@ -550,13 +788,13 @@ sub callsub {
}
if (!$deleted) {
if ($space) {
- #&Apache::lonxml::debug("Calling sub $sub in $space $metamode<br />\n");
+ &Apache::lonxml::debug("Calling sub $sub in $space $metamode");
$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");
+ &Apache::lonxml::debug("NOT Calling sub $sub in $space $metamode");
if ($metamode <1) {
if (defined($token->[4]) && ($metamode < 1)) {
$currentstring = $token->[4];
@@ -590,14 +828,21 @@ sub callsub {
}
sub setup_globals {
- my ($target)=@_;
+ my ($request,$target)=@_;
+ $Apache::lonxml::request=$request;
$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;
@@ -613,6 +858,11 @@ sub setup_globals {
$Apache::lonxml::metamode = 0;
$Apache::lonxml::evaluate = 0;
$Apache::lonxml::import = 0;
+ } elsif ($target eq 'analyze') {
+ $Apache::lonxml::redirection = 0;
+ $Apache::lonxml::metamode = 0;
+ $Apache::lonxml::evaluate = 1;
+ $Apache::lonxml::import = 1;
} else {
$Apache::lonxml::redirection = 0;
$Apache::lonxml::metamode = 0;
@@ -674,7 +924,10 @@ sub init_safespace {
#need to inspect this class of ops
# $safeeval->deny(":base_orig");
$safeinit .= ';$external::target="'.$target.'";';
- $safeinit .= ';$external::randomseed='.&Apache::lonnet::rndseed().';';
+ 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);
}
@@ -725,7 +978,7 @@ sub decreasedepth {
$Apache::lonxml::olddepth=$Apache::lonxml::depth+1;
}
if ( $Apache::lonxml::depth < -1) {
- &Apache::lonxml::warning("Unbalanced tags in resource");
+ &Apache::lonxml::warning("Missing tags, unable to properly run file.");
$Apache::lonxml::depth='-1';
}
my $curdepth=join('_',@Apache::lonxml::depthcounter);
@@ -733,8 +986,35 @@ sub decreasedepth {
#print "<br />e $Apache::lonxml::depth : $Apache::lonxml::olddepth : $token->[1] : $curdepth\n";
}
-sub get_all_text {
+sub get_all_text_unbalanced {
+#there is a copy of this in lonpublisher.pm
+ my($tag,$pars)= @_;
+ my $token;
+ my $result='';
+ $tag='<'.$tag.'>';
+ while ($token = $$pars[-1]->get_token) {
+ 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') {
+ $result.=$token->[4];
+ } elsif ($token->[0] eq 'E') {
+ $result.=$token->[2];
+ }
+ if ($result =~ /(.*)$tag(.*)/) {
+ &Apache::lonxml::debug('Got a winner with leftovers ::'.$2);
+ &Apache::lonxml::debug('Result is :'.$1);
+ $result=$1;
+ my $redo=$tag.$2;
+ &Apache::lonxml::newparser($pars,\$redo);
+ last;
+ }
+ }
+ return $result
+}
+sub get_all_text {
my($tag,$pars)= @_;
my $depth=0;
my $token;
@@ -749,10 +1029,10 @@ sub get_all_text {
} elsif ($token->[0] eq 'PI') {
$result.=$token->[2];
} elsif ($token->[0] eq 'S') {
- if ($token->[1] eq $tag) { $depth++; }
+ if ($token->[1] =~ /^$tag$/i) { $depth++; }
$result.=$token->[4];
} elsif ($token->[0] eq 'E') {
- if ( $token->[1] eq $tag) { $depth--; }
+ if ( $token->[1] =~ /^$tag$/i) { $depth--; }
#skip sending back the last end tag
if ($depth > -1) { $result.=$token->[2]; } else {
$pars->unget_token($token);
@@ -767,7 +1047,7 @@ sub get_all_text {
} elsif ($token->[0] eq 'PI') {
$result.=$token->[2];
} elsif ($token->[0] eq 'S') {
- if ( $token->[1] eq $tag) {
+ if ( $token->[1] =~ /^$tag$/i) {
$pars->unget_token($token); last;
} else {
$result.=$token->[4];
@@ -783,7 +1063,7 @@ sub get_all_text {
sub newparser {
my ($parser,$contentref,$dir) = @_;
- push (@$parser,HTML::TokeParser->new($contentref));
+ push (@$parser,HTML::LCParser->new($contentref));
$$parser['-1']->xml_mode('1');
if ( $dir eq '' ) {
push (@Apache::lonxml::pwd, $Apache::lonxml::pwd[$#Apache::lonxml::pwd]);
@@ -797,18 +1077,19 @@ sub newparser {
sub parstring {
my ($token) = @_;
my $temp='';
- map {
+ foreach (@{$token->[3]}) {
unless ($_=~/\W/) {
my $val=$token->[2]->{$_};
- $val =~ s/([\%\@\\])/\\$1/g;
+ $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};
@@ -816,9 +1097,11 @@ sub writeallows {
my $thisdir=$thisurl;
$thisdir=~s/\/[^\/]+$//;
my %httpref=();
- map {
+ foreach (@extlinks) {
$httpref{'httpref.'.
- &Apache::lonnet::hreflocation($thisdir,$_)}=$thisurl; } @extlinks;
+ &Apache::lonnet::hreflocation($thisdir,$_)}=$thisurl;
+ }
+ @extlinks=();
&Apache::lonnet::appenv(%httpref);
}
@@ -827,31 +1110,23 @@ sub writeallows {
#
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'}));
+ &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},
+ ['highlight','anchor','link']);
if ($ENV{'form.highlight'}) {
- map {
+ foreach (split(/\,/,$ENV{'form.highlight'})) {
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 {
+ 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;
- } split(/\,/,$ENV{'form.link'});
+ }
}
if ($ENV{'form.anchor'}) {
my $anchorname=$ENV{'form.anchor'};
@@ -872,13 +1147,13 @@ sub storefile {
if (my $fh=Apache::File->new('>'.$file)) {
print $fh $contents;
$fh->close();
+ } else {
+ &warning("Unable to save file $file");
}
}
-sub inserteditinfo {
- my ($result,$filecontents)=@_;
- unless ($filecontents) {
- $filecontents=(<<SIMPLECONTENT);
+sub createnewhtml {
+ my $filecontents=(<<SIMPLECONTENT);
<html>
<head>
<title>
@@ -892,28 +1167,67 @@ sub inserteditinfo {
</body>
</html>
SIMPLECONTENT
- }
- my $editheader='<a href="#editsection">Edit below</a><hr />';
+ return $filecontents;
+}
+
+
+sub inserteditinfo {
+ my ($result,$filecontents)=@_;
+ $filecontents = &HTML::Entities::encode($filecontents);
+# my $editheader='<a href="#editsection">Edit below</a><hr />';
+ my $buttons=(<<BUTTONS);
+<input type="submit" name="attemptclean"
+ value="Save and then attempt to clean HTML" />
+<input type="submit" name="savethisfile" value="Save this" />
+<input type="submit" name="viewmode" value="View" />
+BUTTONS
my $editfooter=(<<ENDFOOTER);
<hr />
<a name="editsection" />
<form method="post">
+<input type="hidden" name="editmode" value="Edit" />
+$buttons<br />
<textarea cols="80" rows="40" name="filecont">$filecontents</textarea>
+<br />$buttons
<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[^\>]*\>)/$1$editheader/is;
$result=~s/(\<\/body\>)/$editfooter/is;
return $result;
}
+sub get_target {
+ my $viewgrades=&Apache::lonnet::allowed('vgr',$ENV{'request.course.id'});
+ if ( $ENV{'request.state'} eq 'published') {
+ if ( defined($ENV{'form.grade_target'})
+ && ($viewgrades == 'F' )) {
+ return ($ENV{'form.grade_target'});
+ } elsif (defined($ENV{'form.grade_target'})) {
+ if (($ENV{'form.grade_target'} eq 'web') ||
+ ($ENV{'form.grade_target'} eq 'tex') ) {
+ return $ENV{'form.grade_target'}
+ } else {
+ return 'web';
+ }
+ } else {
+ return 'web';
+ }
+ } elsif ($ENV{'request.state'} eq 'construct') {
+ if ( defined($ENV{'form.grade_target'})) {
+ return ($ENV{'form.grade_target'});
+ } else {
+ return 'web';
+ }
+ } else {
+ return 'web';
+ }
+}
+
sub handler {
my $request=shift;
- my $target='web';
+ my $target=&get_target();
$Apache::lonxml::debug=0;
@@ -922,9 +1236,9 @@ sub handler {
} else {
$request->content_type('text/html');
}
-
+ &Apache::loncommon::no_cache($request);
$request->send_http_header;
-
+
return OK if $request->header_only;
@@ -938,7 +1252,7 @@ sub handler {
}
}
my %mystyle;
- my $result = '';
+ my $result = '';
my $filecontents=&Apache::lonnet::getfile($file);
if ($filecontents == -1) {
$result=(<<ENDNOTFOUND);
@@ -952,59 +1266,77 @@ sub handler {
</html>
ENDNOTFOUND
$filecontents='';
+ if ($ENV{'request.state'} ne 'published') {
+ $filecontents=&createnewhtml();
+ $ENV{'form.editmode'}='Edit'; #force edit mode
+ }
} else {
- unless ($ENV{'request.state'} eq 'published') {
- if ($ENV{'form.attemptclean'}) {
- $filecontents=&htmlclean($filecontents,1);
- }
+ unless ($ENV{'request.state'} eq 'published') {
+ if ($ENV{'form.attemptclean'}) {
+ $filecontents=&htmlclean($filecontents,1);
}
- $result = &Apache::lonxml::xmlparse($target,$filecontents,'',%mystyle);
+ }
+ if (!$ENV{'form.editmode'} || $ENV{'form.viewmode'}) {
+ $result = &Apache::lonxml::xmlparse($request,$target,$filecontents,
+ '',%mystyle);
+ }
}
#
# Edit action? Insert editing commands
#
unless ($ENV{'request.state'} eq 'published') {
+ if ($ENV{'form.editmode'} && (!($ENV{'form.viewmode'}))) {
+ my $displayfile=$request->uri;
+ $displayfile=~s/^\/[^\/]*//;
+ $result='<html><body bgcolor="#FFFFFF"><h3>'.$displayfile.
+ '</h3></body></html>';
$result=&inserteditinfo($result,$filecontents);
+ }
}
+ writeallows($request->uri);
+
$request->print($result);
- writeallows($request->uri);
return OK;
}
-
+
sub debug {
if ($Apache::lonxml::debug eq 1) {
- print("DEBUG:".$_[0]."<br />\n");
+ $|=1;
+ print("DEBUG:".&HTML::Entities::encode($_[0])."<br />\n");
}
}
sub error {
if (($Apache::lonxml::debug eq 1) || ($ENV{'request.state'} eq 'construct') ) {
- print "<b>ERROR:</b>".$_[0]."<br />\n";
+ # If printing in construction space, put the error inside <pre></pre>
+ print "<b>ERROR:</b>".join("\n",@_)."\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]);
+ &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 in $ENV{'request.filename'}",$_[0]);
+ &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'}",$_[0]);
+ &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>".$_[0]."<br />\n";
+ print "<b>W</b>ARNING<b>:</b>".join('<br />',@_)."<br />\n";
}
}
@@ -1013,7 +1345,26 @@ sub get_param {
if ( ! $context ) { $context = -1; }
my $args ='';
if ( $#$parstack > (-2-$context) ) { $args=$$parstack[$context]; }
- return &Apache::run::run("{$args;".'return $'.$param.'}',$safeeval); #'
+ if ( ! $args ) { return undef; }
+ 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 {
@@ -1026,13 +1377,16 @@ sub register_insert {
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++;
+ 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;
@@ -1040,7 +1394,7 @@ sub register_insert {
my $line = $data[$i];
my ($mnemonic,@which) = split(/ +/,$line);
my $tag = $insertlist{"$tagnum.tag"};
- for (my $j=0;$j <$#which;$j++) {
+ for (my $j=0;$j <=$#which;$j++) {
if ( $which[$j] eq 'Y' ) {
if ($insertlist{"$j.show"} ne 'no') {
push(@{ $insertlist{"$tag.which"} },$j);
@@ -1053,8 +1407,41 @@ sub register_insert {
sub description {
my ($token)=@_;
- return $insertlist{$insertlist{"$token->[1].num"}.'.description'};
+ 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__