--- loncom/xml/lonxml.pm 2001/08/09 20:32:36 1.108 +++ loncom/xml/lonxml.pm 2003/08/06 17:00:30 1.269 @@ -1,56 +1,118 @@ # The LearningOnline Network with CAPA # XML Parser Module # +# $Id: lonxml.pm,v 1.269 2003/08/06 17:00:30 albertel Exp $ +# +# Copyright Michigan State University Board of Trustees +# +# This file is part of the LearningOnline Network with CAPA (LON-CAPA). +# +# LON-CAPA is free software; you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation; either version 2 of the License, or +# (at your option) any later version. +# +# LON-CAPA is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with LON-CAPA; if not, write to the Free Software +# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA +# +# /home/httpd/html/adm/gpl.txt +# +# http://www.lon-capa.org/ +# +# Copyright for TtHfunc and TtMfunc by Ian Hutchinson. +# TtHfunc and TtMfunc (the "Code") may be compiled and linked into +# binary executable programs or libraries distributed by the +# Michigan State University (the "Licensee"), but any binaries so +# distributed are hereby licensed only for use in the context +# of a program or computational system for which the Licensee is the +# primary author or distributor, and which performs substantial +# additional tasks beyond the translation of (La)TeX into HTML. +# 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 Gerd Kortemeyer +# 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 $prevent_entity_encode $errorcount $warningcount); 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 HTML::LCParser(); +use HTML::TreeBuilder(); +use HTML::Entities(); +use Safe(); +use Safe::Hole(); +use Math::Cephes(); +use Math::Random(); +use Opcode(); + sub register { - my $space; - my @taglist; - my $temptag; - ($space,@taglist) = @_; - foreach $temptag (@taglist) { - $Apache::lonxml::alltags{$temptag}=$space; + my ($space,@taglist) = @_; + foreach my $temptag (@taglist) { + push(@{ $Apache::lonxml::alltags{$temptag} },$space); + } +} + +sub deregister { + my ($space,@taglist) = @_; + foreach my $temptag (@taglist) { + my $tempspace = $Apache::lonxml::alltags{$temptag}[-1]; + if ($tempspace eq $space) { + pop(@{ $Apache::lonxml::alltags{$temptag} }); + } } + #&printalltags(); } 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; +use Apache::lontexconvert(); +use Apache::style(); +use Apache::run(); +use Apache::londefdef(); +use Apache::scripttag(); +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(); #================================================== 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=(); @@ -76,9 +138,26 @@ $evaluate = 1; # stores the list of active tag namespaces @namespace=(); +# if 0 all high ASCII characters will be encoded into HTML Entities +$prevent_entity_encode=0; + # 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=''; + sub xmlbegin { my $output=''; if ($ENV{'browser.mathml'}) { @@ -95,174 +174,261 @@ sub xmlbegin { } sub xmlend { + my ($discussiononly,$symb)=@_; my $discussion=''; if ($ENV{'request.course.id'}) { - my $symb=&Apache::lonnet::symbread(); + 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); + 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 $message=$contrib{$idx.':message'}; - $message=~s/\n/\
/g; - $discussion.='

