--- loncom/xml/lonxml.pm 2001/03/13 22:44:24 1.56 +++ loncom/xml/lonxml.pm 2001/08/10 16:22:23 1.110 @@ -5,16 +5,27 @@ # 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 Gerd Kortemeyer package Apache::lonxml; use vars -qw(@pwd @outputstack $redirection $textredirection $import @extlinks); +qw(@pwd @outputstack $redirection $import @extlinks $metamode $evaluate %insertlist @namespace); 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 Apache::Constants qw(:common); sub register { my $space; @@ -26,59 +37,270 @@ sub register { } } -sub printalltags { - my $temp; - foreach $temp (sort keys %Apache::lonxml::alltags) { - &Apache::lonxml::debug("$temp -- $Apache::lonxml::alltags{$temp}"); - } -} -use Apache::style; +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; + #================================================== Main subroutine: xmlparse +#debugging control, to turn on debugging modify the correct handler +$Apache::lonxml::debug=0; + +#path to the directory containing the file currently being processed @pwd=(); + +#these two are used for capturing a subset of the output for later processing, +#don't touch them directly use &startredirection and &endredirection @outputstack = (); $redirection = 0; + +#controls wheter the tag actually does $import = 1; @extlinks=(); -sub xmlparse { +# meta mode is a bit weird only some output is to be turned off +# tag turns metamode off (defined in londefdef.pm) +$metamode = 0; + +# turns on and of run::evaluate actually derefencing var refs +$evaluate = 1; + +# data structure for eidt mode, determines what tags can go into what other tags +%insertlist=(); + +# 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'}) { + $output='' + .'' + .']>' + .''; + } else { + $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.':sendername'}.' at '. + $contrib{$idx.':senderdomain'}; + if ($contrib{$idx.':anonymous'}) { + $sender.=' (anonymous)'; + } + if ($seeid) { + if ($hidden) { + $sender.=' Make Visible'; + } else { + $sender.=' Hide'; + } + } + } + $discussion.='

'.$sender.' ('. + localtime($contrib{$idx.':timestamp'}). + '):

'.$message. + '

