--- loncom/xml/lonxml.pm 2001/06/16 15:08:09 1.94 +++ loncom/xml/lonxml.pm 2001/08/06 19:44:54 1.105 @@ -11,6 +11,8 @@ # 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 package Apache::lonxml; use vars @@ -69,9 +71,12 @@ $evaluate = 1; # data structure for eidt mode, determines what tags can go into what other tags %insertlist=(); -#stores the list of active tag namespaces +# 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'}) { @@ -88,7 +93,31 @@ sub xmlbegin { } sub xmlend { - return ''; + my $discussion=''; + if ($ENV{'request.course.id'}) { + 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 $message=$contrib{$idx.':message'}; + $message=~s/\n/\
/g; + $discussion.='

'.$contrib{$idx.':sendername'}.' at '. + $contrib{$idx.':senderdomain'}.' ('. + localtime($contrib{$idx.':timestamp'}). + '):

'.$message. + '

'; + } + $discussion.='
'; + } + } + } + return $discussion.''; } sub fontsettings() { @@ -101,7 +130,10 @@ sub fontsettings() { } sub registerurl { - if ($ENV{'REQUEST_URI'}!~/^\/(res\/)*adm\//) { + my $forcereg=shift; + if ($Apache::lonxml::registered) { 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'})) { @@ -152,8 +184,7 @@ ENDPARM menu.switchbutton (9,2,'vbkm.gif','view','bookmark','edit_bookmarks()'); menu.switchbutton - (9,3,'anot.gif','anno-','tations','gopost("/adm/annotations",currentURL)'); - + (9,3,'anot.gif','anno-','tations','annotate()'); $hwkadd } @@ -225,37 +256,13 @@ sub printalltags { sub xmlparse { my ($target,$content_file_string,$safeinit,%style_for_target) = @_; - if ($target eq 'meta') { - $Apache::lonxml::redirection = 0; - $Apache::lonxml::metamode = 1; - $Apache::lonxml::evaluate = 1; - $Apache::lonxml::import = 0; - } 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; - } else { - $Apache::lonxml::redirection = 0; - $Apache::lonxml::metamode = 0; - $Apache::lonxml::evaluate = 1; - $Apache::lonxml::import = 1; - } + + &setup_globals($target); #&printalltags(); my @pars = (); - @Apache::lonxml::pwd=(); my $pwd=$ENV{'request.filename'}; $pwd =~ s:/[^/]*$::; &newparser(\@pars,\$content_file_string,$pwd); - my $currentstring = ''; - my $finaloutput = ''; - my $newarg = ''; - my $result; my $safeeval = new Safe; my $safehole = new Safe::Hole; @@ -267,94 +274,107 @@ sub xmlparse { my @stack = (); my @parstack = (); &initdepth; - my $token; - while ( $#pars > -1 ) { - while ($token = $pars[$#pars]->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[$#stack] && ($#stack > -1)) { - &Apache::lonxml::warning("Unbalanced tags in resource $stack['-1']"); - pop @stack;pop @parstack;&decreasedepth($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[$#parstack]); - } else { - $finaloutput .= &Apache::run::evaluate($result,$safeeval, - $parstack[$#parstack]); - } - } else { - $finaloutput .= &Apache::run::evaluate($result,$safeeval,''); - } - $result = ''; - } - if ($token->[0] eq 'E') { - pop @stack;pop @parstack;&decreasedepth($token); - } - } - pop @pars; - pop @Apache::lonxml::pwd; - } + my $finaloutput = &inner_xmlparse($target,\@stack,\@parstack,\@pars, + $safeeval,\%style_for_target); -# if ($target eq 'meta') { -# $finaloutput.=&endredirection; -# } + return $finaloutput; +} - if (($ENV{'QUERY_STRING'}) && ($target eq 'web')) { - $finaloutput=&afterburn($finaloutput); +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; + 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("Unbalanced tags in resource $$stack['-1']"); + &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; } - return $finaloutput; -} + # 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) = @_; @@ -382,7 +402,7 @@ sub recurse { while ($tokenpat->[1] ne $innerstack[$#innerstack] && ($#innerstack > -1)) { &Apache::lonxml::warning("Unbalanced tags in resource $innerstack['-1']"); - pop @innerstack;pop @innerparstack;&decreasedepth($tokenpat); + &end_tag(\@innerstack,\@innerparstack,$tokenpat); } $partstring = &callsub("end_$tokenpat->[1]", $target, $tokenpat, \@innerstack, \@innerparstack, \@pat, @@ -432,38 +452,47 @@ sub callsub { $sub=~tr/A-Z/a-z/; $space=$Apache::lonxml::alltags{$tag} } - if ($space) { - #&Apache::lonxml::debug("Calling sub $sub in $space $metamode
\n"); - $sub1="$space\:\:$sub"; - $Apache::lonxml::curdepth=join('_',@Apache::lonxml::depthcounter); - ($currentstring,$nodefault) = &$sub1($target,$token,$tagstack, - $parstack,$parser,$safeeval, - $style); - } else { - #&Apache::lonxml::debug("NOT Calling sub $sub in $space $metamode
\n"); - if ($metamode <1) { - if (defined($token->[4]) && ($metamode < 1)) { - $currentstring = $token->[4]; - } else { - $currentstring = $token->[2]; + + 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
\n"); + $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"); + 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]; + # &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]; + } } } } @@ -472,12 +501,45 @@ sub callsub { return $currentstring; } +sub setup_globals { + my ($target)=@_; + $Apache::lonxml::registered = 0; + @Apache::lonxml::pwd=(); + if ($target eq 'meta') { + $Apache::lonxml::redirection = 0; + $Apache::lonxml::metamode = 1; + $Apache::lonxml::evaluate = 1; + $Apache::lonxml::import = 0; + } 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'); @@ -542,6 +604,13 @@ sub endredirection { 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; @@ -809,7 +878,7 @@ ENDNOTFOUND sub debug { if ($Apache::lonxml::debug eq 1) { - print "DEBUG:".$_[0]."
\n"; + print("DEBUG:".$_[0]."
\n"); } } @@ -883,6 +952,11 @@ sub register_insert { $tagnum++; } } + +sub description { + my ($token)=@_; + return $insertlist{$insertlist{"$token->[1].num"}.'.description'}; +} 1; __END__