'.$contrib{$idx.':sendername'}.' at '. - $contrib{$idx.':senderdomain'}.' ('. + my $hidden=($contrib{'hidden'}=~/\.$idx\./); + my $deleted=($contrib{'deleted'}=~/\.$idx\./); + unless ((($hidden) && (!$seeid)) || ($deleted)) { + my $message=$contrib{$idx.':message'}; + $message=~s/\n/\
/g; + $message=&Apache::lontexconvert::msgtexconverted($message); + if ($contrib{$idx.':attachmenturl'}) { + my ($fname,$ft) + =($contrib{$idx.':attachmenturl'}=~/\/(\w+)\.(\w+)$/); + $message.='

Attachment: '.$fname.'.'.$ft.''; + } + 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=&Apache::loncommon::aboutmewrapper( + $plainname, + $contrib{$idx.':sendername'}, + $contrib{$idx.':senderdomain'}).' ('. + $contrib{$idx.':sendername'}.' at '. + $contrib{$idx.':senderdomain'}.')'; + if ($contrib{$idx.':anonymous'}) { + $sender.=' [anonymous] '. + $screenname; + } + if ($seeid) { + if ($hidden) { + $sender.=' Make Visible'; + } else { + $sender.=' Hide'; + } + $sender.=' Delete'; + } + } else { + if ($screenname) { + $sender=''.$screenname.''; + } + } + $discussion.='

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

'.$message. - '

'; + '

'; + } + } } - $discussion.='
'; + unless ($discussiononly) { + $discussion.='
'; + } + } + if ($discussiononly) { + $discussion.=(< + + + + +
+Note: in anonymous discussion, your name is visible only to +course faculty
+ +

+Attachment (128 KB max size): +

+ +ENDDISCUSS + $discussion.=&Apache::lonfeedback::generate_preview_button(); } } } - return $discussion.''; + return $discussion.($discussiononly?'':''); } -sub fontsettings() { - my $headerstring=''; - if (($ENV{'browser.os'} eq 'mac') && (!$ENV{'browser.mathml'})) { - $headerstring.= - ''; - } - return $headerstring; +sub tokeninputfield { + my $defhost=$Apache::lonnet::perlvar{'lonHostID'}; + $defhost=~tr/a-z/A-Z/; + return (< + function updatetoken() { + var comp=new Array; + var barcode=unescape(document.tokeninput.barcode.value); + comp=barcode.split('*'); + if (typeof(comp[0])!="undefined") { + document.tokeninput.codeone.value=comp[0]; + } + if (typeof(comp[1])!="undefined") { + document.tokeninput.codetwo.value=comp[1]; + } + if (typeof(comp[2])!="undefined") { + comp[2]=comp[2].toUpperCase(); + document.tokeninput.codethree.value=comp[2]; + } + document.tokeninput.barcode.value=''; + } + +
+ + + + +
DocID Checkin
+ + + + + + + +
Scan in Barcode
or Type in DocID + +* + +* + +
+
+
+ENDINPUTFIELD } -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 +sub maketoken { + my ($symb,$tuname,$tudom,$tcrsid)=@_; + unless ($symb) { + $symb=&Apache::lonnet::symbread(); + } + unless ($tuname) { + $tuname=$ENV{'user.name'}; + $tudom=$ENV{'user.domain'}; + $tcrsid=$ENV{'request.course.id'}; + } - } else { - return (< -// BEGIN LON-CAPA Internal +sub printtokenheader { + my ($target,$token,$tsymb,$tcrsid,$tudom,$tuname)=@_; + unless ($token) { return ''; } - 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); - } + my ($symb,$courseid,$domain,$name) = &Apache::lonxml::whichuser(); + unless ($tsymb) { + $tsymb=$symb; } - - function LONCAPAstale() { + unless ($tuname) { + $tuname=$name; + $tudom=$domain; + $tcrsid=$courseid; } -// END LON-CAPA Internal - -ENDDONOTREGTHIS - + my %reply=&Apache::lonnet::get('environment', + ['firstname','middlename','lastname','generation'], + $tudom,$tuname); + my $plainname=$reply{'firstname'}.' '. + $reply{'middlename'}.' '. + $reply{'lastname'}.' '. + $reply{'generation'}; + + if ($target eq 'web') { + my %idhash=&Apache::lonnet::idrget($tudom,($tuname)); + return + ''. + 'Checked out for '.$plainname. + '
User: '.$tuname.' at '.$tudom. + '
ID: '.$idhash{$tuname}. + '
CourseID: '.$tcrsid. + '
Course: '.$ENV{'course.'.$tcrsid.'.description'}. + '
DocID: '.$token. + '
Time: '.localtime().'
'; + } else { + return $token; } } -sub loadevents() { - return 'LONCAPAreg();'; -} - -sub unloadevents() { - return 'LONCAPAstale();'; +sub fontsettings() { + my $headerstring=''; + if (($ENV{'browser.os'} eq 'mac') && (!$ENV{'browser.mathml'})) { + $headerstring.= + ''; + } elsif (!$ENV{'browser.mathml'} && $ENV{'browser.unicode'}) { + $headerstring.= + ''; + } + return $headerstring; } sub printalltags { my $temp; foreach $temp (sort keys %Apache::lonxml::alltags) { - &Apache::lonxml::debug("$temp -- $Apache::lonxml::alltags{$temp}"); + &Apache::lonxml::debug("$temp -- ". + join(',',@{ $Apache::lonxml::alltags{$temp} })); } } sub xmlparse { - my ($target,$content_file_string,$safeinit,%style_for_target) = @_; + my ($request,$target,$content_file_string,$safeinit,%style_for_target) = @_; + + &setup_globals($request,$target); + &Apache::inputtags::initialize_inputtags(); + &Apache::outputtags::initialize_outputtags(); + &Apache::edit::initialize_edit(); - &setup_globals($target); - #&printalltags(); +# +# do we have a course style file? +# + + if ($ENV{'request.course.id'} && $ENV{'request.state'} ne 'construct') { + my $bodytext= + $ENV{'course.'.$ENV{'request.course.id'}.'.default_xml_style'}; + if ($bodytext) { + my $location=&Apache::lonnet::filelocation('',$bodytext); + my $styletext=&Apache::lonnet::getfile($location); + if ($styletext ne '-1') { + %style_for_target = (%style_for_target, + &Apache::style::styleparser($target,$styletext)); + } + } + } +#&printalltags(); my @pars = (); my $pwd=$ENV{'request.filename'}; $pwd =~ s:/[^/]*$::; @@ -275,13 +441,17 @@ sub xmlparse { ($target, my @tenta) = split('&&',$target); - my @stack = (); + my @stack = (); my @parstack = (); &initdepth; my $finaloutput = &inner_xmlparse($target,\@stack,\@parstack,\@pars, $safeeval,\%style_for_target); + if ($ENV{'request.uri'}) { + &writeallows($ENV{'request.uri'}); + } + if ($Apache::lonxml::counter_changed) { &store_counter() } return $finaloutput; } @@ -290,13 +460,13 @@ sub htmlclean { 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; + + $output=~s/\<(br|hr|img|meta|allow)(.*?)\>/\<$1$2 \/\>/gis; + $output=~s/\<\/(br|hr|img|meta|allow)\>//gis; unless ($full) { $output=~s/\<[\/]*(body|head|html)\>//gis; } @@ -306,163 +476,151 @@ sub htmlclean { return $output; } +sub latex_special_symbols { + my ($current_token,$stack,$parstack,$where)=@_; + if ($where eq 'header') { + $current_token =~ s/(\\|_|\^)/ /g; + $current_token =~ s/(\$|%|\#|&|\{|\})/\\$1/g; + } else { + $current_token=~s/\\ /\\char92 /g; + $current_token=~s/\^/\\char94 /g; + $current_token=~s/\~/\\char126 /g; + $current_token=~s/(&[^A-Za-z\#])/\\$1/g; + $current_token=~s/([^&])\#/$1\\#/g; + $current_token=~s/(\$|_|{|})/\\$1/g; + $current_token=~s/\\char92 /\\texttt{\\char92}/g; + $current_token=~s/(>|<)/\$$1\$/g; #more or less + if ($current_token=~m/\d%/) {$current_token =~ s/(\d)%/$1\\%/g;} #percent after digit + if ($current_token=~m/\s%/) {$current_token =~ s/(\s)%/$1\\%/g;} #persent after space + if ($current_token eq '%.') {$current_token = '\%.';} #persent at the end of statement + } + return $current_token; +} + 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; + my $dontpop=0; while ( $#$pars > -1 ) { while ($token = $$pars['-1']->get_token) { - if (($token->[0] eq 'T') || ($token->[0] eq 'C') || ($token->[0] eq 'D') ) { + if (($token->[0] eq 'T') || ($token->[0] eq 'C') ) { if ($metamode<1) { - $result=$token->[1]; + my $text=$token->[1]; + if ($token->[0] eq 'C' && $target eq 'tex') { + $text = ''; +# $text = '%'.$text."\n"; + } + $result.=$text; + } + } elsif (($token->[0] eq 'D')) { + if ($metamode<1 && $target eq 'web') { + my $text=$token->[1]; + $result.=$text; } } elsif ($token->[0] eq 'PI') { - if ($metamode<1) { + if ($metamode<1 && $target eq 'web') { $result=$token->[2]; } } elsif ($token->[0] eq 'S') { - # add tag to stack + # 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); - } + &increasedepth($token); + 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); + $Apache::lonxml::style_values=$$parstack[-1]; + $Apache::lonxml::style_end_values=$$parstack[-1]; } 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); - } - + 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); + $Apache::lonxml::style_values=$Apache::lonxml::style_end_values; + $Apache::lonxml::style_end_values=''; + $dontpop=1; } else { - $result = &callsub("end_$token->[1]", $target, $token, $stack, - $parstack, $pars,$safeeval, $style_for_target); + #clear out any tags that didn't end + while ($token->[1] ne $$stack['-1'] && ($#$stack > -1)) { + my $lasttag=$$stack[-1]; + if ($token->[1] =~ /^$lasttag$/i) { + &Apache::lonxml::warning('Using tag </'.$token->[1].'> on line '.$token->[3].' as end tag to <'.$$stack[-1].'>'); + last; + } else { + &Apache::lonxml::warning('Found tag </'.$token->[1].'> on line '.$token->[3].' when looking for </'.$$stack[-1].'> in file'); + &end_tag($stack,$parstack,$token); + } + } + $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']); + my $extras; + if (!$Apache::lonxml::usestyle) { + $extras=$Apache::lonxml::style_values; } + if ( $#$parstack > -1 ) { + $result=&Apache::run::evaluate($result,$safeeval,$extras.$$parstack[-1]); } else { - $finaloutput .= &Apache::run::evaluate($result,$safeeval,''); + $result= &Apache::run::evaluate($result,$safeeval,$extras); } - $result = ''; - } - if ($token->[0] eq 'E') { + } + if (($token->[0] eq 'T') || ($token->[0] eq 'C') || ($token->[0] eq 'D') ) { + #Style file definitions should be correct + if ($target eq 'tex' && ($Apache::lonxml::usestyle)) { + $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"); + } + if ($Apache::lonxml::redirection) { + $Apache::lonxml::outputstack['-1'] .= $result; + } else { + $finaloutput.=$result; + } + $result = ''; + + if ($token->[0] eq 'E' && !$dontpop) { &end_tag($stack,$parstack,$token); } + $dontpop=0; + } + if ($#$pars > -1) { + pop @$pars; + pop @Apache::lonxml::pwd; } - 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) = @_; - my @pat = (); - &newparser(\@pat,\$newarg); - my $tokenpat; - my $partstring = ''; - my $output=''; - my $decls=''; - 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)) { - &Apache::lonxml::warning("Unbalanced tags in resource $innerstack['-1']"); - &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; - } - return $output; -} - sub callsub { my ($sub,$target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; my $currentstring=''; @@ -471,11 +629,13 @@ sub callsub { my $sub1; no strict 'refs'; my $tag=$token->[1]; - my $space=$Apache::lonxml::alltags{$tag}; +# get utterly rid of extended html tags + if ($tag=~/^x\-/i) { return ''; } + my $space=$Apache::lonxml::alltags{$tag}[-1]; if (!$space) { - $tag=~tr/A-Z/a-z/; + $tag=~tr/A-Z/a-z/; $sub=~tr/A-Z/a-z/; - $space=$Apache::lonxml::alltags{$tag} + $space=$Apache::lonxml::alltags{$tag}[-1] } my $deleted=0; @@ -487,13 +647,13 @@ sub callsub { } if (!$deleted) { if ($space) { - #&Apache::lonxml::debug("Calling sub $sub in $space $metamode
\n"); + #&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
\n"); + #&Apache::lonxml::debug("NOT Calling sub $sub in $space $metamode"); if ($metamode <1) { if (defined($token->[4]) && ($metamode < 1)) { $currentstring = $token->[4]; @@ -505,7 +665,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') { @@ -515,6 +675,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]; } @@ -527,14 +690,26 @@ sub callsub { } sub setup_globals { - my ($target)=@_; + 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') { $Apache::lonxml::redirection = 0; $Apache::lonxml::metamode = 1; $Apache::lonxml::evaluate = 1; $Apache::lonxml::import = 0; + } elsif ($target eq 'answer') { + $Apache::lonxml::redirection = 0; + $Apache::lonxml::metamode = 1; + $Apache::lonxml::evaluate = 1; + $Apache::lonxml::import = 1; } elsif ($target eq 'grade') { &startredirection; $Apache::lonxml::metamode = 0; @@ -550,6 +725,11 @@ sub setup_globals { $Apache::lonxml::metamode = 0; $Apache::lonxml::evaluate = 0; $Apache::lonxml::import = 0; + } elsif ($target eq 'analyze') { + $Apache::lonxml::redirection = 0; + $Apache::lonxml::metamode = 0; + $Apache::lonxml::evaluate = 1; + $Apache::lonxml::import = 1; } else { $Apache::lonxml::redirection = 0; $Apache::lonxml::metamode = 0; @@ -565,6 +745,7 @@ sub init_safespace { $safeeval->permit("sort"); $safeeval->deny(":base_io"); $safehole->wrap(\&Apache::scripttag::xmlparse,$safeeval,'&xmlparse'); + $safehole->wrap(\&Apache::outputtags::multipart,$safeeval,'&multipart'); $safehole->wrap(\&Apache::lonnet::EXT,$safeeval,'&EXT'); $safehole->wrap(\&Math::Cephes::asin,$safeeval,'&asin'); @@ -586,6 +767,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'); @@ -611,10 +823,26 @@ sub init_safespace { #need to inspect this class of ops # $safeeval->deny(":base_orig"); $safeinit .= ';$external::target="'.$target.'";'; - $safeinit .= ';$external::randomseed='.&Apache::lonnet::rndseed().';'; + my $rndseed; + my ($symb,$courseid,$domain,$name) = &Apache::lonxml::whichuser(); + $rndseed=&Apache::lonnet::rndseed($symb,$courseid,$domain,$name); + $safeinit .= ';$external::randomseed='.$rndseed.';'; + &Apache::lonxml::debug("Setting rndseed to $rndseed"); &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 eq -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, ''); @@ -662,7 +890,7 @@ sub decreasedepth { $Apache::lonxml::olddepth=$Apache::lonxml::depth+1; } if ( $Apache::lonxml::depth < -1) { - &Apache::lonxml::warning("Unbalanced tags in resource"); + &Apache::lonxml::warning("Missing tags, unable to properly run file."); $Apache::lonxml::depth='-1'; } my $curdepth=join('_',@Apache::lonxml::depthcounter); @@ -670,89 +898,178 @@ sub decreasedepth { #print "
e $Apache::lonxml::depth : $Apache::lonxml::olddepth : $token->[1] : $curdepth\n"; } -sub get_all_text { +sub get_all_text_unbalanced { +#there is a copy of this in lonpublisher.pm + my($tag,$pars)= @_; + my $token; + my $result=''; + $tag='<'.$tag.'>'; + while ($token = $$pars[-1]->get_token) { + 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') { + $result.=$token->[4]; + } elsif ($token->[0] eq 'E') { + $result.=$token->[2]; + } + if ($result =~ /(.*)\Q$tag\E(.*)/s) { + &Apache::lonxml::debug('Got a winner with leftovers ::'.$2); + &Apache::lonxml::debug('Result is :'.$1); + $result=$1; + my $redo=$tag.$2; + &Apache::lonxml::newparser($pars,\$redo); + last; + } + } + return $result +} + +sub increment_counter { + my ($increment) = @_; + if (defined($increment) && $increment gt 0) { + $Apache::lonxml::counter+=$increment; + } else { + $Apache::lonxml::counter++; + } + $Apache::lonxml::counter_changed=1; +} + +sub init_counter { + if (defined($ENV{'form.counter'})) { + $Apache::lonxml::counter=$ENV{'form.counter'}; + $Apache::lonxml::counter_changed=0; + } else { + $Apache::lonxml::counter=1; + $Apache::lonxml::counter_changed=1; + } +} + +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] 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); + #&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] eq $tag) { - $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 } sub newparser { my ($parser,$contentref,$dir) = @_; - push (@$parser,HTML::TokeParser->new($contentref)); + push (@$parser,HTML::LCParser->new($contentref)); $$parser['-1']->xml_mode('1'); if ( $dir eq '' ) { push (@Apache::lonxml::pwd, $Apache::lonxml::pwd[$#Apache::lonxml::pwd]); } else { push (@Apache::lonxml::pwd, $dir); } -# &Apache::lonxml::debug("pwd:$#Apache::lonxml::pwd"); -# &Apache::lonxml::debug("pwd:$Apache::lonxml::pwd[$#Apache::lonxml::pwd]"); } sub parstring { my ($token) = @_; my $temp=''; - map { + 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\";" + $temp .= "my \$$_=\"$val\";"; } - } @{$token->[3]}; + } return $temp; } sub writeallows { + unless ($#extlinks>=0) { return; } my $thisurl='/res/'.&Apache::lonnet::declutter(shift); + if ($ENV{'httpref.'.$thisurl}) { + $thisurl=$ENV{'httpref.'.$thisurl}; + } my $thisdir=$thisurl; $thisdir=~s/\/[^\/]+$//; my %httpref=(); - map { + foreach (@extlinks) { $httpref{'httpref.'. - &Apache::lonnet::hreflocation($thisdir,$_)}=$thisurl; } @extlinks; + &Apache::lonnet::hreflocation($thisdir,$_)}=$thisurl; + } + @extlinks=(); &Apache::lonnet::appenv(%httpref); } @@ -761,31 +1078,23 @@ sub writeallows { # 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'})); + &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'}, + ['highlight','anchor','link']); if ($ENV{'form.highlight'}) { - map { + foreach (split(/\,/,$ENV{'form.highlight'})) { my $anchorname=$_; my $matchthis=$anchorname; $matchthis=~s/\_+/\\s\+/g; $result=~s/($matchthis)/\$1\<\/font\>/gs; - } split(/\,/,$ENV{'form.highlight'}); + } } if ($ENV{'form.link'}) { - map { + foreach (split(/\,/,$ENV{'form.link'})) { 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'}; @@ -793,7 +1102,7 @@ sub afterburn { $matchthis=~s/\_+/\\s\+/g; $result=~s/($matchthis)/\$1\<\/a\>/s; $result.=(<<"ENDSCRIPT"); - ENDSCRIPT @@ -806,13 +1115,13 @@ sub storefile { if (my $fh=Apache::File->new('>'.$file)) { print $fh $contents; $fh->close(); + } else { + &warning("Unable to save file $file"); } } -sub inserteditinfo { - my ($result,$filecontents)=@_; - unless ($filecontents) { - $filecontents=(< @@ -826,56 +1135,99 @@ sub inserteditinfo { </body> </html> SIMPLECONTENT - } - my $editheader='<a href="#editsection">Edit below</a><hr />'; + return $filecontents; +} + + +sub inserteditinfo { + my ($result,$filecontents)=@_; + $filecontents = &HTML::Entities::encode($filecontents); +# my $editheader='<a href="#editsection">Edit below</a><hr />'; + my $xml_help = Apache::loncommon::helpLatexCheatsheet(); + my $titledisplay=&display_title(); + my $buttons=(<<BUTTONS); +<input type="submit" name="attemptclean" + value="Save and then attempt to clean HTML" /> +<input type="submit" name="savethisfile" value="Save this" /> +<input type="submit" name="viewmode" value="View" /> +BUTTONS my $editfooter=(<<ENDFOOTER); <hr /> <a name="editsection" /> <form method="post"> +$xml_help +<input type="hidden" name="editmode" value="Edit" /> +$buttons<br /> <textarea cols="80" rows="40" name="filecont">$filecontents</textarea> +<br />$buttons <br /> -<input type="submit" name="attemptclean" - value="Save and then attempt to clean HTML" /> -<input type="submit" name="savethisfile" value="Save this" /> </form> +$titledisplay ENDFOOTER - $result=~s/(\<body[^\>]*\>)/$1$editheader/is; +# $result=~s/(\<body[^\>]*\>)/$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'); +sub get_target { + my $viewgrades=&Apache::lonnet::allowed('vgr',$ENV{'request.course.id'}); + if ( $ENV{'request.state'} eq 'published') { + if ( defined($ENV{'form.grade_target'}) + && ($viewgrades == 'F' )) { + return ($ENV{'form.grade_target'}); + } elsif (defined($ENV{'form.grade_target'})) { + if (($ENV{'form.grade_target'} eq 'web') || + ($ENV{'form.grade_target'} eq 'tex') ) { + return $ENV{'form.grade_target'} + } else { + return 'web'; + } + } else { + return 'web'; + } + } elsif ($ENV{'request.state'} eq 'construct') { + if ( defined($ENV{'form.grade_target'})) { + return ($ENV{'form.grade_target'}); + } else { + return 'web'; + } } else { - $request->content_type('text/html'); + return 'web'; } - - $request->send_http_header; - - return OK if $request->header_only; +} + +sub handler { + my $request=shift; + + my $target=&get_target(); + + $Apache::lonxml::debug=$ENV{'user.debug'}; + + if ($ENV{'browser.mathml'}) { + $request->content_type('text/xml'); + } else { + $request->content_type('text/html'); + } + &Apache::loncommon::no_cache($request); + $request->send_http_header; + + return OK if $request->header_only; - my $file=&Apache::lonnet::filelocation("",$request->uri); + 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) { - $result=(<<ENDNOTFOUND); + 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 eq -1) { + $result=(<<ENDNOTFOUND); <html> <head> <title>File not found @@ -886,68 +1238,150 @@ sub handler { ENDNOTFOUND $filecontents=''; - } else { - unless ($ENV{'request.state'} eq 'published') { - if ($ENV{'form.attemptclean'}) { - $filecontents=&htmlclean($filecontents,1); - } - } - $result = &Apache::lonxml::xmlparse($target,$filecontents,'',%mystyle); - } - + if ($ENV{'request.state'} ne 'published') { + $filecontents=&createnewhtml(); + $ENV{'form.editmode'}='Edit'; #force edit mode + } + } else { + unless ($ENV{'request.state'} eq 'published') { + if ($ENV{'form.attemptclean'}) { + $filecontents=&htmlclean($filecontents,1); + } +# +# we are in construction space, see if edit mode forced + &Apache::loncommon::get_unprocessed_cgi + ($ENV{'QUERY_STRING'},['editmode']); + } + if (!$ENV{'form.editmode'} || $ENV{'form.viewmode'}) { + $result = &Apache::lonxml::xmlparse($request,$target,$filecontents, + '',%mystyle); + } + } + # # Edit action? Insert editing commands # - unless ($ENV{'request.state'} eq 'published') { - $result=&inserteditinfo($result,$filecontents); - } + unless ($ENV{'request.state'} eq 'published') { + if ($ENV{'form.editmode'} && (!($ENV{'form.viewmode'}))) { + my $displayfile=$request->uri; + $displayfile=~s/^\/[^\/]*//; + $result='

'.$displayfile. + '

'; + $result=&inserteditinfo($result,$filecontents); + } + } + + writeallows($request->uri); + - $request->print($result); + $request->print($result); + + return OK; +} - writeallows($request->uri); - return OK; +sub display_title { + my $result; + if ($ENV{'request.state'} eq 'construct') { + my $title=&Apache::lonnet::gettitle(); + if (!defined($title) || $title eq '') { + $title = $ENV{'request.filename'}; + $title = substr($title, rindex($title, '/') + 1); + } + $result = ""; + } + return $result; } - + sub debug { if ($Apache::lonxml::debug eq 1) { - print("DEBUG:".$_[0]."
\n"); + $|=1; + print('DEBUG:'.&HTML::Entities::encode($_[0])."\n"); } } sub error { + $errorcount++; if (($Apache::lonxml::debug eq 1) || ($ENV{'request.state'} eq 'construct') ) { - print "ERROR:".$_[0]."
\n"; + # 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'},$_[0]);
+    &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'};
-      foreach my $user (split /\,/, $users) {
-	($user,my $domain) = split /:/, $user;
-	&Apache::lonmsg::user_normal_msg($user,$domain,"Error in $ENV{'request.filename'}",$_[0]);
+      my (undef,%users)=&Apache::lonfeedback::decide_receiver(undef,0,1,1,1);
+      my $declutter=&Apache::lonnet::declutter($ENV{'request.filename'});
+      foreach (keys %users) {
+	my ($user,$domain) = split(/:/, $_);
+	&Apache::lonmsg::user_normal_msg($user,$domain,
+        "Error [$declutter]",join('
',@_));
       }
     }
 
     #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','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:".$_[0]."
\n";
+  $warningcount++;
+  
+  if ($ENV{'form.grade_target'} ne 'tex') {
+      if ($ENV{'request.state'} eq 'construct' || $Apache::lonxml::debug) {
+        print "WARNING:".join('
',@_)."
\n";
+      }
   }
 }
 
 sub get_param {
-  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 ) { 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,$case_insensitive) = @_;
   if ( ! $context ) { $context = -1; }
   my $args ='';
   if ( $#$parstack > (-2-$context) ) { $args=$$parstack[$context]; }
-  return &Apache::run::run("{$args;".'return $'.$param.'}',$safeeval); #'
+  &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); #'
+  &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;
+  }
 }
 
 sub register_insert {
@@ -959,14 +1393,19 @@ 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);
-    $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++;
+    my ($tag,$descrip,$color,$function,$show,$helpfile,$helpdesc) = split(/,/, $line);
+    if ($tag) {
+      $insertlist{"$tagnum.tag"} = $tag;
+      $insertlist{"$tagnum.description"} = $descrip;
+      $insertlist{"$tagnum.color"} = $color;
+      $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++;
+    }
   }
   $i++; #skipping TABLE line
   $tagnum = 0;
@@ -974,7 +1413,7 @@ sub register_insert {
     my $line = $data[$i];
     my ($mnemonic,@which) = split(/ +/,$line);
     my $tag = $insertlist{"$tagnum.tag"};
-    for (my $j=0;$j <$#which;$j++) {
+    for (my $j=0;$j <=$#which;$j++) {
       if ( $which[$j] eq 'Y' ) {
 	if ($insertlist{"$j.show"} ne 'no') {
 	  push(@{ $insertlist{"$tag.which"} },$j);
@@ -987,8 +1426,66 @@ sub register_insert {
 
 sub description {
   my ($token)=@_;
-  return $insertlist{$insertlist{"$token->[1].num"}.'.description'};
+  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.'.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 ($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('vgr',$tmp_courseid);
+    if ($allowed) {
+      $symb=$ENV{'form.grade_symb'};
+      $courseid=$ENV{'form.grade_courseid'};
+      $domain=$ENV{'form.grade_domain'};
+      $name=$ENV{'form.grade_username'};
+    }
+  } else {
+      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,$publicuser);
+}
+
 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.