--- loncom/xml/lonxml.pm 2002/04/10 14:46:30 1.166
+++ loncom/xml/lonxml.pm 2004/11/29 22:45:51 1.347
@@ -1,7 +1,7 @@
# The LearningOnline Network with CAPA
# XML Parser Module
#
-# $Id: lonxml.pm,v 1.166 2002/04/10 14:46:30 matthew Exp $
+# $Id: lonxml.pm,v 1.347 2004/11/29 22:45:51 albertel Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -36,33 +36,13 @@
# 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);
+qw(@pwd @outputstack $redirection $import @extlinks $metamode $evaluate %insertlist @namespace $errorcount $warningcount @htmlareafields);
use strict;
-use HTML::TokeParser();
+use HTML::LCParser();
use HTML::TreeBuilder();
use HTML::Entities();
use Safe();
@@ -70,6 +50,8 @@ use Safe::Hole();
use Math::Cephes();
use Math::Random();
use Opcode();
+use POSIX qw(strftime);
+use Time::HiRes qw( gettimeofday tv_interval );
sub register {
my ($space,@taglist) = @_;
@@ -95,15 +77,26 @@ use Apache::style();
use Apache::run();
use Apache::londefdef();
use Apache::scripttag();
+use Apache::languagetags();
use Apache::edit();
+use Apache::inputtags();
+use Apache::outputtags();
use Apache::lonnet();
use Apache::File();
use Apache::loncommon();
+use Apache::lonfeedback();
+use Apache::lonmsg();
+use Apache::loncacc();
+use Apache::lonlocal;
#================================================== Main subroutine: xmlparse
#debugging control, to turn on debugging modify the correct handler
$Apache::lonxml::debug=0;
+# keeps count of the number of warnings and errors generated in a parse
+$warningcount=0;
+$errorcount=0;
+
#path to the directory containing the file currently being processed
@pwd=();
@@ -132,8 +125,32 @@ $evaluate = 1;
# 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='';
+
+# a problem number counter, and check on ether it is used
+$Apache::lonxml::counter=1;
+$Apache::lonxml::counter_changed=0;
+
+#internal check on whether to look at style defs
+$Apache::lonxml::usestyle=1;
+
+#locations used to store the parameter string for style substitutions
+$Apache::lonxml::style_values='';
+$Apache::lonxml::style_end_values='';
+
+#array of ssi calls that need to occur after we are done parsing
+@Apache::lonxml::ssi_info=();
+
+#should we do the postag variable interpolation
+$Apache::lonxml::post_evaluate=1;
+
+#a header message to emit in the case of any generated warning or errors
+$Apache::lonxml::warnings_error_header='';
+
sub xmlbegin {
my $output='';
+ @htmlareafields=();
if ($ENV{'browser.mathml'}) {
$output=''
.''
@@ -142,80 +159,35 @@ sub xmlbegin {
.'';
} else {
- $output='';
+ $output='
+';
}
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.=
- '
Course Discussion of Resource
';
- 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/\ /g;
- if ($message) {
- if ($hidden) {
- $message=''.$message.'';
- }
- my $sender='Anonymous';
- if ((!$contrib{$idx.':anonymous'}) || ($seeid)) {
- $sender=$contrib{$idx.':plainname'}.' ('.
- $contrib{$idx.':sendername'}.' at '.
- $contrib{$idx.':senderdomain'}.')';
- if ($contrib{$idx.':anonymous'}) {
- $sender.=' [anonymous] '.
- $contrib{$idx.':screenname'};
- }
- if ($seeid) {
- if ($hidden) {
- $sender.=' Make Visible';
- } else {
- $sender.=' Hide';
- }
- }
- } else {
- if ($contrib{$idx.':screenname'}) {
- $sender=''.$contrib{$idx.':screenname'}.'';
- }
- }
- $discussion.='
\n");
+ #&Apache::lonnet::logthis($_[0]);
+ }
}
sub error {
- if (($Apache::lonxml::debug eq 1) || ($ENV{'request.state'} eq 'construct') ) {
- # If printing in construction space, put the error inside
- print "ERROR:
".join("\n",@_)."
\n";
- } else {
- print "An Error occured while processing this resource. The instructor has been notified. ";
- #notify author
- &Apache::lonmsg::author_res_msg($ENV{'request.filename'},join(' ',@_));
- #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(' ',@_));
- }
+ $errorcount++;
+ if (($Apache::lonxml::debug eq 1) || ($ENV{'request.state'} eq 'construct') ) {
+ # If printing in construction space, put the error inside
+ push(@Apache::lonxml::error_messages,
+ $Apache::lonxml::warnings_error_header.
+ "ERROR:".join(" \n",@_)." \n");
+ $Apache::lonxml::warnings_error_header='';
+ } else {
+ my $errormsg;
+ my ($symb)=&Apache::lonnet::symbread();
+ if ( !$symb ) {
+ #public or browsers
+ $errormsg=&mt("An error occured while processing this resource. The author has been notified.");
+ }
+ #notify author
+ &Apache::lonmsg::author_res_msg($ENV{'request.filename'},join(' ',@_));
+ #notify course
+ if ( $symb && $ENV{'request.course.id'} ) {
+ my (undef,%users)=&Apache::lonfeedback::decide_receiver(undef,0,1,1,1);
+ my $declutter=&Apache::lonnet::declutter($ENV{'request.filename'});
+ my @userlist;
+ foreach (keys %users) {
+ my ($user,$domain) = split(/:/, $_);
+ push(@userlist,"$user\@$domain");
+ &Apache::lonmsg::user_normal_msg($user,$domain,
+ "Error [$declutter]",join(' ',@_));
+ }
+ if ($ENV{'request.role.adv'}) {
+ $errormsg=&mt("An error occured while processing this resource. The course personnel ([_1]) and the author have been notified.",join(', ',@userlist));
+ } else {
+ $errormsg=&mt("An error occured while processing this resource. The instructor has been notified.");
+ }
+ }
+ push(@Apache::lonxml::error_messages,"$errormsg ");
}
-
- #FIXME probably shouldn't have me get everything forever.
- &Apache::lonmsg::user_normal_msg('albertel','msu',"Error in $ENV{'request.filename'}",join(' ',@_));
- #&Apache::lonmsg::user_normal_msg('albertel','103',"Error in $ENV{'request.filename'}",$_[0]);
- }
}
sub warning {
- if ($ENV{'request.state'} eq 'construct') {
- print "WARNING:".join(' ',@_)." \n";
- }
+ $warningcount++;
+
+ if ($ENV{'form.grade_target'} ne 'tex') {
+ if ($ENV{'request.state'} eq 'construct' || $Apache::lonxml::debug) {
+ my $request=$Apache::lonxml::request;
+ if (!$request) { $request=Apache->request; }
+ push(@Apache::lonxml::warning_messages,
+ $Apache::lonxml::warnings_error_header.
+ "WARNING:".join(' ',@_)." \n");
+ $Apache::lonxml::warnings_error_header='';
+ }
+ }
+}
+
+sub info {
+ if ($ENV{'form.grade_target'} ne 'tex'
+ && $ENV{'request.state'} eq 'construct') {
+ push(@Apache::lonxml::info_messages,join(' ',@_)." \n");
+ }
+}
+
+sub message_location {
+ return '__LONCAPA_INTERNAL_MESSAGE_LOCATION__';
+}
+
+sub add_messages {
+ my ($msg)=@_;
+ my $result=join(' ',
+ @Apache::lonxml::info_messages,
+ @Apache::lonxml::error_messages,
+ @Apache::lonxml::warning_messages);
+ undef(@Apache::lonxml::info_messages);
+ undef(@Apache::lonxml::error_messages);
+ undef(@Apache::lonxml::warning_messages);
+ $$msg=~s/__LONCAPA_INTERNAL_MESSAGE_LOCATION__/$result/;
+ $$msg=~s/__LONCAPA_INTERNAL_MESSAGE_LOCATION__//g;
}
sub get_param {
- my ($param,$parstack,$safeeval,$context) = @_;
- if ( ! $context ) { $context = -1; }
- my $args ='';
- if ( $#$parstack > (-2-$context) ) { $args=$$parstack[$context]; }
- if ( ! $args ) { return undef; }
- if ( $args =~ /my \$$param=\"/ ) {
- return &Apache::run::run("{$args;".'return $'.$param.'}',$safeeval); #'
- } else {
- return undef;
- }
+ my ($param,$parstack,$safeeval,$context,$case_insensitive) = @_;
+ if ( ! $context ) { $context = -1; }
+ my $args ='';
+ if ( $#$parstack > (-2-$context) ) { $args=$$parstack[$context]; }
+ if ( ! $Apache::lonxml::usestyle ) {
+ $args=$Apache::lonxml::style_values.$args;
+ }
+ if ( ! $args ) { return undef; }
+ if ( $case_insensitive ) {
+ if ($args =~ s/(my \$)(\Q$param\E)(=\")/$1.lc($2).$3/ei) {
+ return &Apache::run::run("{$args;".'return $'.$param.'}',
+ $safeeval); #'
+ } else {
+ return undef;
+ }
+ } else {
+ if ( $args =~ /my \$\Q$param\E=\"/ ) {
+ return &Apache::run::run("{$args;".'return $'.$param.'}',
+ $safeeval); #'
+ } else {
+ return undef;
+ }
+ }
}
sub get_param_var {
- my ($param,$parstack,$safeeval,$context) = @_;
+ my ($param,$parstack,$safeeval,$context,$case_insensitive) = @_;
if ( ! $context ) { $context = -1; }
my $args ='';
if ( $#$parstack > (-2-$context) ) { $args=$$parstack[$context]; }
- if ( $args !~ /my \$$param=\"/ ) { return undef; }
+ if ( ! $Apache::lonxml::usestyle ) {
+ $args=$Apache::lonxml::style_values.$args;
+ }
+ &Apache::lonxml::debug("Args are $args param is $param");
+ if ($case_insensitive) {
+ if (! ($args=~s/(my \$)(\Q$param\E)(=\")/$1.lc($2).$3/ei)) {
+ return undef;
+ }
+ } elsif ( $args !~ /my \$\Q$param\E=\"/ ) { return undef; }
my $value=&Apache::run::run("{$args;".'return $'.$param.'}',$safeeval); #'
- if ($value =~ /^[\$\@\%]/) {
- return &Apache::run::run("return $value",$safeeval,1);
+ &Apache::lonxml::debug("first run is $value");
+ if ($value =~ /^[\$\@\%][a-zA-Z_]\w*$/) {
+ &Apache::lonxml::debug("doing second");
+ my @result=&Apache::run::run("return $value",$safeeval,1);
+ if (!defined($result[0])) {
+ return $value
+ } else {
+ if (wantarray) { return @result; } else { return $result[0]; }
+ }
} else {
return $value;
}
@@ -1313,7 +1518,7 @@ sub register_insert {
my $line = $data[$i];
if ( $line =~ /^\#/ || $line =~ /^\s*\n/) { next; }
if ( $line =~ /TABLE/ ) { last; }
- my ($tag,$descrip,$color,$function,$show) = split(/,/, $line);
+ my ($tag,$descrip,$color,$function,$show,$helpfile,$helpdesc) = split(/,/, $line);
if ($tag) {
$insertlist{"$tagnum.tag"} = $tag;
$insertlist{"$tagnum.description"} = $descrip;
@@ -1321,6 +1526,8 @@ sub register_insert {
$insertlist{"$tagnum.function"} = $function;
if (!defined($show)) { $show='yes'; }
$insertlist{"$tagnum.show"}= $show;
+ $insertlist{"$tagnum.helpfile"} = $helpfile;
+ $insertlist{"$tagnum.helpdesc"} = $helpdesc;
$insertlist{"$tag.num"}=$tagnum;
$tagnum++;
}
@@ -1355,15 +1562,36 @@ sub description {
return $insertlist{$tagnum.'.description'};
}
+# Returns a list containing the help file, and the description
+sub helpinfo {
+ 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.'.helpfile'}, $insertlist{$tagnum.'.helpdesc'});
+}
+
# ----------------------------------------------------------------- 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);
+ my ($passedsymb)=@_;
+ my ($symb,$courseid,$domain,$name,$publicuser);
if (defined($ENV{'form.grade_symb'})) {
my $tmp_courseid=$ENV{'form.grade_courseid'};
- my $allowed=&Apache::lonnet::allowed('mgr',$tmp_courseid);
+ my $allowed=&Apache::lonnet::allowed('vgr',$tmp_courseid);
+ if (!$allowed &&
+ exists($ENV{'request.course.sec'}) &&
+ $ENV{'request.course.sec'} !~ /^\s*$/) {
+ $allowed=&Apache::lonnet::allowed('vgr',$ENV{'form.grade_courseid'}.
+ '/'.$ENV{'request.course.sec'});
+ }
if ($allowed) {
$symb=$ENV{'form.grade_symb'};
$courseid=$ENV{'form.grade_courseid'};
@@ -1371,12 +1599,22 @@ sub whichuser {
$name=$ENV{'form.grade_username'};
}
} else {
- $symb=&Apache::lonnet::symbread();
- $courseid=$ENV{'request.course.id'};
- $domain=$ENV{'user.domain'};
- $name=$ENV{'user.name'};
+ if (!$passedsymb) {
+ $symb=&Apache::lonnet::symbread();
+ } else {
+ $symb=$passedsymb;
+ }
+ $courseid=$ENV{'request.course.id'};
+ $domain=$ENV{'user.domain'};
+ $name=$ENV{'user.name'};
+ if ($name eq 'public' && $domain eq 'public') {
+ if (!defined($ENV{'form.username'})) {
+ $ENV{'form.username'}.=time.rand(10000000);
+ }
+ $name.=$ENV{'form.username'};
+ }
}
- return ($symb,$courseid,$domain,$name);
+ return ($symb,$courseid,$domain,$name,$publicuser);
}
1;