--- loncom/xml/lonxml.pm 2002/12/06 17:56:53 1.218
+++ loncom/xml/lonxml.pm 2003/02/14 15:14:37 1.233
@@ -1,7 +1,7 @@
# The LearningOnline Network with CAPA
# XML Parser Module
#
-# $Id: lonxml.pm,v 1.218 2002/12/06 17:56:53 matthew Exp $
+# $Id: lonxml.pm,v 1.233 2003/02/14 15:14:37 www Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -41,7 +41,6 @@
# 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
@@ -146,7 +145,7 @@ $Apache::lonxml::registered=0;
$Apache::lonxml::request='';
# a problem number counter, and check on ether it is used
-$Apache::lonxml::counter=1;
+$Apache::lonxml::counter=4;
$Apache::lonxml::counter_changed=0;
#internal check on whether to look at style defs
@@ -192,7 +191,8 @@ sub xmlend {
my $idx;
for ($idx=1;$idx<=$contrib{'version'};$idx++) {
my $hidden=($contrib{'hidden'}=~/\.$idx\./);
- unless (($hidden) && (!$seeid)) {
+ my $deleted=($contrib{'deleted'}=~/\.$idx\./);
+ unless ((($hidden) && (!$seeid)) || ($deleted)) {
my $message=$contrib{$idx.':message'};
$message=~s/\n/\
/g;
$message=&Apache::lontexconvert::msgtexconverted($message);
@@ -226,8 +226,10 @@ sub xmlend {
} else {
$sender.=' Hide';
- }
- }
+ }
+ $sender.=' Delete';
+ }
} else {
if ($screenname) {
$sender=''.$screenname.'';
@@ -268,7 +270,7 @@ sub tokeninputfield {
my $defhost=$Apache::lonnet::perlvar{'lonHostID'};
$defhost=~tr/a-z/A-Z/;
return (<
+\n";
}
- if ((($ENV{'request.publicaccess'}) ||
+ if (($ENV{'browser.interface'} eq 'textual') ||
+ ((($ENV{'request.publicaccess'}) ||
(!&Apache::lonnet::is_on_map($ENV{'REQUEST_URI'}))) &&
- (!$forcereg)) {
+ (!$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 $reopen=&Apache::lonmenu::reopenmenu();
my $newmail='';
if (&Apache::lonmsg::newmail()) {
- $newmail='menu.setstatus("you have","messages");';
+ $newmail='swmenu.setstatus("you have","messages");';
}
- my $timesync='menu.syncclock(1000*'.time.');';
+ my $timesync='swmenu.syncclock(1000*'.time.');';
if (($ENV{'REQUEST_URI'}!~/^\/(res\/)*adm\//) || ($forcereg)) {
my $hwkadd='';
if ($ENV{'request.filename'}=~/\.(problem|exam|quiz|assess|survey|form)$/) {
if (&Apache::lonnet::allowed('vgr',$ENV{'request.course.id'})) {
$hwkadd.=(</\$>\$/g; #more
- $current_token=~s//\$>\$/g; #more
+ $current_token=~s/[0] eq 'E') {
&end_tag($stack,$parstack,$token);
}
- }
+ }
if ($#$pars > -1) {
pop @$pars;
pop @Apache::lonxml::pwd;
@@ -813,13 +812,13 @@ sub callsub {
}
if (!$deleted) {
if ($space) {
- &Apache::lonxml::debug("Calling sub $sub in $space $metamode");
+ #&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");
+ #&Apache::lonxml::debug("NOT Calling sub $sub in $space $metamode");
if ($metamode <1) {
if (defined($token->[4]) && ($metamode < 1)) {
$currentstring = $token->[4];
@@ -831,7 +830,7 @@ sub callsub {
# &Apache::lonxml::debug("nodefalt:$nodefault:");
if ($currentstring eq '' && $nodefault eq '') {
if ($target eq 'edit') {
- &Apache::lonxml::debug("doing default edit for $token->[1]");
+ #&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') {
@@ -1113,7 +1112,9 @@ sub store_counter {
sub get_all_text {
my($tag,$pars)= @_;
&Apache::lonxml::debug("Got a ".ref($pars));
+ my $gotfullstack=1;
if (ref($pars) ne 'ARRAY') {
+ $gotfullstack=0;
$pars=[$pars];
}
my $depth=0;
@@ -1122,7 +1123,8 @@ sub get_all_text {
if ( $tag =~ m:^/: ) {
my $tag=substr($tag,1);
#&Apache::lonxml::debug("have:$tag:");
- while (($depth >=0) && ($#$pars > -1)) {
+ my $top_empty=0;
+ while (($depth >=0) && ($#$pars > -1) && (!$top_empty)) {
while (($depth >=0) && ($token = $$pars[-1]->get_token)) {
#&Apache::lonxml::debug("e token:$token->[0]:$depth:$token->[1]:".$#$pars.":".$#Apache::lonxml::pwd);
if (($token->[0] eq 'T')||($token->[0] eq 'C')||($token->[0] eq 'D')) {
@@ -1140,11 +1142,21 @@ sub get_all_text {
}
}
}
+ if (($depth >=0) && ($#$pars == 0) ) { $top_empty=1; }
if (($depth >=0) && ($#$pars > 0) ) {
pop(@$pars);
pop(@Apache::lonxml::pwd);
}
}
+ if ($top_empty && $depth >= 0) {
+ #never found the end tag ran out of text, throw error send back blank
+ &error('Never found end tag for <'.$tag.'>');
+ if ($gotfullstack) {
+ my $newstring=''.$result;
+ &Apache::lonxml::newparser($pars,\$newstring);
+ }
+ $result='';
+ }
} else {
while ($#$pars > -1) {
while ($token = $$pars[-1]->get_token) {
@@ -1196,7 +1208,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\";"
}
@@ -1250,7 +1262,7 @@ sub afterburn {
$matchthis=~s/\_+/\\s\+/g;
$result=~s/($matchthis)/\$1\<\/a\>/s;
$result.=(<<"ENDSCRIPT");
-
ENDSCRIPT
@@ -1486,14 +1498,22 @@ sub get_param_var {
if ( ! $context ) { $context = -1; }
my $args ='';
if ( $#$parstack > (-2-$context) ) { $args=$$parstack[$context]; }
+ &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 =~ /^[\$\@\%]\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;
}