--- loncom/xml/lonxml.pm 2005/02/17 08:34:56 1.356 +++ loncom/xml/lonxml.pm 2007/09/12 14:34:52 1.461 @@ -1,7 +1,7 @@ # The LearningOnline Network with CAPA # XML Parser Module # -# $Id: lonxml.pm,v 1.356 2005/02/17 08:34:56 albertel Exp $ +# $Id: lonxml.pm,v 1.461 2007/09/12 14:34:52 foxr Exp $ # # Copyright Michigan State University Board of Trustees # @@ -40,8 +40,9 @@ package Apache::lonxml; use vars -qw(@pwd @outputstack $redirection $import @extlinks $metamode $evaluate %insertlist @namespace $errorcount $warningcount @htmlareafields); +qw(@pwd @outputstack $redirection $import @extlinks $metamode $evaluate %insertlist @namespace $errorcount $warningcount); use strict; +use LONCAPA; use HTML::LCParser(); use HTML::TreeBuilder(); use HTML::Entities(); @@ -52,6 +53,7 @@ use Math::Random(); use Opcode(); use POSIX qw(strftime); use Time::HiRes qw( gettimeofday tv_interval ); +use Symbol(); sub register { my ($space,@taglist) = @_; @@ -81,12 +83,13 @@ use Apache::languagetags(); use Apache::edit(); use Apache::inputtags(); use Apache::outputtags(); -use Apache::lonnet(); +use Apache::lonnet; use Apache::File(); use Apache::loncommon(); use Apache::lonfeedback(); use Apache::lonmsg(); use Apache::loncacc(); +use Apache::lonmaxima(); use Apache::lonlocal; #================================================== Main subroutine: xmlparse @@ -122,8 +125,8 @@ $evaluate = 1; # stores the list of active tag namespaces @namespace=(); -# has the dynamic menu been updated to know about this resource -$Apache::lonxml::registered=0; +# stores all Scrit Vars displays for later showing +my @script_var_displays=(); # a pointer the the Apache request object $Apache::lonxml::request=''; @@ -148,42 +151,42 @@ $Apache::lonxml::post_evaluate=1; #a header message to emit in the case of any generated warning or errors $Apache::lonxml::warnings_error_header=''; -sub xmlbegin { - my ($style)=@_; - my $output=''; - @htmlareafields=(); - if ($ENV{'browser.mathml'}) { - $output='' - .'' - .']>' - .''; - } else { - $output=''; - } - if ($style eq 'encode') { - $output=&HTML::Entities::encode($output,'<>&"'); - } - return $output; +# 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. + +sub enable_LaTeX_substitutions { + $Apache::lonxml::substitute_LaTeX_symbols = 1; +} +sub disable_LaTeX_substitutions { + $Apache::lonxml::substitute_LaTeX_symbols = 0; } sub xmlend { my ($target,$parser)=@_; my $mode='xml'; my $status='OPEN'; - if ($Apache::lonhomework::parsing_a_problem) { + if ($Apache::lonhomework::parsing_a_problem || + $Apache::lonhomework::parsing_a_task ) { $mode='problem'; $status=$Apache::inputtags::status[-1]; } - my $discussion=&Apache::lonfeedback::list_discussion($mode,$status); + 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 ''; - } else { - return $discussion.''; } + + return $discussion; } sub tokeninputfield { @@ -241,9 +244,9 @@ sub maketoken { $symb=&Apache::lonnet::symbread(); } unless ($tuname) { - $tuname=$ENV{'user.name'}; - $tudom=$ENV{'user.domain'}; - $tcrsid=$ENV{'request.course.id'}; + $tuname=$env{'user.name'}; + $tudom=$env{'user.domain'}; + $tcrsid=$env{'request.course.id'}; } return &Apache::lonnet::checkout($symb,$tuname,$tudom,$tcrsid); @@ -253,7 +256,7 @@ sub printtokenheader { my ($target,$token,$tsymb,$tcrsid,$tudom,$tuname)=@_; unless ($token) { return ''; } - my ($symb,$courseid,$domain,$name) = &Apache::lonxml::whichuser(); + my ($symb,$courseid,$domain,$name) = &Apache::lonnet::whichuser(); unless ($tsymb) { $tsymb=$symb; } @@ -263,13 +266,7 @@ sub printtokenheader { $tcrsid=$courseid; } - my %reply=&Apache::lonnet::get('environment', - ['firstname','middlename','lastname','generation'], - $tudom,$tuname); - my $plainname=$reply{'firstname'}.' '. - $reply{'middlename'}.' '. - $reply{'lastname'}.' '. - $reply{'generation'}; + my $plainname=&Apache::loncommon::plainname($tuname,$tudom); if ($target eq 'web') { my %idhash=&Apache::lonnet::idrget($tudom,($tuname)); @@ -279,7 +276,7 @@ sub printtokenheader { '
'.&mt('User').': '.$tuname.' at '.$tudom. '
'.&mt('ID').': '.$idhash{$tuname}. '
'.&mt('CourseID').': '.$tcrsid. - '
'.&mt('Course').': '.$ENV{'course.'.$tcrsid.'.description'}. + '
'.&mt('Course').': '.$env{'course.'.$tcrsid.'.description'}. '
'.&mt('DocID').': '.$token. '
'.&mt('Time').': '.&Apache::lonlocal::locallocaltime().'
'; } else { @@ -287,18 +284,6 @@ sub printtokenheader { } } -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) { @@ -312,6 +297,7 @@ sub xmlparse { &setup_globals($request,$target); &Apache::inputtags::initialize_inputtags(); + &Apache::bridgetask::initialize_bridgetask(); &Apache::outputtags::initialize_outputtags(); &Apache::edit::initialize_edit(); &Apache::londefdef::initialize_londefdef(); @@ -320,9 +306,9 @@ sub xmlparse { # do we have a course style file? # - if ($ENV{'request.course.id'} && $ENV{'request.state'} ne 'construct') { + if ($env{'request.course.id'} && $env{'request.state'} ne 'construct') { my $bodytext= - $ENV{'course.'.$ENV{'request.course.id'}.'.default_xml_style'}; + $env{'course.'.$env{'request.course.id'}.'.default_xml_style'}; if ($bodytext) { foreach my $file (split(',',$bodytext)) { my $location=&Apache::lonnet::filelocation('',$file); @@ -333,17 +319,18 @@ sub xmlparse { } } } - } elsif ($ENV{'construct.style'} && ($ENV{'request.state'} eq 'construct')) { - my $location=&Apache::lonnet::filelocation('',$ENV{'construct.style'}); + } 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)); - } + if ($styletext ne '-1') { + %style_for_target = (%style_for_target, + &Apache::style::styleparser($target,$styletext)); + } } #&printalltags(); my @pars = (); - my $pwd=$ENV{'request.filename'}; + my $pwd=$env{'request.filename'}; $pwd =~ s:/[^/]*$::; &newparser(\@pars,\$content_file_string,$pwd); @@ -356,70 +343,67 @@ sub xmlparse { my @stack = (); my @parstack = (); - &initdepth; - + &initdepth(); + &init_alarm(); my $finaloutput = &inner_xmlparse($target,\@stack,\@parstack,\@pars, - $safeeval,\%style_for_target); + $safeeval,\%style_for_target,1); - if ($ENV{'request.uri'}) { - &writeallows($ENV{'request.uri'}); + if (@stack) { + &warning("At end of file some tags were still left unclosed, ". + '<'.join('>, <',reverse(@stack)). + '>'); + } + if ($env{'request.uri'}) { + &writeallows($env{'request.uri'}); } &do_registered_ssi(); if ($Apache::lonxml::counter_changed) { &store_counter() } - return $finaloutput; -} -sub htmlclean { - my ($raw,$full)=@_; -# Take care of CRLF etc - - $raw=~s/\r\f/\n/gs; $raw=~s/\f\r/\n/gs; - $raw=~s/\r\n/\n/gs; $raw=~s/\n\r/\n/gs; - $raw=~s/\f/\n/gs; $raw=~s/\r/\n/gs; - $raw=~s/\&\#10\;/\n/gs; $raw=~s/\&\#13\;/\n/gs; - -# Generate empty tags, remove wrong end tags - $raw=~s/\<(br|hr|img|meta|allow|basefont)([^\>\/]*?)\>/\<$1$2 \/\>/gis; - $raw=~s/\<\/(br|hr|img|meta|allow|basefont)\>//gis; - unless ($full) { - $raw=~s/\<[\/]*(body|head|html)\>//gis; - } -# Make standard tags lowercase - foreach ('html','body','head','meta','h1','h2','h3','h4','b','i','m', - 'table','tr','td','th','p','br','hr','img','embed','font', - 'a','strong','center','title','basefont','li','ol','ul', - 'input','select','form','option','script','pre') { - $raw=~s/\<$_\s*\>/\<$_\>/gis; - $raw=~s/\<\/$_\s*\>/<\/$_\>/gis; - $raw=~s/\<$_\s([^\>]*)\>/<$_ $1\>/gis; - } - return $raw; + &clean_safespace($safeeval); + + if (@script_var_displays) { + $finaloutput .= join('',@script_var_displays); + undef(@script_var_displays); + } + + 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/\\/\$\\backslash\$/g; # \ -> $\backslash$ per LaTex line by line pg 10. $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; + $string =~ s/_/\\_/g; # _ -> \_ + $string =~ s/\^/\\\^{}/g; # ^ -> \^{} } else { $string=~s/\\/\\ensuremath{\\backslash}/g; - $string=~s/([^\\]|^)\%/$1\\\%/g; - $string=~s/([^\\]|^)\$/$1\\\$/g; - $string=~s/([^\\])\_/$1\\_/g; - $string=~s/\$\$/\$\\\$/g; - $string=~s/\_\_/\_\\\_/g; - $string=~s/\#\#/\#\\\#/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/([^\\]|^)\&/$1\\\&/g; - $string=~s/([^\\]|^)\#/$1\\\#/g; + $string=~s/\\\&|\&/\\\&/g; + $string=~s/\\\#|\#/\\\#/g; $string=~s/\|/\$\\mid\$/g; #single { or } How to escape? } @@ -427,11 +411,12 @@ sub latex_special_symbols { } sub inner_xmlparse { - my ($target,$stack,$parstack,$pars,$safeeval,$style_for_target)=@_; + my ($target,$stack,$parstack,$pars,$safeeval,$style_for_target,$start)=@_; my $finaloutput = ''; my $result; my $token; my $dontpop=0; + my $startredirection = $Apache::lonxml::redirection; while ( $#$pars > -1 ) { while ($token = $$pars['-1']->get_token) { if (($token->[0] eq 'T') || ($token->[0] eq 'C') ) { @@ -541,7 +526,12 @@ sub inner_xmlparse { # $finaloutput.=&endredirection; # } - + if ( $start && $target eq 'grade') { &endredirection(); } + if ( $Apache::lonxml::redirection > $startredirection) { + while ($Apache::lonxml::redirection > $startredirection) { + $finaloutput .= &endredirection(); + } + } if (($ENV{'QUERY_STRING'}) && ($target eq 'web')) { $finaloutput=&afterburn($finaloutput); } @@ -570,7 +560,6 @@ sub callsub { } 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, @@ -606,17 +595,23 @@ sub callsub { } elsif ($token->[0] eq 'E') { $currentstring = &Apache::edit::tag_end($target,$token); } - } elsif ($target eq 'modified') { + } + } + if ($target eq 'modified' && $nodefault eq '') { + if ($currentstring eq '') { + if ($token->[0] eq 'S') { + $currentstring = $token->[4]; + } elsif ($token->[0] eq 'E') { + $currentstring = $token->[2]; + } else { + $currentstring = $token->[2]; + } + } if ($token->[0] eq 'S') { - $currentstring = $token->[4]; - $currentstring.=&Apache::edit::handle_insert(); + $currentstring.=&Apache::edit::handle_insert(); } elsif ($token->[0] eq 'E') { - $currentstring = $token->[2]; - $currentstring.=&Apache::edit::handle_insertafter($token->[1]); - } else { - $currentstring = $token->[2]; + $currentstring.=&Apache::edit::handle_insertafter($token->[1]); } - } } } use strict 'refs'; @@ -627,8 +622,6 @@ sub callsub { sub setup_globals { my ($request,$target)=@_; $Apache::lonxml::request=$request; - $Apache::lonxml::registered = 0; - @Apache::lonxml::htmlareafields=(); $errorcount=0; $warningcount=0; $Apache::lonxml::default_homework_loaded=0; @@ -636,9 +629,11 @@ sub setup_globals { &init_counter(); @Apache::lonxml::pwd=(); @Apache::lonxml::extlinks=(); + @script_var_displays=(); @Apache::lonxml::ssi_info=(); $Apache::lonxml::post_evaluate=1; $Apache::lonxml::warnings_error_header=''; + $Apache::lonxml::substitute_LaTeX_symbols = 1; if ($target eq 'meta') { $Apache::lonxml::redirection = 0; $Apache::lonxml::metamode = 1; @@ -650,7 +645,7 @@ sub setup_globals { $Apache::lonxml::evaluate = 1; $Apache::lonxml::import = 1; } elsif ($target eq 'grade') { - &startredirection; + &startredirection(); #ended in inner_xmlparse on exit $Apache::lonxml::metamode = 0; $Apache::lonxml::evaluate = 1; $Apache::lonxml::import = 1; @@ -679,16 +674,30 @@ sub setup_globals { sub init_safespace { my ($target,$safeeval,$safehole,$safeinit) = @_; + $safeeval->deny_only(':dangerous'); + $safeeval->reval('use Math::Complex;'); + $safeeval->permit_only(":default"); $safeeval->permit("entereval"); $safeeval->permit(":base_math"); $safeeval->permit("sort"); $safeeval->permit("time"); + $safeeval->deny("rand"); + $safeeval->deny("srand"); $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(\&Apache::chemresponse::chem_standard_order,$safeeval, '&chem_standard_order'); + $safehole->wrap(\&Apache::response::check_status,$safeeval,'&check_status'); + + $safehole->wrap(\&Apache::lonmaxima::maxima_eval,$safeeval,'&maxima_eval'); + $safehole->wrap(\&Apache::lonmaxima::maxima_check,$safeeval,'&maxima_check'); + $safehole->wrap(\&Apache::lonmaxima::maxima_cas_formula_fix,$safeeval, + '&maxima_cas_formula_fix'); + + $safehole->wrap(\&Apache::caparesponse::capa_formula_fix,$safeeval, + '&capa_formula_fix'); $safehole->wrap(\&Math::Cephes::asin,$safeeval,'&asin'); $safehole->wrap(\&Math::Cephes::acos,$safeeval,'&acos'); @@ -733,6 +742,36 @@ sub init_safespace { $safehole->wrap(\&Math::Cephes::stdtr ,$safeeval,'&stdtr' ); $safehole->wrap(\&Math::Cephes::stdtri,$safeeval,'&stdtri'); + $safehole->wrap(\&Math::Cephes::Matrix::mat,$safeeval,'&mat'); + $safehole->wrap(\&Math::Cephes::Matrix::new,$safeeval, + '&Math::Cephes::Matrix::new'); + $safehole->wrap(\&Math::Cephes::Matrix::coef,$safeeval, + '&Math::Cephes::Matrix::coef'); + $safehole->wrap(\&Math::Cephes::Matrix::clr,$safeeval, + '&Math::Cephes::Matrix::clr'); + $safehole->wrap(\&Math::Cephes::Matrix::add,$safeeval, + '&Math::Cephes::Matrix::add'); + $safehole->wrap(\&Math::Cephes::Matrix::sub,$safeeval, + '&Math::Cephes::Matrix::sub'); + $safehole->wrap(\&Math::Cephes::Matrix::mul,$safeeval, + '&Math::Cephes::Matrix::mul'); + $safehole->wrap(\&Math::Cephes::Matrix::div,$safeeval, + '&Math::Cephes::Matrix::div'); + $safehole->wrap(\&Math::Cephes::Matrix::inv,$safeeval, + '&Math::Cephes::Matrix::inv'); + $safehole->wrap(\&Math::Cephes::Matrix::transp,$safeeval, + '&Math::Cephes::Matrix::transp'); + $safehole->wrap(\&Math::Cephes::Matrix::simq,$safeeval, + '&Math::Cephes::Matrix::simq'); + $safehole->wrap(\&Math::Cephes::Matrix::mat_to_vec,$safeeval, + '&Math::Cephes::Matrix::mat_to_vec'); + $safehole->wrap(\&Math::Cephes::Matrix::vec_to_mat,$safeeval, + '&Math::Cephes::Matrix::vec_to_mat'); + $safehole->wrap(\&Math::Cephes::Matrix::check,$safeeval, + '&Math::Cephes::Matrix::check'); + $safehole->wrap(\&Math::Cephes::Matrix::check,$safeeval, + '&Math::Cephes::Matrix::check'); + # $safehole->wrap(\&Math::Cephes::new_fract,$safeeval,'&new_fract'); # $safehole->wrap(\&Math::Cephes::radd,$safeeval,'&radd'); # $safehole->wrap(\&Math::Cephes::rsub,$safeeval,'&rsub'); @@ -761,21 +800,58 @@ sub init_safespace { $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'); + $safehole->wrap(\&Apache::loncommon::languages,$safeeval,'&languages'); $safehole->wrap(\&Apache::lonxml::error,$safeeval,'&LONCAPA_INTERNAL_ERROR'); $safehole->wrap(\&Apache::lonxml::debug,$safeeval,'&LONCAPA_INTERNAL_DEBUG'); + $safehole->wrap(\&Apache::lonnet::logthis,$safeeval,'&LONCAPA_INTERNAL_LOGTHIS'); + $safehole->wrap(\&Apache::inputtags::finalizeawards,$safeeval,'&LONCAPA_INTERNAL_FINALIZEAWARDS'); $safehole->wrap(\&Apache::caparesponse::get_sigrange,$safeeval,'&LONCAPA_INTERNAL_get_sigrange'); - +# use Data::Dumper; +# $safehole->wrap(\&Data::Dumper::Dumper,$safeeval,'&LONCAPA_INTERNAL_Dumper'); #need to inspect this class of ops # $safeeval->deny(":base_orig"); $safeeval->permit("require"); $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); + &initialize_rndseed($safeeval); +} +sub clean_safespace { + my ($safeeval) = @_; + delete_package_recurse($safeeval->{Root}); +} + +sub delete_package_recurse { + my ($package) = @_; + my @subp; + { + no strict 'refs'; + while (my ($key,$val) = each(%{*{"$package\::"}})) { + if (!defined($val)) { next; } + local (*ENTRY) = $val; + if (defined *ENTRY{HASH} && $key =~ /::$/ && + $key ne "main::" && $key ne "::") + { + my ($p) = $package ne "main" ? "$package\::" : ""; + ($p .= $key) =~ s/::$//; + push(@subp,$p); + } + } + } + foreach my $p (@subp) { + delete_package_recurse($p); + } + Symbol::delete_package($package); +} + +sub initialize_rndseed { + my ($safeeval)=@_; + my $rndseed; + my ($symb,$courseid,$domain,$name) = &Apache::lonnet::whichuser(); + $rndseed=&Apache::lonnet::rndseed($symb,$courseid,$domain,$name); + my $safeinit = '$external::randomseed="'.$rndseed.'";'; + &Apache::lonxml::debug("Setting rndseed to $rndseed"); + &Apache::run::run($safeinit,$safeeval); } sub default_homework_load { @@ -790,6 +866,28 @@ sub default_homework_load { } } +{ + my $alarm_depth; + sub init_alarm { + alarm(0); + $alarm_depth=0; + } + + sub start_alarm { + if ($alarm_depth<1) { + my $old=alarm($Apache::lonnet::perlvar{'lonScriptTimeout'}); + if ($old) { + &Apache::lonxml::error("Cancelled an alarm of $old, this shouldn't occur."); + } + } + $alarm_depth++; + } + + sub end_alarm { + $alarm_depth--; + if ($alarm_depth<1) { alarm(0); } + } +} my $metamode_was; sub startredirection { if (!$Apache::lonxml::redirection) { @@ -802,7 +900,7 @@ sub startredirection { 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); + &Apache::lonxml::error("Endredirection was called before a startredirection, perhaps you have unbalanced tags. Some debugging information:".join ":",caller); return ''; } $Apache::lonxml::redirection--; @@ -811,6 +909,9 @@ sub endredirection { } pop @Apache::lonxml::outputstack; } +sub in_redirection { + return ($Apache::lonxml::redirection > 0) +} sub end_tag { my ($tagstack,$parstack,$token)=@_; @@ -821,54 +922,63 @@ sub end_tag { sub initdepth { @Apache::lonxml::depthcounter=(); - $Apache::lonxml::depth=-1; - $Apache::lonxml::olddepth=-1; + undef($Apache::lonxml::last_depth_count); } + my @timers; my $lasttime; +# @Apache::lonxml::depthcounter -> count of tags that exist so +# far at each level +# $Apache::lonxml::last_depth_count -> when ascending, need to +# remember the count for the level below the current level (for +# example going from 1_2 -> 1 -> 1_3 need to remember the 2 ) + 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; - } + push(@Apache::lonxml::depthcounter,$Apache::lonxml::last_depth_count+1); + undef($Apache::lonxml::last_depth_count); my $time; if ($Apache::lonxml::debug eq "1") { push(@timers,[&gettimeofday()]); $time=&tv_interval($lasttime); $lasttime=[&gettimeofday()]; } - my $spacing=' 'x($Apache::lonxml::depth-1); - my $curdepth=join('_',@Apache::lonxml::depthcounter); - &Apache::lonxml::debug("s$spacing$Apache::lonxml::depth : $Apache::lonxml::olddepth : $curdepth : $token->[1] : $time : \n"); + my $spacing=' 'x($#Apache::lonxml::depthcounter); + $Apache::lonxml::curdepth=join('_',@Apache::lonxml::depthcounter); +# &Apache::lonxml::debug("s$spacing$Apache::lonxml::depth : $Apache::lonxml::olddepth : $Apache::lonxml::curdepth : $token->[1] : $time"); #print "
s $Apache::lonxml::depth : $Apache::lonxml::olddepth : $curdepth : $token->[1]\n"; } 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(&mt("Missing tags, unable to properly run file.")); - $Apache::lonxml::depth='-1'; + if ( $#Apache::lonxml::depthcounter == -1) { + &Apache::lonxml::warning(&mt("Missing tags, unable to properly run file.")); } + $Apache::lonxml::last_depth_count = pop(@Apache::lonxml::depthcounter); + my ($timer,$time); if ($Apache::lonxml::debug eq "1") { $timer=pop(@timers); $time=&tv_interval($lasttime); $lasttime=[&gettimeofday()]; } - my $spacing=' 'x$Apache::lonxml::depth; - my $curdepth=join('_',@Apache::lonxml::depthcounter); - &Apache::lonxml::debug("e$spacing$Apache::lonxml::depth : $Apache::lonxml::olddepth : $curdepth : $token->[1] : $time : ".&tv_interval($timer)."\n"); + my $spacing=' 'x($#Apache::lonxml::depthcounter); + $Apache::lonxml::curdepth = join('_',@Apache::lonxml::depthcounter); +# &Apache::lonxml::debug("e$spacing$Apache::lonxml::depth : $Apache::lonxml::olddepth : $Apache::lonxml::curdepth : $token->[1] : $time : ".&tv_interval($timer)); #print "
e $Apache::lonxml::depth : $Apache::lonxml::olddepth : $token->[1] : $curdepth\n"; } +sub get_id { + my ($parstack,$safeeval)=@_; + my $id= &Apache::lonxml::get_param('id',$parstack,$safeeval); + if ($env{'request.state'} eq 'construct' && $id =~ /([._]|[^\w\d\s[:punct:]])/) { + &error(&mt("ID "[_1]" contains invalid characters, IDs are only allowed to contain letters, numbers, spaces and -",''.$id.'')); + } + if ($id =~ /^\s*$/) { $id = $Apache::lonxml::curdepth; } + return $id; +} + sub get_all_text_unbalanced { #there is a copy of this in lonpublisher.pm my($tag,$pars)= @_; @@ -877,7 +987,11 @@ sub get_all_text_unbalanced { $tag='<'.$tag.'>'; while ($token = $$pars[-1]->get_token) { if (($token->[0] eq 'T')||($token->[0] eq 'C')||($token->[0] eq 'D')) { - $result.=$token->[1]; + if ($token->[0] eq 'T' && $token->[2]) { + $result.='[1].']]>'; + } else { + $result.=$token->[1]; + } } elsif ($token->[0] eq 'PI') { $result.=$token->[2]; } elsif ($token->[0] eq 'S') { @@ -897,6 +1011,24 @@ sub get_all_text_unbalanced { return $result } +=pod + +For bubble grading mode and exam bubble printing mode, the tracking of +the current 'bubble line number' is stored in the %env element +'form.counter', and is modifed and handled by the following routines. + +The value of it is stored in $Apache:lonxml::counter when live and +stored back to env after done. + +=item &increment_counter($increment); + +Increments the internal counter environment variable a specified amount + +Optional Arguments: + $increment - amount to increment by (defaults to 1) + +=cut + sub increment_counter { my ($increment) = @_; if (defined($increment) && $increment gt 0) { @@ -907,9 +1039,20 @@ sub increment_counter { $Apache::lonxml::counter_changed=1; } +=pod + +=item &init_counter($increment); + +Initialize the internal counter environment variable + +=cut + sub init_counter { - if (defined($ENV{'form.counter'})) { - $Apache::lonxml::counter=$ENV{'form.counter'}; + if ($env{'request.state'} eq 'construct') { + $Apache::lonxml::counter=1; + $Apache::lonxml::counter_changed=1; + } elsif (defined($env{'form.counter'})) { + $Apache::lonxml::counter=$env{'form.counter'}; $Apache::lonxml::counter_changed=0; } else { $Apache::lonxml::counter=1; @@ -919,9 +1062,36 @@ sub init_counter { sub store_counter { &Apache::lonnet::appenv(('form.counter' => $Apache::lonxml::counter)); + $Apache::lonxml::counter_changed=0; return ''; } +{ + my $state; + sub clear_problem_counter { + undef($state); + &Apache::lonnet::delenv('form.counter'); + &Apache::lonxml::init_counter(); + &Apache::lonxml::store_counter(); + } + + sub remember_problem_counter { + &Apache::lonnet::transfer_profile_to_env(undef,undef,1); + $state = $env{'form.counter'}; + } + + sub restore_problem_counter { + if (defined($state)) { + &Apache::lonnet::appenv(('form.counter' => $state)); + } + } + sub get_problem_counter { + if ($Apache::lonxml::counter_changed) { &store_counter() } + &Apache::lonnet::transfer_profile_to_env(undef,undef,1); + return $env{'form.counter'}; + } +} + sub get_all_text { my($tag,$pars,$style)= @_; my $gotfullstack=1; @@ -943,7 +1113,11 @@ sub get_all_text { 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]; + if ($token->[2]) { + $result.='[1].']]>'; + } else { + $result.=$token->[1]; + } } elsif ($token->[0] eq 'PI') { $result.=$token->[2]; } elsif ($token->[0] eq 'S') { @@ -995,7 +1169,11 @@ sub get_all_text { #&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]; + if ($token->[2]) { + $result.='[1].']]>'; + } else { + $result.=$token->[1]; + } } elsif ($token->[0] eq 'PI') { $result.=$token->[2]; } elsif ($token->[0] eq 'S') { @@ -1023,7 +1201,8 @@ sub get_all_text { sub newparser { my ($parser,$contentref,$dir) = @_; push (@$parser,HTML::LCParser->new($contentref)); - $$parser['-1']->xml_mode('1'); + $$parser[-1]->xml_mode(1); + $$parser[-1]->marked_sections(1); if ( $dir eq '' ) { push (@Apache::lonxml::pwd, $Apache::lonxml::pwd[$#Apache::lonxml::pwd]); } else { @@ -1032,33 +1211,45 @@ sub newparser { } sub parstring { - my ($token) = @_; - my $temp=''; - foreach (@{$token->[3]}) { - unless ($_=~/\W/) { - my $val=$token->[2]->{$_}; - $val =~ s/([\%\@\\\"\'])/\\$1/g; - $val =~ s/(\$[^{a-zA-Z_])/\\$1/g; - $val =~ s/(\$)$/\\$1/; - #if ($val =~ m/^[\%\@]/) { $val="\\".$val; } - $temp .= "my \$$_=\"$val\";"; + my ($token) = @_; + my (@vars,@values); + foreach my $attr (@{$token->[3]}) { + if ($attr!~/\W/) { + my $val=$token->[2]->{$attr}; + $val =~ s/([\%\@\\\"\'])/\\$1/g; + $val =~ s/(\$[^\{a-zA-Z_])/\\$1/g; + $val =~ s/(\$)$/\\$1/; + #if ($val =~ m/^[\%\@]/) { $val="\\".$val; } + push(@vars,"\$$attr"); + push(@values,"\"$val\""); + } + } + my $var_init = + (@vars) ? 'my ('.join(',',@vars).') = ('.join(',',@values).');' + : ''; + return $var_init; +} + +sub extlink { + my ($res,$exact)=@_; + if (!$exact) { + $res=&Apache::lonnet::hreflocation($Apache::lonxml::pwd[-1],$res); } - } - return $temp; + push(@Apache::lonxml::extlinks,$res) } sub writeallows { unless ($#extlinks>=0) { return; } - my $thisurl='/res/'.&Apache::lonnet::declutter(shift); - if ($ENV{'httpref.'.$thisurl}) { - $thisurl=$ENV{'httpref.'.$thisurl}; + my $thisurl = &Apache::lonnet::clutter(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; + &Apache::lonnet::hreflocation($thisdir,&unescape($_))}=$thisurl; } @extlinks=(); &Apache::lonnet::appenv(%httpref); @@ -1077,6 +1268,12 @@ sub do_registered_ssi { &Apache::lonnet::ssi($url,%form); } } + +sub add_script_result { + my ($display) = @_; + push(@script_var_displays, $display); +} + # # Afterburner handles anchors, highlights and links # @@ -1084,24 +1281,24 @@ 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'})) { + if ($env{'form.highlight'}) { + foreach (split(/\,/,$env{'form.highlight'})) { my $anchorname=$_; my $matchthis=$anchorname; $matchthis=~s/\_+/\\s\+/g; $result=~s/(\Q$matchthis\E)/\$1\<\/font\>/gs; } } - if ($ENV{'form.link'}) { - foreach (split(/\,/,$ENV{'form.link'})) { + if ($env{'form.link'}) { + foreach (split(/\,/,$env{'form.link'})) { my ($anchorname,$linkurl)=split(/\>/,$_); my $matchthis=$anchorname; $matchthis=~s/\_+/\\s\+/g; $result=~s/(\Q$matchthis\E)/\$1\<\/a\>/gs; } } - if ($ENV{'form.anchor'}) { - my $anchorname=$ENV{'form.anchor'}; + if ($env{'form.anchor'}) { + my $anchorname=$env{'form.anchor'}; my $matchthis=$anchorname; $matchthis=~s/\_+/\\s\+/g; $result=~s/(\Q$matchthis\E)/\$1\<\/a\>/s; @@ -1131,7 +1328,6 @@ sub createnewhtml { my $title=&mt('Title of document goes here'); my $body=&mt('Body of document goes here'); my $filecontents=(< $title @@ -1158,18 +1354,20 @@ SIMPLECONTENT sub inserteditinfo { - my ($result,$filecontents,$filetype)=@_; + my ($filecontents,$filetype)=@_; $filecontents = &HTML::Entities::encode($filecontents,'<>&"'); # my $editheader='Edit below
'; my $xml_help = ''; my $initialize=''; - if ($filetype eq 'html') { - my $addbuttons=&Apache::lonhtmlcommon::htmlareaaddbuttons(); - $initialize=&Apache::lonhtmlcommon::htmlareaheaders(). - &Apache::lonhtmlcommon::spellheader(); - if (!&Apache::lonhtmlcommon::htmlareablocked() && - &Apache::lonhtmlcommon::htmlareabrowser()) { - $initialize.=(< $addbuttons @@ -1179,76 +1377,91 @@ $addbuttons var editor=new HTMLArea("filecont",config); editor.registerPlugin(FullPage); editor.generate(); + setTimeout( + function () { + HTMLArea._addEvents(editor._doc, + ["keypress","mousedown"], unClean); + editor._iframe.id = '$textarea_id'; + resize_textarea('$textarea_id','LC_aftertextarea'); + },300); } FULLPAGE - } else { - $initialize.=(< $addbuttons function initDocument() { + resize_textarea('$textarea_id','LC_aftertextarea'); } FULLPAGE - } - $result=~s/\]*)\>/\/i; - $xml_help=&Apache::loncommon::helpLatexCheatsheet(); } - my $cleanbut = ''; + + $add_to_onload = 'initDocument();'; + $add_to_onresize = "resize_textarea('$textarea_id','LC_aftertextarea');"; + if ($filetype eq 'html') { - $cleanbut=''; + $xml_help=&Apache::loncommon::helpLatexCheatsheet(); } + + my $cleanbut = ''; + my $titledisplay=&display_title(); - my %lt=&Apache::lonlocal::texthash('st' => 'Save this', - 'vi' => 'View', + my %lt=&Apache::lonlocal::texthash('st' => 'Save and Edit', + 'vi' => 'Save and View', + 'dv' => 'Discard Edits and View', + 'un' => 'undo', 'ed' => 'Edit'); my $buttons=(< +
BUTTONS $buttons.=&Apache::lonhtmlcommon::spelllink('xmledit','filecont'); - $buttons.=&Apache::lonhtmlcommon::htmlareaselectactive('filecont'); + my $textarea_events = &Apache::edit::element_change_detection(); + my $form_events = &Apache::edit::form_change_detection(); my $editfooter=(< -
+ $xml_help $buttons
- + +

$buttons
- $titledisplay +
+ ENDFOOTER -# $result=~s/(\]*\>)/$1$editheader/is; - $result=~s/(\<\/body\>)/$editfooter/is; - return $result; + return ($editfooter,$add_to_onload,$add_to_onresize);; } 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'}) + 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'} + 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'}); + } elsif ($env{'request.state'} eq 'construct') { + if ( defined($env{'form.grade_target'})) { + return ($env{'form.grade_target'}); } else { return 'web'; } @@ -1262,16 +1475,14 @@ sub handler { my $target=&get_target(); - $Apache::lonxml::debug=$ENV{'user.debug'}; + $Apache::lonxml::debug=$env{'user.debug'}; - if ($ENV{'browser.mathml'}) { - &Apache::loncommon::content_type($request,'text/xml'); - } else { - &Apache::loncommon::content_type($request,'text/html'); - } + &Apache::loncommon::content_type($request,'text/html'); &Apache::loncommon::no_cache($request); - $request->set_last_modified(&Apache::lonnet::metadata($request->uri, - 'lastrevisiondate')); + 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; @@ -1287,81 +1498,102 @@ sub handler { # # Edit action? Save file. # - unless ($ENV{'request.state'} eq 'published') { - if (($ENV{'form.savethisfile'}) || ($ENV{'form.attemptclean'})) { - if (&storefile($file,$ENV{'form.filecont'})) { - &Apache::lonxml::info("". - &mt('Updated').": ". - &Apache::lonlocal::locallocaltime(time). - " "); - } + if (!($env{'request.state'} eq 'published')) { + if ($env{'form.savethisfile'} || $env{'form.viewmode'} || $env{'form.Undo'}) { + my $html_file=&Apache::lonnet::getfile($file); + my $error = &Apache::lonhomework::handle_save_or_undo($request, \$html_file, \$env{'form.filecont'}); } } my %mystyle; my $result = ''; my $filecontents=&Apache::lonnet::getfile($file); if ($filecontents eq -1) { - my $bodytag=&Apache::loncommon::bodytag('File Error'); + my $start_page=&Apache::loncommon::start_page('File Error'); + my $end_page=&Apache::loncommon::end_page(); my $fnf=&mt('File not found'); $result=(< - -$fnf - -$bodytag +$start_page $fnf: $file - - +$end_page ENDNOTFOUND $filecontents=''; - if ($ENV{'request.state'} ne 'published') { + if ($env{'request.state'} ne 'published') { if ($filetype eq 'sty') { $filecontents=&createnewsty(); } else { $filecontents=&createnewhtml(); } - $ENV{'form.editmode'}='Edit'; #force edit mode + $env{'form.editmode'}='Edit'; #force edit mode } } else { - unless ($ENV{'request.state'} eq 'published') { + 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.')); - } - - if ($ENV{'form.attemptclean'}) { - $filecontents=&htmlclean($filecontents,1); + &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']); + &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'}, + ['editmode']); } - if (!$ENV{'form.editmode'} || $ENV{'form.viewmode'}) { + if (!$env{'form.editmode'} || $env{'form.viewmode'} || $env{'form.discardview'}) { + &Apache::structuretags::reset_problem_globals(); $result = &Apache::lonxml::xmlparse($request,$target,$filecontents, '',%mystyle); + # .html files may contain or need to clean + # up if it did + &Apache::structuretags::reset_problem_globals(); + &Apache::lonhomework::finished_parsing(); + &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'}, + ['rawmode']); + if ($env{'form.rawmode'}) { $result = $filecontents; } + if ($filetype eq 'sty') { + my $controls = + ($env{'request.state'} eq 'construct') ? &Apache::londefdef::edit_controls() + : ''; + my %options = ('bgcolor' => '#FFFFFF'); + $result = + &Apache::loncommon::start_page(undef,undef,\%options). + $controls. + $result. + &Apache::loncommon::end_page(); + } } } - + # # Edit action? Insert editing commands # - unless ($ENV{'request.state'} eq 'published') { - if ($ENV{'form.editmode'} && (!($ENV{'form.viewmode'}))) { + unless ($env{'request.state'} eq 'published') { + if ($env{'form.editmode'} && (!($env{'form.viewmode'})) && (!($env{'form.discardview'}))) + { + my ($edit_info, $add_to_onload, $add_to_onresize)= + &inserteditinfo($filecontents,$filetype); + my $displayfile=$request->uri; $displayfile=~s/^\/[^\/]*//; - my $bodytag=''; - if ($ENV{'environment.remote'} eq 'off') { - $bodytag=&Apache::loncommon::bodytag(); + my %options = + ('add_entries' => + {'onresize' => $add_to_onresize, + 'onload' => $add_to_onload, }); + + if ($env{'environment.remote'} ne 'off') { + $options{'bgcolor'} = '#FFFFFF'; + $options{'only_body'} = 1; } - $result=''.$bodytag. + my $js = + &Apache::edit::js_change_detection(). + &Apache::loncommon::resize_textarea_js(); + my $start_page = &Apache::loncommon::start_page(undef,$js, + \%options); + $result=$start_page. &Apache::lonxml::message_location().'

'. $displayfile. - '

'; - $result=&inserteditinfo($result,$filecontents,$filetype); + ''. + $edit_info. + &Apache::loncommon::end_page(); } } - if ($filetype eq 'html') { writeallows($request->uri); } - + if ($filetype eq 'html') { &writeallows($request->uri); } &Apache::lonxml::add_messages(\$result); $request->print($result); @@ -1371,10 +1603,10 @@ ENDNOTFOUND sub display_title { my $result; - if ($ENV{'request.state'} eq 'construct') { + if ($env{'request.state'} eq 'construct') { my $title=&Apache::lonnet::gettitle(); if (!defined($title) || $title eq '') { - $title = $ENV{'request.filename'}; + $title = $env{'request.filename'}; $title = substr($title, rindex($title, '/') + 1); } $result = ""; @@ -1386,31 +1618,52 @@ sub debug { if ($Apache::lonxml::debug eq "1") { $|=1; my $request=$Apache::lonxml::request; - if (!$request) { $request=Apache->request; } + if (!$request) { + eval { $request=Apache->request; }; + } + if (!$request) { + eval { $request=Apache2::RequestUtil->request; }; + } $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'})) { + 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') || + ($env{'request.state'} eq 'construct') || ($Apache::lonhomework::browse eq 'F' && - $ENV{'form.show_errors'} eq 'on')); + $env{'form.show_errors'} eq 'on')); } sub error { + my @errors = @_; + $errorcount++; + + if (defined($Apache::inputtags::part)) { + if ( @Apache::inputtags::response ) { + push(@errors, + &mt("This error occurred while processing response [_1] in part [_2]", + $Apache::inputtags::response[-1], + $Apache::inputtags::part)); + } else { + push(@errors, + &mt("This error occurred while processing part [_1]", + $Apache::inputtags::part)); + } + } + 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"); + "ERROR:".join("
\n",@errors)."
\n"); $Apache::lonxml::warnings_error_header=''; } else { my $errormsg; @@ -1418,21 +1671,42 @@ sub error { 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'}; + push(@errors, "The error occurred on host $host"); + + my $msg = join('
', @errors); + #notify author - &Apache::lonmsg::author_res_msg($ENV{'request.filename'},join('
',@_)); + &Apache::lonmsg::author_res_msg($env{'request.filename'},$msg); #notify course - if ( $symb && $ENV{'request.course.id'} ) { - my (undef,%users)=&Apache::lonfeedback::decide_receiver(undef,0,1,1,1); - my $declutter=&Apache::lonnet::declutter($ENV{'request.filename'}); + 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::lonmsg::decide_receiver(undef,0,1,1,1); + my $declutter=&Apache::lonnet::declutter($env{'request.filename'}); + my $baseurl = &Apache::lonnet::clutter($declutter); my @userlist; foreach (keys %users) { my ($user,$domain) = split(/:/, $_); push(@userlist,"$user\@$domain"); - &Apache::lonmsg::user_normal_msg($user,$domain, - "Error [$declutter]",join('
',@_)); + my $key=$declutter.'_'.$user.'_'.$domain; + my %lastnotified=&Apache::lonnet::get('nohist_xmlerrornotifications', + [$key], + $cdom,$cnum); + my $now=time; + if ($now-$lastnotified{$key}>86400) { + my $title = &Apache::lonnet::gettitle($symb); + my $sentmessage; + &Apache::lonmsg::user_normal_msg($user,$domain, + "Error [$title]",$msg,'',$baseurl,'','', + \$sentmessage,$symb,$title,1); + &Apache::lonnet::put('nohist_xmlerrornotifications', + {$key => $now}, + $cdom,$cnum); + } } - if ($ENV{'request.role.adv'}) { + 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."); @@ -1445,10 +1719,8 @@ sub error { sub warning { $warningcount++; - if ($ENV{'form.grade_target'} ne 'tex') { + if ($env{'form.grade_target'} ne 'tex') { if ( &show_error_warn_msg() ) { - my $request=$Apache::lonxml::request; - if (!$request) { $request=Apache->request; } push(@Apache::lonxml::warning_messages, $Apache::lonxml::warnings_error_header. "WARNING:".join('
',@_)."
\n"); @@ -1458,8 +1730,8 @@ sub warning { } sub info { - if ($ENV{'form.grade_target'} ne 'tex' - && $ENV{'request.state'} eq 'construct') { + if ($env{'form.grade_target'} ne 'tex' + && $env{'request.state'} eq 'construct') { push(@Apache::lonxml::info_messages,join('
',@_)."
\n"); } } @@ -1491,14 +1763,14 @@ sub get_param { } if ( ! $args ) { return undef; } if ( $case_insensitive ) { - if ($args =~ s/(my \$)(\Q$param\E)(=\")/$1.lc($2).$3/ei) { + if ($args =~ s/(my (?:.*))(\$\Q$param\E[,\)])/$1.lc($2)/ei) { return &Apache::run::run("{$args;".'return $'.$param.'}', $safeeval); #' } else { return undef; } } else { - if ( $args =~ /my \$\Q$param\E=\"/ ) { + if ( $args =~ /my .*\$\Q$param\E[,\)]/ ) { return &Apache::run::run("{$args;".'return $'.$param.'}', $safeeval); #' } else { @@ -1517,10 +1789,10 @@ sub get_param_var { } &Apache::lonxml::debug("Args are $args param is $param"); if ($case_insensitive) { - if (! ($args=~s/(my \$)(\Q$param\E)(=\")/$1.lc($2).$3/ei)) { + if (! ($args=~s/(my (?:.*))(\$\Q$param\E[,\)])/$1.lc($2)/ei)) { return undef; } - } elsif ( $args !~ /my \$\Q$param\E=\"/ ) { 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*$/) { @@ -1536,113 +1808,144 @@ sub get_param_var { } } -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++; +sub register_insert_xml { + my $parser = HTML::LCParser->new($Apache::lonnet::perlvar{'lonTabDir'} + .'/insertlist.xml'); + my ($tagnum,$in_help)=(0,0); + my @alltags; + my $tag; + while (my $token = $parser->get_token()) { + if ($token->[0] eq 'S') { + my $key; + if ($token->[1] eq 'tag') { + $tag = $token->[2]{'name'}; + $insertlist{"$tagnum.tag"} = $tag; + $insertlist{"$tag.num"} = $tagnum; + push(@alltags,$tag); + } elsif ($in_help && $token->[1] eq 'file') { + $key = $tag.'.helpfile'; + } elsif ($in_help && $token->[1] eq 'description') { + $key = $tag.'.helpdesc'; + } elsif ($token->[1] eq 'description' || + $token->[1] eq 'color' || + $token->[1] eq 'show' ) { + $key = $tag.'.'.$token->[1]; + } elsif ($token->[1] eq 'insert_sub') { + $key = $tag.'.function'; + } elsif ($token->[1] eq 'help') { + $in_help=1; + } elsif ($token->[1] eq 'allow') { + $key = $tag.'.allow'; + } + if (defined($key)) { + $insertlist{$key} = $parser->get_text(); + $insertlist{$key} =~ s/(^\s*|\s*$ )//gx; + } + } elsif ($token->[0] eq 'E') { + if ($token->[1] eq 'tag') { + undef($tag); + $tagnum++; + } elsif ($token->[1] eq 'help') { + undef($in_help); + } + } } - } - $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); + + # parse the allows and ignore tags set to no + foreach my $tag (@alltags) { + next if (!exists($insertlist{"$tag.allow"})); + my $allow = $insertlist{"$tag.allow"}; + foreach my $element (split(',',$allow)) { + $element =~ s/(^\s*|\s*$ )//gx; + if (!exists($insertlist{"$element.show"}) + || $insertlist{"$element.show"} ne 'no') { + push(@{ $insertlist{$tag.'.which'} },$element); + } } - } } - $tagnum++; - } +} + +sub register_insert { + return ®ister_insert_xml(@_); +# &dump_insertlist('2'); +} + +sub dump_insertlist { + my ($ext) = @_; + open(XML,">/tmp/insertlist.xml.$ext"); + print XML (""); + my $i=0; + + while (exists($insertlist{"$i.tag"})) { + my $tag = $insertlist{"$i.tag"}; + print XML (" +\t"); + if (defined($insertlist{"$tag.description"})) { + print XML (" +\t\t".$insertlist{"$tag.description"}.""); + } + if (defined($insertlist{"$tag.color"})) { + print XML (" +\t\t".$insertlist{"$tag.color"}.""); + } + if (defined($insertlist{"$tag.function"})) { + print XML (" +\t\t".$insertlist{"$tag.function"}.""); + } + if (defined($insertlist{"$tag.show"}) + && $insertlist{"$tag.show"} ne 'yes') { + print XML (" +\t\t".$insertlist{"$tag.show"}.""); + } + if (defined($insertlist{"$tag.helpfile"})) { + print XML (" +\t\t +\t\t\t".$insertlist{"$tag.helpfile"}.""); + if ($insertlist{"$tag.helpdesc"} ne '') { + print XML (" +\t\t\t".$insertlist{"$tag.helpdesc"}.""); + } + print XML (" +\t\t"); + } + if (defined($insertlist{"$tag.which"})) { + print XML (" +\t\t".join(',',sort(@{ $insertlist{"$tag.which"} })).""); + } + print XML (" +\t"); + $i++; + } + print XML ("\n\n"); + close(XML); } 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'}; + my ($token)=@_; + my $tag = &get_tag($token); + return $insertlist{$tag.'.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'}); + my ($token)=@_; + my $tag = &get_tag($token); + return ($insertlist{$tag.'.helpfile'}, $insertlist{$tag.'.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); +sub get_tag { + my ($token)=@_; + my $tagnum; + my $tag=$token->[1]; + foreach my $namespace (reverse(@Apache::lonxml::namespace)) { + my $testtag = $namespace.'::'.$tag; + $tagnum = $insertlist{"$testtag.num"}; + last if (defined($tagnum)); + } + if (!defined($tagnum)) { + $tagnum = $Apache::lonxml::insertlist{"$tag.num"}; + } + return $insertlist{"$tagnum.tag"}; } 1; 500 Internal Server Error

Internal Server Error

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

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

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