--- loncom/xml/lonxml.pm 2002/01/02 13:18:26 1.144
+++ loncom/xml/lonxml.pm 2002/09/04 21:01:33 1.193
@@ -1,7 +1,7 @@
# The LearningOnline Network with CAPA
# XML Parser Module
#
-# $Id: lonxml.pm,v 1.144 2002/01/02 13:18:26 matthew Exp $
+# $Id: lonxml.pm,v 1.193 2002/09/04 21:01:33 albertel Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -54,19 +54,22 @@
# 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,@taglist) = @_;
@@ -87,15 +90,15 @@ sub deregister {
}
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;
+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
@@ -126,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'}) {
@@ -167,16 +176,19 @@ sub xmlend {
unless (($hidden) && (!$seeid)) {
my $message=$contrib{$idx.':message'};
$message=~s/\n/\
/g;
+ $message=&Apache::lontexconvert::msgtexconverted($message);
if ($message) {
if ($hidden) {
$message=''.$message.'';
}
my $sender='Anonymous';
if ((!$contrib{$idx.':anonymous'}) || ($seeid)) {
- $sender=$contrib{$idx.':sendername'}.' at '.
- $contrib{$idx.':senderdomain'};
+ $sender=$contrib{$idx.':plainname'}.' ('.
+ $contrib{$idx.':sendername'}.' at '.
+ $contrib{$idx.':senderdomain'}.')';
if ($contrib{$idx.':anonymous'}) {
- $sender.=' (anonymous)';
+ $sender.=' [anonymous] '.
+ $contrib{$idx.':screenname'};
}
if ($seeid) {
if ($hidden) {
@@ -187,6 +199,10 @@ sub xmlend {
$symb.':::'.$idx.'">Hide';
}
}
+ } else {
+ if ($contrib{$idx.':screenname'}) {
+ $sender=''.$contrib{$idx.':screenname'}.'';
+ }
}
$discussion.='
'.$sender.' ('.
localtime($contrib{$idx.':timestamp'}).
@@ -288,11 +304,14 @@ sub printtokenheader {
$reply{'generation'};
if ($target eq 'web') {
+ my %idhash=&Apache::lonnet::idrget($tudom,($tuname));
return
''.
'Checked out for '.$plainname.
'
User: '.$tuname.' at '.$tudom.
+ '
ID: '.$idhash{$tuname}.
'
CourseID: '.$tcrsid.
+ '
Course: '.$ENV{'course.'.$tcrsid.'.description'}.
'
DocID: '.$token.
'
Time: '.localtime().'
';
} else {
@@ -311,46 +330,55 @@ sub fontsettings() {
sub registerurl {
my $forcereg=shift;
- if ($ENV{'request.publicaccess'}) {
- return
+ my $target = shift;
+ my $result = '';
+ if ($target eq 'edit') {
+ $result .="\n";
+ }
+ if ((($ENV{'request.publicaccess'}) ||
+ (!&Apache::lonnet::is_on_map($ENV{'REQUEST_URI'}))) &&
+ (!$forcereg)) {
+ return $result.
'';
}
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.=(<
// 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
@@ -358,7 +386,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
@@ -375,10 +403,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);
@@ -394,13 +424,14 @@ ENDPARM
ENDREGTHIS
} else {
- return (<
// 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);
@@ -421,8 +452,8 @@ ENDREGTHIS
// END LON-CAPA Internal
ENDDONOTREGTHIS
-
}
+ return $result;
}
sub loadevents() {
@@ -442,9 +473,26 @@ sub printalltags {
}
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'};
@@ -458,7 +506,7 @@ sub xmlparse {
($target, my @tenta) = split('&&',$target);
- my @stack = ();
+ my @stack = ();
my @parstack = ();
&initdepth;
@@ -480,7 +528,7 @@ sub htmlclean {
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;
@@ -491,6 +539,22 @@ 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)=@_;
my $finaloutput = '';
@@ -500,7 +564,12 @@ 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) {
@@ -528,8 +597,14 @@ sub inner_xmlparse {
} 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);
+ 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]"})) {
@@ -552,18 +627,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,'');
+ }
+ }
+ if (($token->[0] eq 'T') || ($token->[0] eq 'C') || ($token->[0] eq 'D') ) {
+ if ($target eq 'tex') {
+ $result=&latex_special_symbols($result,$stack,$parstack);
}
- $result = '';
- }
+ }
+
+ # 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);
}
@@ -576,6 +661,7 @@ sub inner_xmlparse {
# $finaloutput.=&endredirection;
# }
+
if (($ENV{'QUERY_STRING'}) && ($target eq 'web')) {
$finaloutput=&afterburn($finaloutput);
}
@@ -608,10 +694,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('Missing tag </'.$innerstack['-1'].'> in style');
- &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,
@@ -672,13 +764,13 @@ sub callsub {
}
if (!$deleted) {
if ($space) {
- #&Apache::lonxml::debug("Calling sub $sub in $space $metamode
\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
\n");
+ &Apache::lonxml::debug("NOT Calling sub $sub in $space $metamode");
if ($metamode <1) {
if (defined($token->[4]) && ($metamode < 1)) {
$currentstring = $token->[4];
@@ -712,7 +804,8 @@ sub callsub {
}
sub setup_globals {
- my ($target)=@_;
+ my ($request,$target)=@_;
+ $Apache::lonxml::request=$request;
$Apache::lonxml::registered = 0;
@Apache::lonxml::pwd=();
@Apache::lonxml::extlinks=();
@@ -741,6 +834,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;
@@ -864,8 +962,35 @@ sub decreasedepth {
#print "
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;
@@ -880,10 +1005,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);
@@ -898,7 +1023,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];
@@ -914,7 +1039,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]);
@@ -931,7 +1056,7 @@ sub parstring {
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\";"
}
@@ -961,16 +1086,8 @@ sub writeallows {
#
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;
- }
- }
- }
+ &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},
+ ['highlight','anchor','link']);
if ($ENV{'form.highlight'}) {
foreach (split(/\,/,$ENV{'form.highlight'})) {
my $anchorname=$_;
@@ -1006,13 +1123,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=(<
@@ -1026,28 +1143,67 @@ sub inserteditinfo {