'; + } + } + } + $discussion.='
'; + } + } + } + return $discussion.''; +} + +sub fontsettings() { + my $headerstring=''; + if (($ENV{'browser.os'} eq 'mac') && (!$ENV{'browser.mathml'})) { + $headerstring.= + ''; + } + return $headerstring; +} + +sub registerurl { + 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'})) { + $hwkadd.=(< +// BEGIN LON-CAPA Internal + + function LONCAPAreg() { + menu=window.open("","LONCAPAmenu"); + menu.clearTimeout(menu.menucltim); + menu.currentURL=window.location.pathname; + menu.currentStale=0; + menu.clearbut(3,1); + menu.switchbutton + (6,3,'catalog.gif','catalog','info','catalog_info()'); + 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)'); + menu.switchbutton + (8,3,'prt.gif','prepare','printout','gopost("/adm/printout",currentURL)'); + menu.switchbutton + (2,1,'back.gif','backward','','gopost("/adm/flip","back:"+currentURL)'); + menu.switchbutton + (2,3,'forw.gif','forward','','gopost("/adm/flip","forward:"+currentURL)'); + menu.switchbutton + (9,1,'sbkm.gif','set','bookmark','set_bookmark()'); + menu.switchbutton + (9,2,'vbkm.gif','view','bookmark','edit_bookmarks()'); + menu.switchbutton + (9,3,'anot.gif','anno-','tations','annotate()'); + $hwkadd + } + + function LONCAPAstale() { + menu=window.open("","LONCAPAmenu"); + menu.currentStale=1; + menu.switchbutton + (3,1,'reload.gif','return','location','go(currentURL)'); + menu.clearbut(7,1); + menu.clearbut(7,2); + menu.clearbut(7,3); + menu.menucltim=menu.setTimeout( + 'clearbut(2,1);clearbut(2,3);clearbut(8,1);clearbut(8,2);clearbut(8,3);'+ + 'clearbut(9,1);clearbut(9,2);clearbut(9,3);clearbut(6,3)', + 2000); + + } + +// END LON-CAPA Internal + +ENDREGTHIS + + } else { + return (< +// BEGIN LON-CAPA Internal + + function LONCAPAreg() { + menu=window.open("","LONCAPAmenu"); + menu.currentStale=1; + menu.clearbut(2,1); + menu.clearbut(2,3); + menu.clearbut(8,1); + menu.clearbut(8,2); + menu.clearbut(8,3); + if (menu.currentURL) { + menu.switchbutton + (3,1,'reload.gif','return','location','go(currentURL)'); + } else { + menu.clearbut(3,1); + } + } + + function LONCAPAstale() { + } + +// END LON-CAPA Internal + +ENDDONOTREGTHIS + } +} + +sub loadevents() { + return 'LONCAPAreg();'; +} + +sub unloadevents() { + return 'LONCAPAstale();'; +} + +sub printalltags { + my $temp; + foreach $temp (sort keys %Apache::lonxml::alltags) { + &Apache::lonxml::debug("$temp -- $Apache::lonxml::alltags{$temp}"); + } +} + +sub xmlparse { my ($target,$content_file_string,$safeinit,%style_for_target) = @_; - if ($target eq 'meta') { - &startredirection; - $Apache::lonxml::import = 0; - } elsif ($target eq 'grade') { - &startredirection; - $Apache::lonxml::import = 1; - } else { - $Apache::lonxml::redirection = 0; - $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; - $safeeval->permit("entereval"); - $safeeval->permit(":base_math"); - $safeeval->deny(":base_io"); - $safehole->wrap(\&Apache::lonnet::EXT,$safeeval,'&EXT'); -#need to inspect this class of ops -# $safeeval->deny(":base_orig"); - $safeinit .= ';$external::target='.$target.';'; - $safeinit .= ';$external::randomseed='.&Apache::lonnet::rndseed().';'; - &Apache::run::run($safeinit,$safeeval); + &init_safespace($target,$safeeval,$safehole,$safeinit); #-------------------- Redefinition of the target in the case of compound target ($target, my @tenta) = split('&&',$target); @@ -86,81 +308,128 @@ sub xmlparse { my @stack = (); my @parstack = (); &initdepth; - my $token; - while ( $#pars > -1 ) { - while ($token = $pars[$#pars]->get_token) { - if ($token->[0] eq 'T') { - $result=$token->[1]; - } 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,\@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, \@parstack, - \@pars,$safeeval, \%style_for_target); - } - } - #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); return $finaloutput; } +sub htmlclean { + my ($raw,$full)=@_; + + my $tree = HTML::TreeBuilder->new; + $tree->ignore_unknown(0); + + $tree->parse($raw); + + my $output= $tree->as_HTML(undef,' '); + + $output=~s/\<(br|hr|img)([^\>\/]*)\>/\<$1$2 \/\>/gis; + $output=~s/\<\/(br|hr|img)\>//gis; + unless ($full) { + $output=~s/\<[\/]*(body|head|html)\>//gis; + } + + $tree = $tree->delete; + + return $output; +} + +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; + } + + # 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) = @_; @@ -172,25 +441,29 @@ sub recurse { my $decls=''; while ( $#pat > -1 ) { while ($tokenpat = $pat[$#pat]->get_token) { - if ($tokenpat->[0] eq 'T') { - $partstring = $tokenpat->[1]; + if (($tokenpat->[0] eq 'T') || ($tokenpat->[0] eq 'C') || ($tokenpat->[0] eq 'D') ) { + if ($metamode<1) { $partstring=$tokenpat->[1]; } + } elsif ($tokenpat->[0] eq 'PI') { + if ($metamode<1) { $partstring=$tokenpat->[2]; } } elsif ($tokenpat->[0] eq 'S') { push (@innerstack,$tokenpat->[1]); push (@innerparstack,&parstring($tokenpat)); &increasedepth($tokenpat); - $partstring = &callsub("start_$tokenpat->[1]", - $target, $tokenpat, \@innerparstack, - \@pat, $safeeval, $style_for_target); + $partstring = &callsub("start_$tokenpat->[1]", $target, $tokenpat, + \@innerstack, \@innerparstack, \@pat, + $safeeval, $style_for_target); } elsif ($tokenpat->[0] eq 'E') { #clear out any tags that didn't end 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, \@innerparstack, - \@pat, $safeeval, $style_for_target); + $partstring = &callsub("end_$tokenpat->[1]", $target, $tokenpat, + \@innerstack, \@innerparstack, \@pat, + $safeeval, $style_for_target); + } else { + &Apache::lonxml::error("Unknown token event :$tokenpat->[0]:$tokenpat->[1]:"); } #pass both the variable to the style tag, and the tag we #are processing inside the @@ -221,23 +494,61 @@ sub recurse { } sub callsub { - my ($sub,$target,$token,$parstack,$parser,$safeeval,$style)=@_; + my ($sub,$target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; my $currentstring=''; + my $nodefault; { - my $sub1; + my $sub1; no strict 'refs'; - if (my $space=$Apache::lonxml::alltags{$token->[1]}) { - #&Apache::lonxml::debug("Calling sub $sub in $space
\n"); - $sub1="$space\:\:$sub"; - $Apache::lonxml::curdepth=join('_',@Apache::lonxml::depthcounter); - $currentstring = &$sub1($target,$token,$parstack,$parser, - $safeeval,$style); - } else { - #&Apache::lonxml::debug("NOT Calling sub $sub in $space
\n"); - if (defined($token->[4])) { - $currentstring = $token->[4]; + my $tag=$token->[1]; + my $space=$Apache::lonxml::alltags{$tag}; + if (!$space) { + $tag=~tr/A-Z/a-z/; + $sub=~tr/A-Z/a-z/; + $space=$Apache::lonxml::alltags{$tag} + } + + 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 { - $currentstring = $token->[2]; + #&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]; + } + } } } use strict 'refs'; @@ -245,6 +556,95 @@ 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'); + $safehole->wrap(\&Math::Cephes::acos,$safeeval,'&acos'); + $safehole->wrap(\&Math::Cephes::atan,$safeeval,'&atan'); + $safehole->wrap(\&Math::Cephes::sinh,$safeeval,'&sinh'); + $safehole->wrap(\&Math::Cephes::cosh,$safeeval,'&cosh'); + $safehole->wrap(\&Math::Cephes::tanh,$safeeval,'&tanh'); + $safehole->wrap(\&Math::Cephes::asinh,$safeeval,'&asinh'); + $safehole->wrap(\&Math::Cephes::acosh,$safeeval,'&acosh'); + $safehole->wrap(\&Math::Cephes::atanh,$safeeval,'&atanh'); + $safehole->wrap(\&Math::Cephes::erf,$safeeval,'&erf'); + $safehole->wrap(\&Math::Cephes::erfc,$safeeval,'&erfc'); + $safehole->wrap(\&Math::Cephes::j0,$safeeval,'&j0'); + $safehole->wrap(\&Math::Cephes::j1,$safeeval,'&j1'); + $safehole->wrap(\&Math::Cephes::jn,$safeeval,'&jn'); + $safehole->wrap(\&Math::Cephes::jv,$safeeval,'&jv'); + $safehole->wrap(\&Math::Cephes::y0,$safeeval,'&y0'); + $safehole->wrap(\&Math::Cephes::y1,$safeeval,'&y1'); + $safehole->wrap(\&Math::Cephes::yn,$safeeval,'&yn'); + $safehole->wrap(\&Math::Cephes::yv,$safeeval,'&yv'); + $safehole->wrap(\&Math::Random::random_beta,$safeeval,'&math_random_beta'); + $safehole->wrap(\&Math::Random::random_chi_square,$safeeval,'&math_random_chi_square'); + $safehole->wrap(\&Math::Random::random_exponential,$safeeval,'&math_random_exponential'); + $safehole->wrap(\&Math::Random::random_f,$safeeval,'&math_random_f'); + $safehole->wrap(\&Math::Random::random_gamma,$safeeval,'&math_random_gamma'); + $safehole->wrap(\&Math::Random::random_multivariate_normal,$safeeval,'&math_random_multivariate_normal'); + $safehole->wrap(\&Math::Random::random_multinomial,$safeeval,'&math_random_multinomial'); + $safehole->wrap(\&Math::Random::random_noncentral_chi_square,$safeeval,'&math_random_noncentral_chi_square'); + $safehole->wrap(\&Math::Random::random_noncentral_f,$safeeval,'&math_random_noncentral_f'); + $safehole->wrap(\&Math::Random::random_normal,$safeeval,'&math_random_normal'); + $safehole->wrap(\&Math::Random::random_permutation,$safeeval,'&math_random_permutation'); + $safehole->wrap(\&Math::Random::random_permuted_index,$safeeval,'&math_random_permuted_index'); + $safehole->wrap(\&Math::Random::random_uniform,$safeeval,'&math_random_uniform'); + $safehole->wrap(\&Math::Random::random_poisson,$safeeval,'&math_random_poisson'); + $safehole->wrap(\&Math::Random::random_uniform_integer,$safeeval,'&math_random_uniform_integer'); + $safehole->wrap(\&Math::Random::random_negative_binomial,$safeeval,'&math_random_negative_binomial'); + $safehole->wrap(\&Math::Random::random_binomial,$safeeval,'&math_random_binomial'); + $safehole->wrap(\&Math::Random::random_seed_from_phrase,$safeeval,'&random_seed_from_phrase'); + $safehole->wrap(\&Math::Random::random_set_seed_from_phrase,$safeeval,'&random_set_seed_from_phrase'); + $safehole->wrap(\&Math::Random::random_get_seed,$safeeval,'&random_get_seed'); + $safehole->wrap(\&Math::Random::random_set_seed,$safeeval,'&random_set_seed'); + +#need to inspect this class of ops +# $safeeval->deny(":base_orig"); + $safeinit .= ';$external::target="'.$target.'";'; + $safeinit .= ';$external::randomseed='.&Apache::lonnet::rndseed().';'; + &Apache::run::run($safeinit,$safeeval); +} + sub startredirection { $Apache::lonxml::redirection++; push (@Apache::lonxml::outputstack, ''); @@ -252,13 +652,20 @@ sub startredirection { sub endredirection { if (!$Apache::lonxml::redirection) { - &Apache::lonxml::error("Endredirection was called, before a startredirection, perhaps you have unbalanced tags. Some debuggin information:".join ":",caller); + &Apache::lonxml::error("Endredirection was called, before a startredirection, perhaps you have unbalanced tags. Some debuging information:".join ":",caller); return ''; } $Apache::lonxml::redirection--; 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; @@ -299,20 +706,41 @@ sub get_all_text { my $depth=0; my $token; my $result=''; - my $tag=substr($tag,1); #strip the / off the tag - #&Apache::lonxml::debug("have:$tag:"); - while (($depth >=0) && ($token = $pars->get_token)) { - #&Apache::lonxml::debug("token:$token->[0]:$depth:$token->[1]"); - if ($token->[0] eq 'T') { - $result.=$token->[1]; - } elsif ($token->[0] eq 'S') { - if ($token->[1] eq $tag) { $depth++; } - $result.=$token->[4]; - } elsif ($token->[0] eq 'E') { - if ( $token->[1] eq $tag) { $depth--; } - #skip sending back the last end tag - if ($depth > -1) { $result.=$token->[2]; } else { - $pars->unget_token($token); + if ( $tag =~ m:^/: ) { + my $tag=substr($tag,1); +# &Apache::lonxml::debug("have:$tag:"); + while (($depth >=0) && ($token = $pars->get_token)) { +# &Apache::lonxml::debug("e token:$token->[0]:$depth:$token->[1]"); + 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') { + if ($token->[1] eq $tag) { $depth++; } + $result.=$token->[4]; + } elsif ($token->[0] eq 'E') { + if ( $token->[1] eq $tag) { $depth--; } + #skip sending back the last end tag + if ($depth > -1) { $result.=$token->[2]; } else { + $pars->unget_token($token); + } + } + } + } else { + while ($token = $pars->get_token) { +# &Apache::lonxml::debug("s token:$token->[0]:$depth:$token->[1]"); + 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') { + if ( $token->[1] eq $tag) { + $pars->unget_token($token); last; + } else { + $result.=$token->[4]; + } + } elsif ($token->[0] eq 'E') { + $result.=$token->[2]; } } } @@ -358,61 +786,166 @@ sub writeallows { &Apache::lonnet::appenv(%httpref); } +# +# Afterburner handles anchors, highlights and links +# +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'})); + if ($ENV{'form.highlight'}) { + map { + my $anchorname=$_; + my $matchthis=$anchorname; + $matchthis=~s/\_+/\\s\+/g; + $result=~s/($matchthis)/\$1\<\/font\>/gs; + } split(/\,/,$ENV{'form.highlight'}); + } + if ($ENV{'form.link'}) { + map { + my ($anchorname,$linkurl)=split(/\>/,$_); + my $matchthis=$anchorname; + $matchthis=~s/\_+/\\s\+/g; + $result=~s/($matchthis)/\$1\<\/a\>/gs; + } split(/\,/,$ENV{'form.link'}); + } + if ($ENV{'form.anchor'}) { + my $anchorname=$ENV{'form.anchor'}; + my $matchthis=$anchorname; + $matchthis=~s/\_+/\\s\+/g; + $result=~s/($matchthis)/\$1\<\/a\>/s; + $result.=(<<"ENDSCRIPT"); + +ENDSCRIPT + } + return $result; +} + +sub storefile { + my ($file,$contents)=@_; + if (my $fh=Apache::File->new('>'.$file)) { + print $fh $contents; + $fh->close(); + } +} + +sub inserteditinfo { + my ($result,$filecontents)=@_; + unless ($filecontents) { + $filecontents=(< + + + Title of Document Goes Here + + + + + Body of Document Goes Here + + + +SIMPLECONTENT + } + my $editheader='Edit below
'; + my $editfooter=(< + +
+ +
+ + +
+ENDFOOTER + $result=~s/(\]*\>)/$1$editheader/is; + $result=~s/(\<\/body\>)/$editfooter/is; + return $result; +} + sub handler { my $request=shift; - + my $target='web'; + $Apache::lonxml::debug=0; + if ($ENV{'browser.mathml'}) { $request->content_type('text/xml'); } else { $request->content_type('text/html'); } - -# $request->print(< -# -#Just test -# -# -#ENDHEADER -# &Apache::lonhomework::send_header($request); + $request->send_http_header; - + return OK if $request->header_only; - $request->print(&Apache::lontexconvert::header()); - - $request->print(''."\n"); my $file=&Apache::lonnet::filelocation("",$request->uri); +# +# Edit action? Save file. +# + unless ($ENV{'request.state'} eq 'published') { + if (($ENV{'form.savethisfile'}) || ($ENV{'form.attemptclean'})) { + &storefile($file,$ENV{'form.filecont'}); + } + } my %mystyle; my $result = ''; my $filecontents=&Apache::lonnet::getfile($file); if ($filecontents == -1) { - &Apache::lonxml::error(" Unable to find $file"); + $result=(< + +File not found + + +File not found: $file + + +ENDNOTFOUND $filecontents=''; } else { + unless ($ENV{'request.state'} eq 'published') { + if ($ENV{'form.attemptclean'}) { + $filecontents=&htmlclean($filecontents,1); + } + } $result = &Apache::lonxml::xmlparse($target,$filecontents,'',%mystyle); } - $request->print($result); +# +# Edit action? Insert editing commands +# + unless ($ENV{'request.state'} eq 'published') { + $result=&inserteditinfo($result,$filecontents); + } + + $request->print($result); - $request->print(''); - $request->print(&Apache::lontexconvert::footer()); writeallows($request->uri); return OK; } -$Apache::lonxml::debug=0; sub debug { if ($Apache::lonxml::debug eq 1) { - print "DEBUG:".$_[0]."
\n"; + print("DEBUG:".$_[0]."
\n"); } } sub error { - if ($Apache::lonxml::debug eq 1) { + if (($Apache::lonxml::debug eq 1) || ($ENV{'request.state'} eq 'construct') ) { print "ERROR:".$_[0]."
\n"; } else { print "An Error occured while processing this resource. The instructor has been notified.
"; @@ -426,18 +959,67 @@ sub error { &Apache::lonmsg::user_normal_msg($user,$domain,"Error in $ENV{'request.filename'}",$_[0]); } } - + #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','103',"Error in $ENV{'request.filename'}",$_[0]); + #&Apache::lonmsg::user_normal_msg('albertel','103',"Error in $ENV{'request.filename'}",$_[0]); } } sub warning { - if ($Apache::lonxml::debug eq 1) { + if ($ENV{'request.state'} eq 'construct') { print "WARNING:".$_[0]."
\n"; } } +sub get_param { + my ($param,$parstack,$safeeval,$context) = @_; + if ( ! $context ) { $context = -1; } + my $args =''; + if ( $#$parstack > (-2-$context) ) { $args=$$parstack[$context]; } + return &Apache::run::run("{$args;".'return $'.$param.'}',$safeeval); #' +} + +sub register_insert { + my @data = split /\n/, &Apache::lonnet::getfile('/home/httpd/lonTabs/insertlist.tab'); + my $i; + my $tagnum=0; + my @order; + for ($i=0;$i < $#data; $i++) { + my $line = $data[$i]; + 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++; + } + $i++; #skipping TABLE line + $tagnum = 0; + for (;$i < $#data;$i++) { + my $line = $data[$i]; + my ($mnemonic,@which) = split(/ +/,$line); + my $tag = $insertlist{"$tagnum.tag"}; + for (my $j=0;$j <$#which;$j++) { + if ( $which[$j] eq 'Y' ) { + if ($insertlist{"$j.show"} ne 'no') { + push(@{ $insertlist{"$tag.which"} },$j); + } + } + } + $tagnum++; + } +} + +sub description { + my ($token)=@_; + return $insertlist{$insertlist{"$token->[1].num"}.'.description'}; +} 1; __END__ + + 500 Internal Server Error

Internal Server Error

The server encountered an internal error or misconfiguration and was unable to complete your request.

Please contact the server administrator at root@localhost to inform them of the time this error occurred, and the actions you performed just before this error.

More information about this error may be available in the server error log.