--- loncom/xml/lonxml.pm 2002/07/12 16:37:38 1.180 +++ loncom/xml/lonxml.pm 2003/02/12 20:43:18 1.229 @@ -1,7 +1,7 @@ # The LearningOnline Network with CAPA # XML Parser Module # -# $Id: lonxml.pm,v 1.180 2002/07/12 16:37:38 albertel Exp $ +# $Id: lonxml.pm,v 1.229 2003/02/12 20:43:18 sakharuk 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 @@ -60,7 +59,7 @@ package Apache::lonxml; use vars -qw(@pwd @outputstack $redirection $import @extlinks $metamode $evaluate %insertlist @namespace $prevent_entity_encode); +qw(@pwd @outputstack $redirection $import @extlinks $metamode $evaluate %insertlist @namespace $prevent_entity_encode $errorcount $warningcount); use strict; use HTML::LCParser(); use HTML::TreeBuilder(); @@ -99,11 +98,18 @@ use Apache::edit(); use Apache::lonnet(); use Apache::File(); use Apache::loncommon(); +use Apache::lonfeedback(); +use Apache::lonmsg(); +use Apache::loncacc(); #================================================== 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=(); @@ -138,6 +144,13 @@ $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=4; +$Apache::lonxml::counter_changed=0; + +#internal check on whether to look at style defs +$Apache::lonxml::usestyle=1; + sub xmlbegin { my $output=''; if ($ENV{'browser.mathml'}) { @@ -154,6 +167,7 @@ sub xmlbegin { } sub xmlend { + my ($discussiononly,$symb)=@_; my $discussion=''; if ($ENV{'request.course.id'}) { my $crs='/'.$ENV{'request.course.id'}; @@ -162,32 +176,48 @@ sub xmlend { } $crs=~s/\_/\//g; my $seeid=&Apache::lonnet::allowed('rin',$crs); - my $symb=&Apache::lonnet::symbread(); + unless ($symb) { + $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

'; + unless ($discussiononly) { + $discussion.= + '

