--- loncom/xml/lonxml.pm 2000/06/19 15:52:29 1.1 +++ loncom/xml/lonxml.pm 2006/06/27 14:22:39 1.413 @@ -1,1305 +1,1783 @@ -package Apache::lonxml; - +# The LearningOnline Network with CAPA +# XML Parser Module +# +# $Id: lonxml.pm,v 1.413 2006/06/27 14:22:39 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. +# + + +package Apache::lonxml; +use vars +qw(@pwd @outputstack $redirection $import @extlinks $metamode $evaluate %insertlist @namespace $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(); +use POSIX qw(strftime); +use Time::HiRes qw( gettimeofday tv_interval ); +use Symbol(); + +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::languagetags(); +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(); +use Apache::lonlocal; + +#================================================== 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=(); + +# 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=''; + +#array of ssi calls that need to occur after we are done parsing +@Apache::lonxml::ssi_info=(); + +#should we do the postag variable interpolation +$Apache::lonxml::post_evaluate=1; + +#a header message to emit in the case of any generated warning or errors +$Apache::lonxml::warnings_error_header=''; + +# Control whether or not LaTeX symbols should be substituted for their +# \ style equivalents...this may be turned off e.g. in an verbatim +# environment. +$Apache::lonxml::substitute_LaTeX_symbols = 1; # Starts out on. -#======================================================= Main subroutine: xmlparse +sub enable_LaTeX_substitutions { + $Apache::lonxml::substitute_LaTeX_symbols = 1; +} +sub disable_LaTeX_substitutions { + $Apache::lonxml::substitute_LaTeX_symbols = 0; +} -sub xmlparse { +sub xmlend { + my ($target,$parser)=@_; + my $mode='xml'; + my $status='OPEN'; + if ($Apache::lonhomework::parsing_a_problem || + $Apache::lonhomework::parsing_a_task ) { + $mode='problem'; + $status=$Apache::inputtags::status[-1]; + } + my $discussion; + &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'}, + ['LONCAPA_INTERNAL_no_discussion']); + if (! exists($env{'form.LONCAPA_INTERNAL_no_discussion'}) || + $env{'form.LONCAPA_INTERNAL_no_discussion'} ne 'true') { + $discussion=&Apache::lonfeedback::list_discussion($mode,$status); + } + if ($target eq 'tex') { + $discussion.='\keephidden{ENDOFPROBLEM}\vskip 0.5mm\noindent\makebox[\textwidth/$number_of_columns][b]{\hrulefill}\end{document}'; + &Apache::lonxml::newparser($parser,\$discussion,''); + return ''; + } - 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) + return $discussion; +} - my @stack = (); - my @parstack = (); +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 +} -#------------------------------------------ Parse input string (content_file_string) - - my $token; +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'}; + } - 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; - } - } - return $finaloutput; + 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; + } -#================================================================== style subroutine + my $plainname=&Apache::loncommon::plainname($tuname,$tudom); -sub styleparser { + if ($target eq 'web') { + my %idhash=&Apache::lonnet::idrget($tudom,($tuname)); + return + ''. + &mt('Checked out for').' '.$plainname. + '
'.&mt('User').': '.$tuname.' at '.$tudom. + '
'.&mt('ID').': '.$idhash{$tuname}. + '
'.&mt('CourseID').': '.$tcrsid. + '
'.&mt('Course').': '.$env{'course.'.$tcrsid.'.description'}. + '
'.&mt('DocID').': '.$token. + '
'.&mt('Time').': '.&Apache::lonlocal::locallocaltime().'
'; + } else { + return $token; + } +} - my ($target,$content_style_string) = @_; +sub printalltags { + my $temp; + foreach $temp (sort keys %Apache::lonxml::alltags) { + &Apache::lonxml::debug("$temp -- ". + join(',',@{ $Apache::lonxml::alltags{$temp} })); + } +} -#------------------------------------------------ target redefinition (if necessary) - - my @target_string = ''; - my $element; - - ($element,@target_string) = split ('&&',$target); - - map {$content_style_string =~ s/\<(.*)$_\>/\<$1$element\>/g; } @target_string; - - $target = $element; - -#------------------------------------------------- create a table for defined target -#---------------------------------------------- from the information from Style File - - my @value_style = (); - my $current_key = ''; - my $current_value = ''; - - my $pstyle = HTML::TokeParser->new(\$content_style_string); - - my $stoken; - - 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 - - - } 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; - } - } - - } - } - - } - push (@value_style,lc $current_key,$current_value); - $current_key = ''; - $current_value = ''; +sub xmlparse { + my ($request,$target,$content_file_string,$safeinit,%style_for_target) = @_; + &setup_globals($request,$target); + &Apache::inputtags::initialize_inputtags(); + &Apache::bridgetask::initialize_bridgetask(); + &Apache::outputtags::initialize_outputtags(); + &Apache::edit::initialize_edit(); + &Apache::londefdef::initialize_londefdef(); + +# +# 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) { + foreach my $file (split(',',$bodytext)) { + my $location=&Apache::lonnet::filelocation('',$file); + my $styletext=&Apache::lonnet::getfile($location); + if ($styletext ne '-1') { + %style_for_target = (%style_for_target, + &Apache::style::styleparser($target,$styletext)); + } + } + } + } elsif ($env{'construct.style'} && ($env{'request.state'} eq 'construct')) { + my $location=&Apache::lonnet::filelocation('',$env{'construct.style'}); + my $styletext=&Apache::lonnet::getfile($location); + if ($styletext ne '-1') { + %style_for_target = (%style_for_target, + &Apache::style::styleparser($target,$styletext)); } - - my %style_for_target = @value_style; - -#-------------------------------------------------------------------- check printing -# while (($current_key,$current_value) = each %style_for_target) { -# print "$current_key => $current_value\n"; -# } - - return %style_for_target; - + } +#&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(); + &init_alarm(); + my $finaloutput = &inner_xmlparse($target,\@stack,\@parstack,\@pars, + $safeeval,\%style_for_target,1); + + if ($env{'request.uri'}) { + &writeallows($env{'request.uri'}); + } + &do_registered_ssi(); + if ($Apache::lonxml::counter_changed) { &store_counter() } + + &clean_safespace($safeeval); + + if ($env{'form.return_only_error_and_warning_counts'}) { + return "$errorcount:$warningcount"; + } + return $finaloutput; } +sub latex_special_symbols { + my ($string,$where)=@_; + # + # If e.g. in verbatim mode, then don't substitute. + # but return original string. + # + if (!($Apache::lonxml::substitute_LaTeX_symbols)) { + return $string; + } + if ($where eq 'header') { + $string =~ s/(\\|_|\^)/ /g; + $string =~ s/(\$|%|\{|\})/\\$1/g; + $string =~ s/_/ /g; + $string=&Apache::lonprintout::character_chart($string); + # any & or # leftover should be safe to just escape + $string=~s/([^\\])\&/$1\\\&/g; + $string=~s/([^\\])\#/$1\\\#/g; + } else { + $string=~s/\\/\\ensuremath{\\backslash}/g; + $string=~s/\\\%|\%/\\\%/g; + $string=~s/\\{|{/\\{/g; + $string=~s/\\}|}/\\}/g; + $string=~s/\\ensuremath\\{\\backslash\\}/\\ensuremath{\\backslash}/g; + $string=~s/\\\$|\$/\\\$/g; + $string=~s/\\\_|\_/\\\_/g; + $string=~s/([^\\]|^)(\~|\^)/$1\\$2\\strut /g; + $string=~s/(>|<)/\\ensuremath\{$1\}/g; #more or less + $string=&Apache::lonprintout::character_chart($string); + # any & or # leftover should be safe to just escape + $string=~s/\\\&|\&/\\\&/g; + $string=~s/\\\#|\#/\\\#/g; + $string=~s/\|/\$\\mid\$/g; +#single { or } How to escape? + } + return $string; +} - -#=============================================================== 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; - } -#---------------------------------------------------------------------- +
$buttons +
+ +$titledisplay + +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'; + } + } 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'; + } +} + +sub handler { + my $request=shift; + + my $target=&get_target(); + + $Apache::lonxml::debug=$env{'user.debug'}; + + &Apache::loncommon::content_type($request,'text/html'); + &Apache::loncommon::no_cache($request); + if ($env{'request.state'} eq 'published') { + $request->set_last_modified(&Apache::lonnet::metadata($request->uri, + 'lastrevisiondate')); + } + $request->send_http_header; + + return OK if $request->header_only; + + + my $file=&Apache::lonnet::filelocation("",$request->uri); + my $filetype; + if ($file =~ /\.sty$/) { + $filetype='sty'; + } else { + $filetype='html'; + } +# +# Edit action? Save file. +# + unless ($env{'request.state'} eq 'published') { + if ($env{'form.savethisfile'}) { + if (&storefile($file,$env{'form.filecont'})) { + &Apache::lonxml::info("". + &mt('Updated').": ". + &Apache::lonlocal::locallocaltime(time). + " "); } - return $currentstring; } - sub end_dir { - my ($target,$token) = @_; - my $currentstring = ''; - if ($target eq 'web') { - $currentstring = $token->[2]; - } elsif ($target eq 'tex') { - $currentstring = " \\end{itemize}"; - } - return $currentstring; + } + my %mystyle; + my $result = ''; + my $filecontents=&Apache::lonnet::getfile($file); + if ($filecontents eq -1) { + my $start_page=&Apache::loncommon::start_page('File Error'); + my $end_page=&Apache::loncommon::end_page(); + my $fnf=&mt('File not found'); + $result=(<$fnf: $file +$end_page +ENDNOTFOUND + $filecontents=''; + if ($env{'request.state'} ne 'published') { + if ($filetype eq 'sty') { + $filecontents=&createnewsty(); + } else { + $filecontents=&createnewhtml(); + } + $env{'form.editmode'}='Edit'; #force edit mode } -#----------------------------------------------------------------------------
    tag - sub start_ol { - my ($target,$token) = @_; - my $currentstring = ''; - if ($target eq 'web') { - $currentstring = $token->[4]; - } elsif ($target eq 'tex') { - $currentstring = " \\begin{enumerate} "; - } - return $currentstring; + } else { + unless ($env{'request.state'} eq 'published') { + if ($filecontents=~/BEGIN LON-CAPA Internal/) { + &Apache::lonxml::error(&mt('This file appears to be a rendering of a LON-CAPA resource. If this is correct, this resource will act very oddly and incorrectly.')); + } +# +# 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); + undef($Apache::lonhomework::parsing_a_task); + &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'}, + ['rawmode']); + if ($env{'form.rawmode'}) { $result = $filecontents; } } - sub end_ol { - my ($target,$token) = @_; - my $currentstring = ''; - if ($target eq 'web') { - $currentstring = $token->[2]; - } elsif ($target eq 'tex') { - $currentstring = " \\end{enumerate}"; - } - return $currentstring; + } + +# +# Edit action? Insert editing commands +# + unless ($env{'request.state'} eq 'published') { + if ($env{'form.editmode'} && (!($env{'form.viewmode'}))) { + my $displayfile=$request->uri; + $displayfile=~s/^\/[^\/]*//; + my %options = (); + if ($env{'environment.remote'} ne 'off') { + $options{'bgcolor'} = '#FFFFFF'; + } + my $start_page = &Apache::loncommon::start_page(undef,undef, + \%options); + $result=$start_page. + &Apache::lonxml::message_location().'

    '. + $displayfile. + '

    '.&Apache::loncommon::end_page(); + $result=&inserteditinfo($result,$filecontents,$filetype); } -#----------------------------------------------------------------------------
    tag - sub start_dl { - my ($target,$token) = @_; - my $currentstring = ''; - if ($target eq 'web') { - $currentstring = $token->[4]; - } elsif ($target eq 'tex') { - $currentstring = " \\begin{description} "; - } - return $currentstring; + } + if ($filetype eq 'html') { &writeallows($request->uri); } + + + &Apache::lonxml::add_messages(\$result); + $request->print($result); + + 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); } - sub end_dl { - my ($target,$token) = @_; - my $currentstring = ''; - if ($target eq 'web') { - $currentstring = $token->[2]; - } elsif ($target eq 'tex') { - $currentstring = " \\end{description}"; - } - return $currentstring; + $result = ""; + } + return $result; +} + +sub debug { + if ($Apache::lonxml::debug eq "1") { + $|=1; + my $request=$Apache::lonxml::request; + if (!$request) { + eval { $request=Apache->request; }; } -#----------------------------------------------------------------------------
    tag - sub start_dt { - my ($target,$token) = @_; - my $currentstring = ''; - if ($target eq 'web') { - $currentstring = $token->[4]; - } elsif ($target eq 'tex') { - $currentstring = "\\item[ "; - } - return $currentstring; + if (!$request) { + eval { $request=Apache2::RequestUtil->request; }; } - sub end_dt { - my ($target,$token) = @_; - my $currentstring = ''; - if ($target eq 'web') { - $currentstring = $token->[2]; - } elsif ($target eq 'tex') { - $currentstring = "]"; - } - return $currentstring; + $request->print('
    DEBUG:'.&HTML::Entities::encode($_[0],'<>&"')."
    \n"); + #&Apache::lonnet::logthis($_[0]); + } +} + +sub show_error_warn_msg { + if ($env{'request.filename'} eq '/home/httpd/html/res/lib/templates/simpleproblem.problem' && + &Apache::lonnet::allowed('mdc',$env{'request.course.id'})) { + return 1; + } + return (($Apache::lonxml::debug eq 1) || + ($env{'request.state'} eq 'construct') || + ($Apache::lonhomework::browse eq 'F' + && + $env{'form.show_errors'} eq 'on')); +} + +sub error { + $errorcount++; + if ( &show_error_warn_msg() ) { + # If printing in construction space, put the error inside 
    
+	push(@Apache::lonxml::error_messages,
+	     $Apache::lonxml::warnings_error_header.
+	     "ERROR:".join("
    \n",@_)."
    \n");
+	$Apache::lonxml::warnings_error_header='';
+    } else {
+	my $errormsg;
+	my ($symb)=&Apache::lonnet::symbread();
+	if ( !$symb ) {
+	    #public or browsers
+	    $errormsg=&mt("An error occured while processing this resource. The author has been notified.");
+	}
+	my $host=$Apache::lonnet::perlvar{'lonHostID'};
+	my $msg = join('
    ',(@_,"The occured on host $host"));
+	#notify author
+	&Apache::lonmsg::author_res_msg($env{'request.filename'},$msg);
+	#notify course
+	if ( $symb && $env{'request.course.id'} ) {
+	    my $cnum=$env{'course.'.$env{'request.course.id'}.'.num'};
+	    my $cdom=$env{'course.'.$env{'request.course.id'}.'.domain'};
+	    my (undef,%users)=&Apache::lonfeedback::decide_receiver(undef,0,1,1,1);
+	    my $declutter=&Apache::lonnet::declutter($env{'request.filename'});
+	    my @userlist;
+	    foreach (keys %users) {
+		my ($user,$domain) = split(/:/, $_);
+		push(@userlist,"$user\@$domain");
+		my $key=$declutter.'_'.$user.'_'.$domain;
+		my %lastnotified=&Apache::lonnet::get('nohist_xmlerrornotifications',
+						      [$key],
+						      $cdom,$cnum);
+		my $now=time;
+		if ($now-$lastnotified{$key}>86400) {
+		    &Apache::lonmsg::user_normal_msg($user,$domain,
+						 "Error [$declutter]",$msg);
+		    &Apache::lonnet::put('nohist_xmlerrornotifications',
+					 {$key => $now},
+					 $cdom,$cnum);		
+		}
+	    }
+	    if ($env{'request.role.adv'}) {
+		$errormsg=&mt("An error occured while processing this resource. The course personnel ([_1]) and the author have been notified.",join(', ',@userlist));
+	    } else {
+		$errormsg=&mt("An error occured while processing this resource. The instructor has been notified.");
+	    }
 	}
-#---------------------------------------------------------------------------- 
     tag
-        sub start_dd {
-	    my ($target,$token) = @_;
-            my $currentstring = '';
-            if ($target eq 'web') {
-              $currentstring = $token->[4];     
-	    } 
-	   return $currentstring;
+	push(@Apache::lonxml::error_messages,"$errormsg 
    ");
+    }
+}
+
+sub warning {
+    $warningcount++;
+  
+    if ($env{'form.grade_target'} ne 'tex') {
+	if ( &show_error_warn_msg() ) {
+	    push(@Apache::lonxml::warning_messages,
+		 $Apache::lonxml::warnings_error_header.
+		 "WARNING:".join('
    ',@_)."
    \n");
+	    $Apache::lonxml::warnings_error_header='';
 	}
-        sub end_dd {
-	    my ($target,$token) = @_;
-            my $currentstring = '';
-            if ($target eq 'web') {
-              $currentstring = $token->[2];    
-            } 
-	   return $currentstring;
-	}
-#-------------------------------------------------------------------------  tag
-        sub start_table {
-	    my ($target,$token) = @_;
-            my $currentstring = '';
-            if ($target eq 'web') {
-              $currentstring = $token->[4];     
-	    } elsif ($target eq 'tex') {
-              $currentstring = " \\begin{tabular} ";  
-	    } 
-	   return $currentstring;
+    }
+}
+
+sub info {
+    if ($env{'form.grade_target'} ne 'tex' 
+	&& $env{'request.state'} eq 'construct') {
+	push(@Apache::lonxml::info_messages,join('
    ',@_)."
    \n");
+    }
+}
+
+sub message_location {
+    return '__LONCAPA_INTERNAL_MESSAGE_LOCATION__';
+}
+
+sub add_messages {
+    my ($msg)=@_;
+    my $result=join(' ',
+		    @Apache::lonxml::info_messages,
+		    @Apache::lonxml::error_messages,
+		    @Apache::lonxml::warning_messages);
+    undef(@Apache::lonxml::info_messages);
+    undef(@Apache::lonxml::error_messages);
+    undef(@Apache::lonxml::warning_messages);
+    $$msg=~s/__LONCAPA_INTERNAL_MESSAGE_LOCATION__/$result/;
+    $$msg=~s/__LONCAPA_INTERNAL_MESSAGE_LOCATION__//g;
+}
+
+sub get_param {
+    my ($param,$parstack,$safeeval,$context,$case_insensitive) = @_;
+    if ( ! $context ) { $context = -1; }
+    my $args ='';
+    if ( $#$parstack > (-2-$context) ) { $args=$$parstack[$context]; }
+    if ( ! $Apache::lonxml::usestyle ) {
+	$args=$Apache::lonxml::style_values.$args;
+    }
+    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 end_table {
-	    my ($target,$token) = @_;
-            my $currentstring = '';
-            if ($target eq 'web') {
-              $currentstring = $token->[2];     
-	    } elsif ($target eq 'tex') {
-              $currentstring = " \\end{tabular}";  
-	    } 
-	   return $currentstring;
+    }
+}
+
+sub get_param_var {
+  my ($param,$parstack,$safeeval,$context,$case_insensitive) = @_;
+  if ( ! $context ) { $context = -1; }
+  my $args ='';
+  if ( $#$parstack > (-2-$context) ) { $args=$$parstack[$context]; }
+  if ( ! $Apache::lonxml::usestyle ) {
+      $args=$Apache::lonxml::style_values.$args;
+  }
+  &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 =~ /^[\$\@\%][a-zA-Z_]\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 {
+  my @data = split /\n/, &Apache::lonnet::getfile('/home/httpd/lonTabs/insertlist.tab');
+  my $i;
+  my $tagnum=0;
+  my @order;
+  for ($i=0;$i < $#data; $i++) {
+    my $line = $data[$i];
+    if ( $line =~ /^\#/ || $line =~ /^\s*\n/) { next; }
+    if ( $line =~ /TABLE/ ) { last; }
+    my ($tag,$descrip,$color,$function,$show,$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;
+  for (;$i < $#data;$i++) {
+    my $line = $data[$i];
+    my ($mnemonic,@which) = split(/ +/,$line);
+    my $tag = $insertlist{"$tagnum.tag"};
+    for (my $j=0;$j <=$#which;$j++) {
+      if ( $which[$j] eq 'Y' ) {
+	if ($insertlist{"$j.show"} ne 'no') {
+	  push(@{ $insertlist{"$tag.which"} },$j);
 	}
+      }
+    }
+    $tagnum++;
+  }
+}
+
+sub description {
+  my ($token)=@_;
+  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)=
+	  &Apache::loncommon::get_env_multiple('form.grade_courseid');
+      my $allowed=&Apache::lonnet::allowed('vgr',$tmp_courseid);
+      if (!$allowed && 
+	  exists($env{'request.course.sec'}) && 
+	  $env{'request.course.sec'} !~ /^\s*$/) {
+	  $allowed=&Apache::lonnet::allowed('vgr',$tmp_courseid.
+					    '/'.$env{'request.course.sec'});
+      }
+      if ($allowed) {
+	  ($symb)=&Apache::loncommon::get_env_multiple('form.grade_symb');
+	  $courseid=$tmp_courseid;
+	  ($domain)=&Apache::loncommon::get_env_multiple('form.grade_domain');
+	  ($name)=&Apache::loncommon::get_env_multiple('form.grade_username');
+	  return ($symb,$courseid,$domain,$name,$publicuser);
+      }
+  }
+  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__
+
+