--- loncom/xml/lonxml.pm 2004/08/29 08:17:22 1.332.2.1 +++ loncom/xml/lonxml.pm 2005/12/08 19:37:05 1.393 @@ -1,7 +1,7 @@ # The LearningOnline Network with CAPA # XML Parser Module # -# $Id: lonxml.pm,v 1.332.2.1 2004/08/29 08:17:22 albertel Exp $ +# $Id: lonxml.pm,v 1.393 2005/12/08 19:37:05 albertel Exp $ # # Copyright Michigan State University Board of Trustees # @@ -51,7 +51,8 @@ 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) = @_; @@ -81,7 +82,7 @@ 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(); @@ -149,29 +150,50 @@ $Apache::lonxml::post_evaluate=1; $Apache::lonxml::warnings_error_header=''; sub xmlbegin { - my $output=''; - @htmlareafields=(); - if ($ENV{'browser.mathml'}) { - $output='' - .'' - .']>' + my ($style)=@_; + my $output=''; + @htmlareafields=(); + if ($env{'browser.mathml'}) { + $output='' + #.''."\n" +# .'] >' + .'' .''; - } else { - $output=''; - } - return $output; + .'xmlns="http://www.w3.org/1999/xhtml">'; + } else { + $output=''; + } + if ($style eq 'encode') { + $output=&HTML::Entities::encode($output,'<>&"'); + } + return $output; } 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]; } - return &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.&Apache::loncommon::endbodytag(); + } } sub tokeninputfield { @@ -229,9 +251,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); @@ -251,13 +273,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)); @@ -267,7 +283,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 { @@ -275,12 +291,12 @@ sub printtokenheader { } } -sub fontsettings() { +sub fontsettings { my $headerstring=''; - if (($ENV{'browser.os'} eq 'mac') && (!$ENV{'browser.mathml'})) { + if (($env{'browser.os'} eq 'mac') && (!$env{'browser.mathml'})) { $headerstring.= - ''; - } elsif (!$ENV{'browser.mathml'} && $ENV{'browser.unicode'}) { + ''; + } elsif (!$env{'browser.mathml'} && $env{'browser.unicode'}) { $headerstring.= ''; } @@ -300,6 +316,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(); @@ -308,19 +325,21 @@ 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) { - 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)); - } - } - } elsif ($ENV{'construct.style'} && ($ENV{'request.state'} eq 'construct')) { - my $location=&Apache::lonnet::filelocation('',$ENV{'construct.style'}); + 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, @@ -329,7 +348,7 @@ sub xmlparse { } #&printalltags(); my @pars = (); - my $pwd=$ENV{'request.filename'}; + my $pwd=$env{'request.filename'}; $pwd =~ s:/[^/]*$::; &newparser(\@pars,\$content_file_string,$pwd); @@ -342,38 +361,23 @@ sub xmlparse { my @stack = (); my @parstack = (); - &initdepth; - + &initdepth(); + &init_alarm(); my $finaloutput = &inner_xmlparse($target,\@stack,\@parstack,\@pars, $safeeval,\%style_for_target); - if ($ENV{'request.uri'}) { - &writeallows($ENV{'request.uri'}); + 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)=@_; - - 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; - } + &clean_safespace($safeeval); - $tree = $tree->delete; - - return $output; + if ($env{'form.return_only_error_and_warning_counts'}) { + return "$errorcount:$warningcount"; + } + return $finaloutput; } sub latex_special_symbols { @@ -388,18 +392,18 @@ sub latex_special_symbols { $string=~s/([^\\])\#/$1\\\#/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? } @@ -412,6 +416,7 @@ sub inner_xmlparse { 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') ) { @@ -521,7 +526,12 @@ sub inner_xmlparse { # $finaloutput.=&endredirection; # } - + if ($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); } @@ -630,7 +640,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; @@ -659,16 +669,22 @@ 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(\&Math::Cephes::asin,$safeeval,'&asin'); $safehole->wrap(\&Math::Cephes::acos,$safeeval,'&acos'); @@ -713,6 +729,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'); @@ -749,13 +795,46 @@ sub init_safespace { # $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::lonxml::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 { @@ -770,6 +849,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) { @@ -782,7 +883,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--; @@ -805,6 +906,8 @@ sub initdepth { $Apache::lonxml::olddepth=-1; } +my @timers; +my $lasttime; sub increasedepth { my ($token) = @_; $Apache::lonxml::depth++; @@ -812,8 +915,15 @@ sub increasedepth { if ($Apache::lonxml::depthcounter[$Apache::lonxml::depth]==1) { $Apache::lonxml::olddepth=$Apache::lonxml::depth; } + 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 $Apache::lonxml::depth : $Apache::lonxml::olddepth : $curdepth : $token->[1]\n"); + &Apache::lonxml::debug("s$spacing$Apache::lonxml::depth : $Apache::lonxml::olddepth : $curdepth : $token->[1] : $time : \n"); #print "
s $Apache::lonxml::depth : $Apache::lonxml::olddepth : $curdepth : $token->[1]\n"; } @@ -828,8 +938,15 @@ sub decreasedepth { &Apache::lonxml::warning(&mt("Missing tags, unable to properly run file.")); $Apache::lonxml::depth='-1'; } + 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 $Apache::lonxml::depth : $Apache::lonxml::olddepth : $token->[1] : $curdepth\n"); + &Apache::lonxml::debug("e$spacing$Apache::lonxml::depth : $Apache::lonxml::olddepth : $curdepth : $token->[1] : $time : ".&tv_interval($timer)."\n"); #print "
e $Apache::lonxml::depth : $Apache::lonxml::olddepth : $token->[1] : $curdepth\n"; } @@ -841,7 +958,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') { @@ -872,8 +993,11 @@ sub increment_counter { } 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; @@ -907,7 +1031,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') { @@ -959,7 +1087,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') { @@ -987,7 +1119,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 { @@ -1002,6 +1135,8 @@ sub parstring { 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\";"; } @@ -1009,11 +1144,19 @@ sub parstring { return $temp; } +sub extlink { + my ($res,$exact)=@_; + if (!$exact) { + $res=&Apache::lonnet::hreflocation($Apache::lonxml::pwd[-1],$res); + } + 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/\/[^\/]+$//; @@ -1046,24 +1189,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; @@ -1093,7 +1236,6 @@ sub createnewhtml { my $title=&mt('Title of document goes here'); my $body=&mt('Body of document goes here'); my $filecontents=(< $title @@ -1127,7 +1269,11 @@ sub inserteditinfo { my $initialize=''; if ($filetype eq 'html') { my $addbuttons=&Apache::lonhtmlcommon::htmlareaaddbuttons(); - $initialize=&Apache::lonhtmlcommon::htmlareaheaders().(< $addbuttons @@ -1140,14 +1286,20 @@ $addbuttons } FULLPAGE + } else { + $initialize.=(< +$addbuttons + function initDocument() { + } + +FULLPAGE + } $result=~s/\]*)\>/\/i; $xml_help=&Apache::loncommon::helpLatexCheatsheet(); } my $cleanbut = ''; - if ($filetype eq 'html') { - $cleanbut=''; - } + my $titledisplay=&display_title(); my %lt=&Apache::lonlocal::texthash('st' => 'Save this', 'vi' => 'View', @@ -1157,16 +1309,17 @@ $cleanbut BUTTONS + $buttons.=&Apache::lonhtmlcommon::spelllink('xmledit','filecont'); $buttons.=&Apache::lonhtmlcommon::htmlareaselectactive('filecont'); my $editfooter=(< -
+ $xml_help $buttons
- +
$buttons
@@ -1179,24 +1332,24 @@ ENDFOOTER } 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'; } @@ -1210,14 +1363,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); + 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; @@ -1233,9 +1386,9 @@ 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'})) { + 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). @@ -1259,39 +1412,47 @@ $bodytag ENDNOTFOUND - $filecontents=''; - if ($ENV{'request.state'} ne 'published') { + $filecontents=''; + 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') { - if ($ENV{'form.attemptclean'}) { - $filecontents=&htmlclean($filecontents,1); + 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']); + &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'}, + ['editmode']); } - if (!$ENV{'form.editmode'} || $ENV{'form.viewmode'}) { + 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{'rawmode'}) { $result = $filecontents; } } } # # 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'}))) { my $displayfile=$request->uri; $displayfile=~s/^\/[^\/]*//; - $result=''. + my $bodytag=''; + if ($env{'environment.remote'} eq 'off') { + $bodytag=&Apache::loncommon::bodytag(); + } + $result=''.$bodytag. &Apache::lonxml::message_location().'

'. $displayfile. '

'; @@ -1309,10 +1470,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 = ""; @@ -1324,47 +1485,84 @@ 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]); + #&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++; - my $request=$Apache::lonxml::request; - if (!$request) { $request=Apache->request; } - if (($Apache::lonxml::debug eq 1) || ($ENV{'request.state'} eq 'construct') ) { - # 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 { - push(@Apache::lonxml::error_messages, - "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('
',@_)); - } + $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."); + } + #notify author + &Apache::lonmsg::author_res_msg($env{'request.filename'},join('
',@_)); + #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]",join('
',@_)); + &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."); + } + } + push(@Apache::lonxml::error_messages,"$errormsg
"); } - } } sub warning { $warningcount++; - if ($ENV{'form.grade_target'} ne 'tex') { - if ($ENV{'request.state'} eq 'construct' || $Apache::lonxml::debug) { - my $request=$Apache::lonxml::request; - if (!$request) { $request=Apache->request; } + 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"); @@ -1374,8 +1572,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"); } } @@ -1439,7 +1637,7 @@ sub get_param_var { } elsif ( $args !~ /my \$\Q$param\E=\"/ ) { return undef; } my $value=&Apache::run::run("{$args;".'return $'.$param.'}',$safeeval); #' &Apache::lonxml::debug("first run is $value"); - if ($value =~ /^[\$\@\%]\w+$/) { + if ($value =~ /^[\$\@\%][a-zA-Z_]\w*$/) { &Apache::lonxml::debug("doing second"); my @result=&Apache::run::run("return $value",$safeeval,1); if (!defined($result[0])) { @@ -1526,30 +1724,37 @@ sub helpinfo { sub whichuser { my ($passedsymb)=@_; my ($symb,$courseid,$domain,$name,$publicuser); - if (defined($ENV{'form.grade_symb'})) { - my $tmp_courseid=$ENV{'form.grade_courseid'}; - my $allowed=&Apache::lonnet::allowed('vgr',$tmp_courseid); - if ($allowed) { - $symb=$ENV{'form.grade_symb'}; - $courseid=$ENV{'form.grade_courseid'}; - $domain=$ENV{'form.grade_domain'}; - $name=$ENV{'form.grade_username'}; - } - } else { - if (!$passedsymb) { - $symb=&Apache::lonnet::symbread(); - } else { - $symb=$passedsymb; + 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'}); } - $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'}; + 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); } 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.