'; + } 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); if ($message) { if ($hidden) { $message=''.$message.''; } + my $screenname=&Apache::loncommon::screenname( + $contrib{$idx.':sendername'}, + $contrib{$idx.':senderdomain'}); + my $plainname=&Apache::loncommon::nickname( + $contrib{$idx.':sendername'}, + $contrib{$idx.':senderdomain'}); + my $sender='Anonymous'; if ((!$contrib{$idx.':anonymous'}) || ($seeid)) { - $sender=$contrib{$idx.':plainname'}.' ('. + $sender=&Apache::loncommon::aboutmewrapper( + $plainname, + $contrib{$idx.':sendername'}, + $contrib{$idx.':senderdomain'}).' ('. $contrib{$idx.':sendername'}.' at '. $contrib{$idx.':senderdomain'}.')'; if ($contrib{$idx.':anonymous'}) { $sender.=' [anonymous] '. - $contrib{$idx.':screenname'}; + $screenname; } if ($seeid) { if ($hidden) { @@ -196,11 +226,13 @@ sub xmlend { } else { $sender.=' Hide'; - } - } + } + $sender.=' Delete'; + } } else { - if ($contrib{$idx.':screenname'}) { - $sender=''.$contrib{$idx.':screenname'}.''; + if ($screenname) { + $sender=''.$screenname.''; } } $discussion.='

'.$sender.' ('. @@ -210,18 +242,35 @@ sub xmlend { } } } - $discussion.='

'; + unless ($discussiononly) { + $discussion.='
'; + } + } + if ($discussiononly) { + $discussion.=(< + + + + +
+Note: in anonymous discussion, your name is visible only to +course faculty
+ + +ENDDISCUSS + $discussion.=&Apache::lonfeedback::generate_preview_button(); } } } - return $discussion.''; + return $discussion.($discussiononly?'':''); } sub tokeninputfield { my $defhost=$Apache::lonnet::perlvar{'lonHostID'}; $defhost=~tr/a-z/A-Z/; return (< +\n"; } @@ -340,79 +403,145 @@ sub registerurl { (!&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.clock.setTime(1000*'.time.');'; + my $reopen=&Apache::lonmenu::reopenmenu(); + my $newmail=''; + if (&Apache::lonmsg::newmail()) { + $newmail='menu.setstatus("you have","messages");'; + } + my $timesync='menu.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.=(< // BEGIN LON-CAPA Internal function LONCAPAreg() { - menu=window.open("$nothing","LONCAPAmenu","",false); + menu=$reopen; menu.clearTimeout(menu.menucltim); $timesync + $newmail menu.currentURL=window.location.pathname; menu.reloadURL=window.location.pathname; + menu.currentSymb="$ENV{'request.symb'}"; + menu.reloadSymb="$ENV{'request.symb'}"; menu.currentStale=0; menu.clearbut(3,1); menu.switchbutton - (6,3,'catalog.gif','catalog','info','catalog_info()'); + (6,3,'catalog.gif','catalog','info','catalog_info()','Show catalog information'); menu.switchbutton - (8,1,'eval.gif','evaluate','this','gopost("/adm/evaluate",currentURL)'); + (8,1,'eval.gif','evaluate','this','gopost("/adm/evaluate",currentURL)','Provide my evaluation of this resource'); menu.switchbutton - (8,2,'fdbk.gif','feedback','on this','gopost("/adm/feedback",currentURL)'); + (8,2,'fdbk.gif','feedback','discuss','gopost("/adm/feedback",currentURL)','Provide feedback messages or contribute to the course discussion about this resource'); menu.switchbutton - (8,3,'prt.gif','prepare','printout','gopost("/adm/printout",currentURL)'); + (8,3,'prt.gif','prepare','printout','gopost("/adm/printout",currentURL)','Prepare a printable document'); menu.switchbutton - (2,1,'back.gif','backward','','gopost("/adm/flip","back:"+currentURL)'); + (2,1,'back.gif','backward','','gopost("/adm/flip","back:"+currentURL)','Go to the previous resource in the course sequence'); menu.switchbutton - (2,3,'forw.gif','forward','','gopost("/adm/flip","forward:"+currentURL)'); + (2,3,'forw.gif','forward','','gopost("/adm/flip","forward:"+currentURL)','Go to the next resource in the course sequence'); menu.switchbutton - (9,1,'sbkm.gif','set','bookmark','set_bookmark()'); + (9,1,'sbkm.gif','set','bookmark','set_bookmark()','Set a bookmark for this resource'); menu.switchbutton - (9,2,'vbkm.gif','view','bookmark','edit_bookmarks()'); + (9,2,'vbkm.gif','view','bookmark','edit_bookmarks()','Use or edit my bookmark collection'); menu.switchbutton - (9,3,'anot.gif','anno-','tations','annotate()'); + (9,3,'anot.gif','anno-','tations','annotate()','Make notes and annotations about this resource'); $hwkadd + $editbutton } function LONCAPAstale() { - menu=window.open("$nothing","LONCAPAmenu","",false); + menu=$reopen menu.currentStale=1; if (menu.reloadURL!='' && menu.reloadURL!= null) { menu.switchbutton - (3,1,'reload.gif','return','location','go(reloadURL)'); + (3,1,'reload.gif','return','location','go(reloadURL)','Return to the last known location in the course sequence'); } 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)', + 'clearbut(9,1);clearbut(9,2);clearbut(9,3);clearbut(6,3);clearbut(6,1)', 2000); } @@ -428,7 +557,7 @@ ENDREGTHIS // BEGIN LON-CAPA Internal function LONCAPAreg() { - menu=window.open("$nothing","LONCAPAmenu","",false); + menu=$reopen $timesync menu.currentStale=1; menu.clearbut(2,1); @@ -478,7 +607,7 @@ sub xmlparse { # do we have a course style file? # - if ($ENV{'request.course.id'}) { + if ($ENV{'request.course.id'} && $ENV{'request.state'} ne 'construct') { my $bodytext= $ENV{'course.'.$ENV{'request.course.id'}.'.default_xml_style'}; if ($bodytext) { @@ -513,6 +642,7 @@ sub xmlparse { if ($ENV{'request.uri'}) { &writeallows($ENV{'request.uri'}); } + if ($Apache::lonxml::counter_changed) { &store_counter() } return $finaloutput; } @@ -537,6 +667,28 @@ sub htmlclean { return $output; } +sub latex_special_symbols { + my ($current_token,$stack,$parstack,$where)=@_; + if ($where=='header') { + $current_token =~ s/_/ /g; + $current_token =~ s/\^/ /g; + $current_token =~ s/&/\\&/g; + } else { + $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/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."\n"; + } + $result.=$text; } } elsif ($token->[0] eq 'PI') { if ($metamode<1) { @@ -558,15 +714,12 @@ sub inner_xmlparse { # 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); - } + if ($Apache::lonxml::usestyle && + exists($$style_for_target{$token->[1]})) { + $Apache::lonxml::usestyle=0; + my $string=$$style_for_target{$token->[1]}. + ''; + &Apache::lonxml::newparser($pars,\$string); } else { $result = &callsub("start_$token->[1]", $target, $token, $stack, $parstack, $pars, $safeeval, $style_for_target); @@ -584,16 +737,12 @@ sub inner_xmlparse { } } - 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); - } + if ($Apache::lonxml::usestyle && + exists($$style_for_target{'/'."$token->[1]"})) { + $Apache::lonxml::usestyle=0; + my $string=$$style_for_target{'/'.$token->[1]}. + ''; + &Apache::lonxml::newparser($pars,\$string); } else { $result = &callsub("end_$token->[1]", $target, $token, $stack, $parstack, $pars,$safeeval, $style_for_target); @@ -609,6 +758,12 @@ sub inner_xmlparse { $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); + } + } + # Encode any high ASCII characters if (!$Apache::lonxml::prevent_entity_encode) { $result=&HTML::Entities::encode($result,"\200-\377"); @@ -623,9 +778,11 @@ sub inner_xmlparse { if ($token->[0] eq 'E') { &end_tag($stack,$parstack,$token); } + } + if ($#$pars > -1) { + pop @$pars; + pop @Apache::lonxml::pwd; } - pop @$pars; - pop @Apache::lonxml::pwd; } # if ($target eq 'meta') { @@ -635,82 +792,10 @@ sub inner_xmlparse { 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) = @_; - my @pat = (); - &newparser(\@pat,\$newarg); - my $tokenpat; - my $partstring = ''; - my $output=''; - my $decls=''; - &Apache::lonxml::debug("Recursing"); - while ( $#pat > -1 ) { - while ($tokenpat = $pat[$#pat]->get_token) { - 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, - \@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)) { - 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, - $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 - if ( $partstring ne "" ) { - if ( $#parstack > -1 ) { - if ( $#innerparstack > -1 ) { - $decls= $parstack[$#parstack].$innerparstack[$#innerparstack]; - } else { - $decls= $parstack[$#parstack]; - } - } else { - if ( $#innerparstack > -1 ) { - $decls=$innerparstack[$#innerparstack]; - } else { - $decls=''; - } - } - $output .= &Apache::run::evaluate($partstring,$safeeval,$decls); - $partstring = ''; - } - if ($tokenpat->[0] eq 'E') { pop @innerstack;pop @innerparstack; - &decreasedepth($tokenpat);} - } - pop @pat; - pop @Apache::lonxml::pwd; - } - &Apache::lonxml::debug("Exiting Recursing"); - return $output; -} - sub callsub { my ($sub,$target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; my $currentstring=''; @@ -753,7 +838,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') { @@ -763,6 +848,9 @@ sub callsub { if ($token->[0] eq 'S') { $currentstring = $token->[4]; $currentstring.=&Apache::edit::handle_insert(); + } elsif ($token->[0] eq 'E') { + $currentstring = $token->[2]; + $currentstring.=&Apache::edit::handle_insertafter($token->[1]); } else { $currentstring = $token->[2]; } @@ -778,6 +866,11 @@ sub setup_globals { my ($request,$target)=@_; $Apache::lonxml::request=$request; $Apache::lonxml::registered = 0; + $errorcount=0; + $warningcount=0; + $Apache::lonxml::default_homework_loaded=0; + $Apache::lonxml::usestyle=1; + &init_counter(); @Apache::lonxml::pwd=(); @Apache::lonxml::extlinks=(); if ($target eq 'meta') { @@ -846,6 +939,37 @@ sub init_safespace { $safehole->wrap(\&Math::Cephes::y1,$safeeval,'&y1'); $safehole->wrap(\&Math::Cephes::yn,$safeeval,'&yn'); $safehole->wrap(\&Math::Cephes::yv,$safeeval,'&yv'); + + $safehole->wrap(\&Math::Cephes::bdtr ,$safeeval,'&bdtr' ); + $safehole->wrap(\&Math::Cephes::bdtrc ,$safeeval,'&bdtrc' ); + $safehole->wrap(\&Math::Cephes::bdtri ,$safeeval,'&bdtri' ); + $safehole->wrap(\&Math::Cephes::btdtr ,$safeeval,'&btdtr' ); + $safehole->wrap(\&Math::Cephes::chdtr ,$safeeval,'&chdtr' ); + $safehole->wrap(\&Math::Cephes::chdtrc,$safeeval,'&chdtrc'); + $safehole->wrap(\&Math::Cephes::chdtri,$safeeval,'&chdtri'); + $safehole->wrap(\&Math::Cephes::fdtr ,$safeeval,'&fdtr' ); + $safehole->wrap(\&Math::Cephes::fdtrc ,$safeeval,'&fdtrc' ); + $safehole->wrap(\&Math::Cephes::fdtri ,$safeeval,'&fdtri' ); + $safehole->wrap(\&Math::Cephes::gdtr ,$safeeval,'&gdtr' ); + $safehole->wrap(\&Math::Cephes::gdtrc ,$safeeval,'&gdtrc' ); + $safehole->wrap(\&Math::Cephes::nbdtr ,$safeeval,'&nbdtr' ); + $safehole->wrap(\&Math::Cephes::nbdtrc,$safeeval,'&nbdtrc'); + $safehole->wrap(\&Math::Cephes::nbdtri,$safeeval,'&nbdtri'); + $safehole->wrap(\&Math::Cephes::ndtr ,$safeeval,'&ndtr' ); + $safehole->wrap(\&Math::Cephes::ndtri ,$safeeval,'&ndtri' ); + $safehole->wrap(\&Math::Cephes::pdtr ,$safeeval,'&pdtr' ); + $safehole->wrap(\&Math::Cephes::pdtrc ,$safeeval,'&pdtrc' ); + $safehole->wrap(\&Math::Cephes::pdtri ,$safeeval,'&pdtri' ); + $safehole->wrap(\&Math::Cephes::stdtr ,$safeeval,'&stdtr' ); + $safehole->wrap(\&Math::Cephes::stdtri,$safeeval,'&stdtri'); + +# $safehole->wrap(\&Math::Cephes::new_fract,$safeeval,'&new_fract'); +# $safehole->wrap(\&Math::Cephes::radd,$safeeval,'&radd'); +# $safehole->wrap(\&Math::Cephes::rsub,$safeeval,'&rsub'); +# $safehole->wrap(\&Math::Cephes::rmul,$safeeval,'&rmul'); +# $safehole->wrap(\&Math::Cephes::rdiv,$safeeval,'&rdiv'); +# $safehole->wrap(\&Math::Cephes::euclid,$safeeval,'&euclid'); + $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'); @@ -878,6 +1002,18 @@ sub init_safespace { &Apache::run::run($safeinit,$safeeval); } +sub default_homework_load { + my ($safeeval)=@_; + &Apache::lonxml::debug('Loading default_homework'); + my $default=&Apache::lonnet::getfile('/home/httpd/html/res/adm/includes/default_homework.lcpm'); + if ($default == -1) { + &Apache::lonxml::error("Unable to find default_homework.lcpm"); + } else { + &Apache::run::run($default,$safeeval); + $Apache::lonxml::default_homework_loaded=1; + } +} + sub startredirection { $Apache::lonxml::redirection++; push (@Apache::lonxml::outputstack, ''); @@ -934,6 +1070,7 @@ sub decreasedepth { } sub get_all_text_unbalanced { +#there is a copy of this in lonpublisher.pm my($tag,$pars)= @_; my $token; my $result=''; @@ -948,7 +1085,7 @@ sub get_all_text_unbalanced { } elsif ($token->[0] eq 'E') { $result.=$token->[2]; } - if ($result =~ /(.*)$tag(.*)/) { + if ($result =~ /(.*)\Q$tag\E(.*)/s) { &Apache::lonxml::debug('Got a winner with leftovers ::'.$2); &Apache::lonxml::debug('Result is :'.$1); $result=$1; @@ -960,50 +1097,103 @@ sub get_all_text_unbalanced { return $result } +sub increment_counter { + $Apache::lonxml::counter++; + $Apache::lonxml::counter_changed=1; +} + +sub init_counter { + if (defined($ENV{'form.counter'})) { + $Apache::lonxml::counter=$ENV{'form.counter'}; + } elsif (not defined($Apache::lonxml::counter)) { + $Apache::lonxml::counter=1; + &store_counter(); + } + $Apache::lonxml::counter_changed=0; +} + +sub store_counter { + &Apache::lonnet::appenv(('form.counter' => $Apache::lonxml::counter)); + return ''; +} + 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; my $token; my $result=''; 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] =~ /^$tag$/i) { $depth++; } - $result.=$token->[4]; - } elsif ($token->[0] eq 'E') { - if ( $token->[1] =~ /^$tag$/i) { $depth--; } - #skip sending back the last end tag - if ($depth > -1) { $result.=$token->[2]; } else { - $pars->unget_token($token); + #&Apache::lonxml::debug("have:$tag:"); + 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')) { + $result.=$token->[1]; + } elsif ($token->[0] eq 'PI') { + $result.=$token->[2]; + } elsif ($token->[0] eq 'S') { + if ($token->[1] =~ /^$tag$/i) { $depth++; } + $result.=$token->[4]; + } elsif ($token->[0] eq 'E') { + if ( $token->[1] =~ /^$tag$/i) { $depth--; } + #skip sending back the last end tag + if ($depth > -1) { $result.=$token->[2]; } else { + $$pars[-1]->unget_token($token); + } } } + if (($depth >=0) && ($#$pars == 0) ) { $top_empty=1; } + if (($depth >=0) && ($#$pars > 0) ) { + pop(@$pars); + pop(@Apache::lonxml::pwd); + } } - } 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] =~ /^$tag$/i) { - $pars->unget_token($token); last; - } else { - $result.=$token->[4]; + 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); } - } elsif ($token->[0] eq 'E') { - $result.=$token->[2]; - } + $result=''; } + } else { + while ($#$pars > -1) { + while ($token = $$pars[-1]->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] =~ /^$tag$/i) { + $$pars[-1]->unget_token($token); last; + } else { + $result.=$token->[4]; + } + } elsif ($token->[0] eq 'E') { + $result.=$token->[2]; + } + } + if (($#$pars > 0) ) { + pop(@$pars); + pop(@Apache::lonxml::pwd); + } else { last; } + } + } + if ($result =~ m||) { + $Apache::lonxml::usestyle=1; } -# &Apache::lonxml::debug("Exit:$result:"); + #&Apache::lonxml::debug("Exit:$result:"); return $result } @@ -1080,7 +1270,7 @@ sub afterburn { $matchthis=~s/\_+/\\s\+/g; $result=~s/($matchthis)/\$1\<\/a\>/s; $result.=(<<"ENDSCRIPT"); - ENDSCRIPT @@ -1251,11 +1441,12 @@ ENDNOTFOUND sub debug { if ($Apache::lonxml::debug eq 1) { $|=1; - print("DEBUG:".&HTML::Entities::encode($_[0])."
\n"); + print('DEBUG:'.&HTML::Entities::encode($_[0])."\n"); } } sub error { + $errorcount++; 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";
@@ -1265,10 +1456,10 @@ sub error {
     &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 (undef,%users)=&Apache::lonfeedback::decide_receiver(undef,0,1,1,1); my $declutter=&Apache::lonnet::declutter($ENV{'request.filename'}); - foreach my $user (split /\,/, $users) { - ($user,my $domain) = split /:/, $user; + foreach (keys %users) { + my ($user,$domain) = split(/:/, $_); &Apache::lonmsg::user_normal_msg($user,$domain, "Error [$declutter]",join('
',@_)); } @@ -1281,30 +1472,45 @@ sub error { } sub warning { + $warningcount++; if ($ENV{'request.state'} eq 'construct') { print "WARNING:".join('
',@_)."
\n"; } } 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 ( ! $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 ($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); 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.