--- loncom/xml/lonxml.pm 2000/06/19 15:52:29 1.1 +++ loncom/xml/lonxml.pm 2003/05/01 15:49:26 1.249 @@ -1,1305 +1,1432 @@ -package Apache::lonxml; - +# The LearningOnline Network with CAPA +# XML Parser Module +# +# $Id: lonxml.pm,v 1.249 2003/05/01 15:49:26 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/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,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 $prevent_entity_encode $errorcount $warningcount); use strict; -use HTML::TokeParser; -use Safe; +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,@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::lontexconvert(); +use Apache::style(); +use Apache::run(); +use Apache::londefdef(); +use Apache::scripttag(); +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=(); + +#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=(); + +# 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=(); + +# 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; + +sub xmlbegin { + my $output=''; + if ($ENV{'browser.mathml'}) { + $output='' + .'' + .']>' + .''; + } else { + $output=''; + } + return $output; +} +sub xmlend { + my ($discussiononly,$symb)=@_; + 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); + 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'}) { + unless ($discussiononly) { + $discussion.= + '
'; + } + my $idx; + for ($idx=1;$idx<=$contrib{'version'};$idx++) { + 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. + '

'; + } + } + } + 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.($discussiononly?'':''); +} + +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 +} -#======================================================= Main subroutine: xmlparse +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'}; + } + + return &Apache::lonnet::checkout($symb,$tuname,$tudom,$tcrsid); +} + +sub printtokenheader { + my ($target,$token,$tsymb,$tcrsid,$tudom,$tuname)=@_; + unless ($token) { return ''; } + + my ($symb,$courseid,$domain,$name) = &Apache::lonxml::whichuser(); + unless ($tsymb) { + $tsymb=$symb; + } + unless ($tuname) { + $tuname=$name; + $tudom=$domain; + $tcrsid=$courseid; + } + + 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 fontsettings() { + my $headerstring=''; + if (($ENV{'browser.os'} eq 'mac') && (!$ENV{'browser.mathml'})) { + $headerstring.= + ''; + } elsif (!$ENV{'browser.mathml'}) { + $headerstring.= + ''; + } + return $headerstring; +} + +sub printalltags { + my $temp; + foreach $temp (sort keys %Apache::lonxml::alltags) { + &Apache::lonxml::debug("$temp -- ". + join(',',@{ $Apache::lonxml::alltags{$temp} })); + } +} sub xmlparse { + 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(); + +# +# 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:/[^/]*$::; + &newparser(\@pars,\$content_file_string,$pwd); + + my $safeeval = new Safe; + my $safehole = new Safe::Hole; + &init_safespace($target,$safeeval,$safehole,$safeinit); +#-------------------- Redefinition of the target in the case of compound target + + ($target, my @tenta) = split('&&',$target); + + 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; +} + +sub htmlclean { + my ($raw,$full)=@_; - my ($target,$content_file_string,%style_for_target) = @_; - my $pars = HTML::TokeParser->new(\$content_file_string); - my $currentstring = ''; - my $finaloutput = ''; - my $newarg = ''; - my $tempostring = ''; - my $tempocont = ''; - my $safeeval = new Safe; - -#------------------------- Redefinition of the target in the case of compound target - ($target, my @tenta) = split('&&',$target); -#------------------------------ Stack definition (in stack we have all current tags) - - my @stack = (); - my @parstack = (); - -#------------------------------------------ Parse input string (content_file_string) - - my $token; - - while ($token = $pars->get_token) { - if ($token->[0] eq 'T') { - $finaloutput .= $token->[1]; - $tempocont .= $token->[1]; - } elsif ($token->[0] eq 'S') { -#------------------------------------------------------------------ add tag to stack - push (@stack,$token->[1]); -#---------------------------------------------- add parameters list to another stack - map {$tempostring .= "$_=$token->[2]->{$_},"} @{$token->[3]}; - push (@parstack,$tempostring); - $tempostring = ''; - $tempocont = ''; - - if (exists $style_for_target{$token->[1]}) { - -#--------------------------------------------------------- use style file definition - - $newarg = $style_for_target{$token->[1]}; - - if (index($newarg,'script') != -1 ) { - my $pat = HTML::TokeParser->new(\$newarg); - my $tokenpat; - my $partstring = ''; - my $oustring = ''; - my $outputstring; - - while ($tokenpat = $pat->get_token) { - if ($tokenpat->[0] eq 'T') { - $oustring .= $tokenpat->[1]; - } elsif ($tokenpat->[0] eq 'S') { - if ($tokenpat->[1] eq 'script') { - while ($tokenpat = $pat->get_token and $tokenpat->[1] ne 'script') { - if ($tokenpat->[0] eq 'S') { - $partstring .= $tokenpat->[4]; - } elsif ($tokenpat->[0] eq 'T') { - $partstring .= $tokenpat->[1]; - } elsif ($tokenpat->[0] eq 'E') { - $partstring .= $tokenpat->[2]; - } - } - - map {$partstring =~ s/\$$_/$token->[2]->{$_}/g; } @{$token->[3]}; - - &run($partstring,$safeeval); - $partstring = ''; - } elsif ($tokenpat->[1] eq 'evaluate') { - $outputstring = &evaluate($tokenpat->[2]{expression},$safeeval); - $oustring .= $outputstring; - } else { - $oustring .= $tokenpat->[4]; - } - } elsif ($tokenpat->[0] eq 'E' and $tokenpat->[1] ne 'evaluate') { - $oustring .= $tokenpat->[1]; - } - } - $newarg = $oustring; - } else { - map {$newarg =~ s/\$$_/$token->[2]->{$_}/g; } @{$token->[3]}; - } - $finaloutput .= $newarg; - } else { -#----------------------------------------------------- use default definition of tag - my $sub="start_$token->[1]"; - - { - no strict 'refs'; - if (defined (&$sub)) { - $currentstring = &$sub($target,$token,\@parstack); - $finaloutput .= $currentstring; - $currentstring = ''; - } else { - $finaloutput .= $token->[4]; - } - use strict 'refs'; - } - } - } elsif ($token->[0] eq 'E') { - pop @stack; - unless (exists $style_for_target{$token->[1]}) { - my $sub="end_$token->[1]"; - { - no strict 'refs'; - if (defined (&$sub)) { - $currentstring = &$sub($target,$token,\@parstack); - $finaloutput .= $currentstring; - $currentstring = ''; - } else { - $finaloutput .= $token->[4]; - } - use strict 'refs'; - } - } -#------------------------------------------------------- end tag from the style file - if (exists $style_for_target{'/'."$token->[1]"}) { - $newarg = $style_for_target{'/'."$token->[1]"}; - my @very_temp = split(',',@parstack[$#parstack]); - map {my @ret= split('=',$_); $newarg =~ s/\$$ret[0]/$ret[1]/g; } @very_temp; - $finaloutput .= $newarg; - } - pop @parstack; + my $tree = HTML::TreeBuilder->new; + $tree->ignore_unknown(0); + + $tree->parse($raw); + + my $output= $tree->as_HTML(undef,' '); + + $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; + } + + $tree = $tree->delete; + + 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 + } + return $current_token; +} + +sub inner_xmlparse { + my ($target,$stack,$parstack,$pars,$safeeval,$style_for_target)=@_; + 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) { + my $text=$token->[1]; + if ($token->[0] eq 'C' && $target eq 'tex') { + $text = ''; +# $text = '%'.$text."\n"; + } + $result.=$text; + } + } 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 ($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); + } + } elsif ($token->[0] eq 'E') { + #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); + } + } + + 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); + } + } else { + &Apache::lonxml::error("Unknown token event :$token->[0]:$token->[1]:"); + } + #evaluate variable refs in result + if ($result ne "") { + if ( $#$parstack > -1 ) { + $result=&Apache::run::evaluate($result,$safeeval,$$parstack[-1]); + } else { + $result= &Apache::run::evaluate($result,$safeeval,''); + } + } + 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') { + &end_tag($stack,$parstack,$token); + } + } + if ($#$pars > -1) { + 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 callsub { + my ($sub,$target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; + my $currentstring=''; + my $nodefault; + { + my $sub1; + no strict 'refs'; + my $tag=$token->[1]; +# 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/; + $sub=~tr/A-Z/a-z/; + $space=$Apache::lonxml::alltags{$tag}[-1] + } + + 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"); + $sub1="$space\:\:$sub"; + ($currentstring,$nodefault) = &$sub1($target,$token,$tagstack, + $parstack,$parser,$safeeval, + $style); + } else { + #&Apache::lonxml::debug("NOT Calling sub $sub in $space $metamode"); + 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(); + } elsif ($token->[0] eq 'E') { + $currentstring = $token->[2]; + $currentstring.=&Apache::edit::handle_insertafter($token->[1]); + } else { + $currentstring = $token->[2]; + } } + } } - return $finaloutput; + use strict 'refs'; + } + return $currentstring; } +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') { + $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; + $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; + } 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; + $Apache::lonxml::evaluate = 1; + $Apache::lonxml::import = 1; + } +} -#================================================================== style subroutine +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::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'); + $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.'";'; + 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 styleparser { +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; + } +} - my ($target,$content_style_string) = @_; +sub startredirection { + $Apache::lonxml::redirection++; + push (@Apache::lonxml::outputstack, ''); +} -#------------------------------------------------ target redefinition (if necessary) - - my @target_string = ''; - my $element; - - ($element,@target_string) = split ('&&',$target); +sub endredirection { + if (!$Apache::lonxml::redirection) { + &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; +} - map {$content_style_string =~ s/\<(.*)$_\>/\<$1$element\>/g; } @target_string; - - $target = $element; - -#------------------------------------------------- create a table for defined target -#---------------------------------------------- from the information from Style File +sub end_tag { + my ($tagstack,$parstack,$token)=@_; + pop(@$tagstack); + pop(@$parstack); + &decreasedepth($token); +} - my @value_style = (); - my $current_key = ''; - my $current_value = ''; +sub initdepth { + @Apache::lonxml::depthcounter=(); + $Apache::lonxml::depth=-1; + $Apache::lonxml::olddepth=-1; +} - my $pstyle = HTML::TokeParser->new(\$content_style_string); +sub increasedepth { + my ($token) = @_; + $Apache::lonxml::depth++; + $Apache::lonxml::depthcounter[$Apache::lonxml::depth]++; + if ($Apache::lonxml::depthcounter[$Apache::lonxml::depth]==1) { + $Apache::lonxml::olddepth=$Apache::lonxml::depth; + } + my $curdepth=join('_',@Apache::lonxml::depthcounter); + &Apache::lonxml::debug("s $Apache::lonxml::depth : $Apache::lonxml::olddepth : $curdepth : $token->[1]\n"); +#print "
s $Apache::lonxml::depth : $Apache::lonxml::olddepth : $curdepth : $token->[1]\n"; +} - my $stoken; +sub decreasedepth { + my ($token) = @_; + $Apache::lonxml::depth--; + if ($Apache::lonxml::depth<$Apache::lonxml::olddepth-1) { + $#Apache::lonxml::depthcounter--; + $Apache::lonxml::olddepth=$Apache::lonxml::depth+1; + } + if ( $Apache::lonxml::depth < -1) { + &Apache::lonxml::warning("Missing tags, unable to properly run file."); + $Apache::lonxml::depth='-1'; + } + my $curdepth=join('_',@Apache::lonxml::depthcounter); + &Apache::lonxml::debug("e $Apache::lonxml::depth : $Apache::lonxml::olddepth : $token->[1] : $curdepth\n"); +#print "
e $Apache::lonxml::depth : $Apache::lonxml::olddepth : $token->[1] : $curdepth\n"; +} - while ($stoken = $pstyle->get_token) { -#---------------------------------------------------------- start for tag definition - if ($stoken->[0] eq 'S' and $stoken->[1] eq 'definetag') { -#------------------------------------------------------------------- new key in hash - $current_key = $stoken->[2]{name}; - if ($target eq 'meta') { -#-------------------------------------------------- reserved for the metadate output +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; +} - } else { -#-------------------------------------------------------------------- outtext output - while ($stoken = $pstyle->get_token and $stoken->[1] ne 'outtext') { - } - while ($stoken = $pstyle->get_token and $stoken->[0] ne 'S') { - $current_value .= $stoken->[1]; - } - while ($stoken->[1] ne 'definetag') { - if ($stoken->[0] eq 'S' and $stoken->[1] eq $target) { - while ($stoken = $pstyle->get_token) { - if ($stoken->[1] ne $target) { - if ($stoken->[0] eq 'S') { - $current_value .= $stoken->[4]; - } - if ($stoken->[0] eq 'E') { - $current_value .= $stoken->[2]; - } - if ($stoken->[0] eq 'T') { - $current_value .= $stoken->[1]; - } - } else { - last; - } - } - } elsif ($stoken->[0] eq 'S' and $stoken->[1] ne $target) { - while ($stoken = $pstyle->get_token and $stoken->[0] ne 'E') { - } - } - - while ($stoken = $pstyle->get_token) { - if ($stoken->[0] eq 'T') { - $current_value .= $stoken->[1]; - } - if ($stoken->[0] eq 'E') { - last; - } - if ($stoken->[0] eq 'S') { - last; - } - } - +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:"); + 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); + } + } + if ($top_empty && $depth >= 0) { + #never found the end tag ran out of text, throw error send back blank + &error('Never found end tag for <'.$tag.'>'); + if ($gotfullstack) { + my $newstring=''.$result; + &Apache::lonxml::newparser($pars,\$newstring); + } + $result=''; + } + } else { + while ($#$pars > -1) { + while ($token = $$pars[-1]->get_token) { + #&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]; } - - } - push (@value_style,lc $current_key,$current_value); - $current_key = ''; - $current_value = ''; + } + if (($#$pars > 0) ) { + pop(@$pars); + pop(@Apache::lonxml::pwd); + } else { last; } + } + } + if ($result =~ m||) { + $Apache::lonxml::usestyle=1; + } + #&Apache::lonxml::debug("Exit:$result:"); + return $result +} + +sub newparser { + my ($parser,$contentref,$dir) = @_; + 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=''; + foreach (@{$token->[3]}) { + unless ($_=~/\W/) { + my $val=$token->[2]->{$_}; + $val =~ s/([\%\@\\\"\'])/\\$1/g; + #if ($val =~ m/^[\%\@]/) { $val="\\".$val; } + $temp .= "my \$$_=\"$val\";" + } + } + 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=(); + foreach (@extlinks) { + $httpref{'httpref.'. + &Apache::lonnet::hreflocation($thisdir,$_)}=$thisurl; + } + @extlinks=(); + &Apache::lonnet::appenv(%httpref); +} + +# +# Afterburner handles anchors, highlights and links +# +sub afterburn { + my $result=shift; + &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'}, + ['highlight','anchor','link']); + if ($ENV{'form.highlight'}) { + foreach (split(/\,/,$ENV{'form.highlight'})) { + my $anchorname=$_; + my $matchthis=$anchorname; + $matchthis=~s/\_+/\\s\+/g; + $result=~s/($matchthis)/\$1\<\/font\>/gs; + } + } + if ($ENV{'form.link'}) { + foreach (split(/\,/,$ENV{'form.link'})) { + my ($anchorname,$linkurl)=split(/\>/,$_); + my $matchthis=$anchorname; + $matchthis=~s/\_+/\\s\+/g; + $result=~s/($matchthis)/\$1\<\/a\>/gs; + } + } + 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(); + } else { + &warning("Unable to save file $file"); + } +} +sub createnewhtml { + my $filecontents=(< + + + Title of Document Goes Here + + + + + Body of Document Goes Here + + + +SIMPLECONTENT + return $filecontents; +} + + +sub inserteditinfo { + my ($result,$filecontents)=@_; + $filecontents = &HTML::Entities::encode($filecontents); +# my $editheader='Edit below
'; + my $xml_help = '
'. + &Apache::loncommon::help_open_topic("Greek_Symbols",'Greek Symbols', + undef,undef,600) + .''. + &Apache::loncommon::help_open_topic("Other_Symbols",'Other Symbols', + undef,undef,600) + .'
'; + my $buttons=(< + + +BUTTONS + my $editfooter=(< + +
+$xml_help + +$buttons
+ +
$buttons +
+
+ENDFOOTER +# $result=~s/(\]*\>)/$1$editheader/is; + $result=~s/(\<\/body\>)/$editfooter/is; + return $result; +} + +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'; } - - my %style_for_target = @value_style; - -#-------------------------------------------------------------------- check printing -# while (($current_key,$current_value) = each %style_for_target) { -# print "$current_key => $current_value\n"; -# } + } else { + return 'web'; + } + } elsif ($ENV{'request.state'} eq 'construct') { + if ( defined($ENV{'form.grade_target'})) { + return ($ENV{'form.grade_target'}); + } else { + return 'web'; + } + } else { + return 'web'; + } +} - return %style_for_target; - +sub handler { + my $request=shift; + + my $target=&get_target(); + + $Apache::lonxml::debug=0; + + 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); +# +# 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 eq -1) { + $result=(< + +File not found + + +File not found: $file + + +ENDNOTFOUND + $filecontents=''; + 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); + } + } + 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') { + 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); + + return OK; } +sub debug { + if ($Apache::lonxml::debug eq 1) { + $|=1; + 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";
+  } else {
+    print "An Error occured while processing this resource. The instructor has been notified. 
";
+    #notify author
+    &Apache::lonmsg::author_res_msg($ENV{'request.filename'},join('
',@_));
+    #notify course
+    if ( $ENV{'request.course.id'} ) {
+      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('
',@_));
+      }
+    }
 
-#=============================================================== Subroutine definition
-#--------------------------------------------------------------------------------- Run 
-        sub evaluate {
-	    my ($expression,$safeeval) = @_;
-            return $safeeval->reval($expression);
-        }
-
-        sub run {
-	    my ($code,$safeeval) = @_;
-            $safeeval->reval($code);
-        }
-
-#===================================================================== TAG SUBROUTINES
-#-----------------------------------------------------------------------------  tag
-        sub start_m {
-	    my ($target,$token) = @_;
-            my $currentstring = '';
-            if ($target eq 'web') {
-              $currentstring = "\$out = lontexconvert::converted(\$in = '\$'.\"";     
-	    } elsif ($target eq 'tex') {
-              $currentstring = "\$";
-            }
-	   return $currentstring;
-	}
-        sub end_m {
-	    my ($target,$token) = @_;
-            my $currentstring = '';
-            if ($target eq 'web') {
-              $currentstring = "\".'\$') ";    
-            } elsif ($target eq 'tex') {
-              $currentstring = "\$";
-            }
-	   return $currentstring;
-	}
-#--------------------------------------------------------------------------  tag    
-      sub start_html {
-	    my ($target,$token) = @_;
-            my $currentstring = '';
-            if ($target eq 'web') {
-              $currentstring = $token->[4];     
-	    } 
-	   return $currentstring;
-	}
-        sub end_html {
-	    my ($target,$token) = @_;
-            my $currentstring = '';
-            if ($target eq 'web') {
-              $currentstring = $token->[2];    
-            } 
-	   return $currentstring;
-	}
-#--------------------------------------------------------------------------  tag
-      sub start_head {
-	    my ($target,$token) = @_;
-            my $currentstring = '';
-            if ($target eq 'web') {
-              $currentstring = $token->[4];     
-	    } 
-	   return $currentstring;
-	}
-        sub end_head {
-	    my ($target,$token) = @_;
-            my $currentstring = '';
-            if ($target eq 'web') {
-              $currentstring = $token->[2];    
-            } 
-	   return $currentstring;
-	}
-#---------------------------------------------------------------------------  tag
-      sub start_map {
-	    my ($target,$token) = @_;
-            my $currentstring = '';
-            if ($target eq 'web') {
-              $currentstring = $token->[4];     
-	    } 
-	   return $currentstring;
-	}
-        sub end_map {
-	    my ($target,$token) = @_;
-            my $currentstring = '';
-            if ($target eq 'web') {
-              $currentstring = $token->[2];    
-            } 
-	   return $currentstring;
-	}
-#------------------------------------------------------------------------  tag
-      sub start_applet {
-	    my ($target,$token) = @_;
-            my $currentstring = '';
-            if ($target eq 'web') {
-              $currentstring = $token->[4];     
-	    } 
-	   return $currentstring;
-	}
-        sub end_applet {
-	    my ($target,$token) = @_;
-            my $currentstring = '';
-            if ($target eq 'web') {
-              $currentstring = $token->[2];    
-            } 
-	   return $currentstring;
-	}
-#------------------------------------------------------------------------  tag
-      sub start_input {
-	    my ($target,$token) = @_;
-            my $currentstring = '';
-            if ($target eq 'web') {
-              $currentstring = $token->[4];     
-	    } 
-	   return $currentstring;
-	}
-        sub end_input {
-	    my ($target,$token) = @_;
-            my $currentstring = '';
-            if ($target eq 'web') {
-              $currentstring = $token->[2];    
-            } 
-	   return $currentstring;
-	}
-#----------------------------------------------------------------------