# The LearningOnline Network with CAPA # XML Parser Module # # $Id: lonxml.pm,v 1.560 2018/09/12 21:10:57 raeburn 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. # =pod =head1 NAME Apache::lonxml =head1 SYNOPSIS XML Parsing Module This is part of the LearningOnline Network with CAPA project described at http://www.lon-capa.org. =head1 SUBROUTINES =cut package Apache::lonxml; use vars 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(); use Safe(); use Safe::Hole(); use Math::Cephes(); use Math::Random(); use Math::Calculus::Expression(); use Number::FormatEng(); 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::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::lonmaxima(); use Apache::lonr(); use Apache::lonlocal; use Apache::lonhtmlcommon(); use Apache::functionplotresponse(); use Apache::lonnavmaps(); #==================================== 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 edit mode, determines what tags can go into what other tags %insertlist=(); # stores the list of active tag namespaces @namespace=(); # stores all Scrit Vars displays for later showing my @script_var_displays=(); # 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; # Part counter hash. In analysis mode, the # problems can use this to record which parts increment the counter # by how much. The counter subs will maintain this hash via # their optional part parameters. Note that the assumption is that # analysis is done in one request and therefore it is not necessary to # save this information request-to-request. %Apache::lonxml::counters_per_part = (); #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. 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 || $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') ) && ($env{'form.inhibitmenu'} ne 'yes') ) { $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 ''; } return $discussion; } sub printalltags { foreach my $temp (sort(keys(%Apache::lonxml::alltags))) { &Apache::lonxml::debug("$temp -- ". join(',',@{ $Apache::lonxml::alltags{$temp} })); } } sub xmlparse { my ($request,$target,$content_file_string,$safeinit,%style_for_target) = @_; &setup_globals($request,$target); &Apache::inputtags::initialize_inputtags(); &Apache::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)); } } #&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 (@stack) { &warning(&mt('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() } &clean_safespace($safeeval); if (@script_var_displays) { if ($finaloutput =~ m{\s*\s*$}s) { my $scriptoutput = join('',@script_var_displays); $finaloutput=~s{(\s*)\s*$}{$scriptoutput$1}s; } else { $finaloutput .= join('',@script_var_displays); } undef(@script_var_displays); } &init_state(); if ($env{'form.return_only_error_and_warning_counts'}) { if ($env{'request.filename'}=~/\.(html|htm|xml)$/i) { my $error=&verify_html($content_file_string); if ($error) { $errorcount++; } } 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/\\/\$\\backslash\$/g; # \ -> $\backslash$ per LaTex line by line pg 10. $string =~ s/(\$|%|\{|\})/\\$1/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/\\\%|\%/\\\%/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; } sub inner_xmlparse { my ($target,$stack,$parstack,$pars,$safeeval,$style_for_target,$start)=@_; my $finaloutput = ''; my $result; my $token; my $dontpop=0; my $lastdontpop; my $lastendtag; my $startredirection = $Apache::lonxml::redirection; while ( $#$pars > -1 ) { while ($token = $$pars['-1']->get_token) { if (($token->[0] eq 'T') || ($token->[0] eq 'C') ) { if ($metamode<1) { my $text=$token->[1]; if ($token->[0] eq 'C' && $target eq 'tex') { $text = ''; # $text = '%'.$text."\n"; } $result.=$text; } } elsif (($token->[0] eq 'D')) { if ($metamode<1 && $target eq 'web') { my $text=$token->[1]; $result.=$text; } } elsif ($token->[0] eq 'PI') { if ($metamode<1 && $target eq 'web') { $result=$token->[2]; } } elsif ($token->[0] eq 'S') { # add tag to stack push (@$stack,$token->[1]); # add parameters list to another stack push (@$parstack,&parstring($token)); &increasedepth($token); if ($Apache::lonxml::usestyle && exists($$style_for_target{$token->[1]})) { $Apache::lonxml::usestyle=0; my $string=$$style_for_target{$token->[1]}. ''; &Apache::lonxml::newparser($pars,\$string); $Apache::lonxml::style_values=$$parstack[-1]; $Apache::lonxml::style_end_values=$$parstack[-1]; } else { $result = &callsub("start_$token->[1]", $target, $token, $stack, $parstack, $pars, $safeeval, $style_for_target); } } elsif ($token->[0] eq 'E') { if ($Apache::lonxml::usestyle && exists($$style_for_target{'/'."$token->[1]"})) { $Apache::lonxml::usestyle=0; my $string=$$style_for_target{'/'.$token->[1]}. ''; &Apache::lonxml::newparser($pars,\$string); $Apache::lonxml::style_values=$Apache::lonxml::style_end_values; $Apache::lonxml::style_end_values=''; $dontpop=1; } else { #clear out any tags that didn't end while ($token->[1] ne $$stack['-1'] && ($#$stack > -1)) { my $lasttag=$$stack[-1]; if ($token->[1] =~ /^\Q$lasttag\E$/i) { &Apache::lonxml::warning(&mt('Using tag [_1] on line [_2] as end tag to [_3]','</'.$token->[1].'>','.$token->[3].','<'.$$stack[-1].'>')); last; } else { &Apache::lonxml::warning(&mt('Found tag [_1] on line [_2] when looking for [_3] in file.','</'.$token->[1].'>',$token->[3],'</'.$$stack[-1].'>')); &end_tag($stack,$parstack,$token); } } $result = &callsub("end_$token->[1]", $target, $token, $stack, $parstack, $pars,$safeeval, $style_for_target); } } else { &Apache::lonxml::error("Unknown token event :$token->[0]:$token->[1]:"); } #evaluate variable refs in result if ($Apache::lonxml::post_evaluate &&$result ne "") { my $extras; if (!$Apache::lonxml::usestyle) { $extras=$Apache::lonxml::style_values; } if ( $#$parstack > -1 ) { $result=&Apache::run::evaluate($result,$safeeval,$extras.$$parstack[-1]); } else { $result= &Apache::run::evaluate($result,$safeeval,$extras); } } $Apache::lonxml::post_evaluate=1; if (($token->[0] eq 'T') || ($token->[0] eq 'C') || ($token->[0] eq 'D') ) { #Style file definitions should be correct if ($target eq 'tex' && ($Apache::lonxml::usestyle)) { $result=&latex_special_symbols($result); } } if ($Apache::lonxml::redirection) { $Apache::lonxml::outputstack['-1'] .= $result; } else { $finaloutput.=$result; } $result = ''; if ($token->[0] eq 'E') { if ($dontpop) { $lastdontpop = $token; } else { $lastendtag = $token->[1]; &end_tag($stack,$parstack,$token); } } $dontpop=0; } if ($#$pars > -1) { pop @$pars; pop @Apache::lonxml::pwd; } } if (($#$stack == 0) && ($stack->[0] eq 'physnet') && ($target eq 'web') && ($lastendtag eq 'LONCAPA_INTERNAL_TURN_STYLE_ON')) { if ((ref($lastdontpop) eq 'ARRAY') && ($lastdontpop->[1] eq 'physnet')) { &end_tag($stack,$parstack,$lastdontpop); } } # if ($target eq 'meta') { # $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); } if ($target eq 'modified') { # if modfied, handle startpart and endpart $finaloutput=~s/\]*\>(.*)\]*\>/$1<\/part>/gs; } return $finaloutput; } ## ## Looks to see if there is a subroutine defined for this tag. If so, call it, ## otherwise do not call it as we do not know what it is. ## sub callsub { my ($sub,$target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; my $currentstring=''; my $nodefault; { my $sub1; no strict 'refs'; my $tag=$token->[1]; # get utterly rid of extended html tags if ($tag=~/^x\-/i) { return ''; } my $space=$Apache::lonxml::alltags{$tag}[-1]; if (!$space) { $tag=~tr/A-Z/a-z/; $sub=~tr/A-Z/a-z/; $space=$Apache::lonxml::alltags{$tag}[-1] } my $deleted=0; if (($token->[0] eq 'S') && ($target eq 'modified')) { $deleted=&Apache::edit::handle_delete($space,$target,$token,$tagstack, $parstack,$parser,$safeeval, $style); } if (!$deleted) { if ($space) { #&Apache::lonxml::debug("Calling sub $sub in $space $metamode"); $sub1="$space\:\:$sub"; ($currentstring,$nodefault) = &$sub1($target,$token,$tagstack, $parstack,$parser,$safeeval, $style); } else { if ($target eq 'tex') { # throw away tag name return ''; } #&Apache::lonxml::debug("NOT Calling sub $sub in $space $metamode"); if ($metamode <1) { if (defined($token->[4]) && ($metamode < 1)) { $currentstring = $token->[4]; } else { $currentstring = $token->[2]; } } } # &Apache::lonxml::debug("nodefalt:$nodefault:"); if ($currentstring eq '' && $nodefault eq '') { if ($target eq 'edit') { #&Apache::lonxml::debug("doing default edit for $token->[1]"); if ($token->[0] eq 'S') { $currentstring = &Apache::edit::tag_start($target,$token); } elsif ($token->[0] eq 'E') { $currentstring = &Apache::edit::tag_end($target,$token); } } } 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.=&Apache::edit::handle_insert(); } elsif ($token->[0] eq 'E') { $currentstring.=&Apache::edit::handle_insertafter($token->[1]); } } } use strict 'refs'; } return $currentstring; } { my %state; sub init_state { undef(%state); } sub set_state { my ($key,$value) = @_; $state{$key} = $value; return $value; } sub get_state { my ($key) = @_; return $state{$key}; } } sub setup_globals { my ($request,$target)=@_; $Apache::lonxml::request=$request; $errorcount=0; $warningcount=0; $Apache::lonxml::internal_error=0; $Apache::lonxml::default_homework_loaded=0; $Apache::lonxml::usestyle=1; &init_counter(); &clear_bubble_lines_for_part(); &init_state(); &set_state('target',$target); @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; $Apache::lonxml::evaluate = 1; $Apache::lonxml::import = 0; } elsif ($target eq 'answer') { $Apache::lonxml::redirection = 0; $Apache::lonxml::metamode = 1; $Apache::lonxml::evaluate = 1; $Apache::lonxml::import = 1; } elsif ($target eq 'grade') { &startredirection(); #ended in inner_xmlparse on exit $Apache::lonxml::metamode = 0; $Apache::lonxml::evaluate = 1; $Apache::lonxml::import = 1; } elsif ($target eq 'modified') { $Apache::lonxml::redirection = 0; $Apache::lonxml::metamode = 0; $Apache::lonxml::evaluate = 0; $Apache::lonxml::import = 0; } elsif ($target eq 'edit') { $Apache::lonxml::redirection = 0; $Apache::lonxml::metamode = 0; $Apache::lonxml::evaluate = 0; $Apache::lonxml::import = 0; } elsif ($target eq 'analyze') { $Apache::lonxml::redirection = 0; $Apache::lonxml::metamode = 0; $Apache::lonxml::evaluate = 1; $Apache::lonxml::import = 1; } else { $Apache::lonxml::redirection = 0; $Apache::lonxml::metamode = 0; $Apache::lonxml::evaluate = 1; $Apache::lonxml::import = 1; } } sub init_safespace { my ($target,$safeeval,$safehole,$safeinit) = @_; $safeeval->reval('use LaTeX::Table;'); $safeeval->deny_only(':dangerous'); $safeeval->reval('use LONCAPA::LCMathComplex;'); $safeeval->permit_only(":default"); $safeeval->permit("entereval"); $safeeval->permit(":base_math"); $safeeval->permit("sort"); $safeeval->permit("time"); $safeeval->permit("caller"); $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::response::implicit_multiplication,$safeeval,'&implicit_multiplication'); $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::lonr::r_eval,$safeeval,'&r_eval'); $safehole->wrap(\&Apache::lonr::Rentry,$safeeval,'&Rentry'); $safehole->wrap(\&Apache::lonr::Rarray,$safeeval,'&Rarray'); $safehole->wrap(\&Apache::lonr::r_check,$safeeval,'&r_check'); $safehole->wrap(\&Apache::lonr::r_cas_formula_fix,$safeeval, '&r_cas_formula_fix'); $safehole->wrap(\&Apache::caparesponse::capa_formula_fix,$safeeval, '&capa_formula_fix'); $safehole->wrap(\&Apache::lonlocal::locallocaltime,$safeeval, '&locallocaltime'); $safehole->wrap(\&Math::Cephes::asin,$safeeval,'&asin'); $safehole->wrap(\&Math::Cephes::acos,$safeeval,'&acos'); $safehole->wrap(\&Math::Cephes::atan,$safeeval,'&atan'); $safehole->wrap(\&Math::Cephes::sinh,$safeeval,'&sinh'); $safehole->wrap(\&Math::Cephes::cosh,$safeeval,'&cosh'); $safehole->wrap(\&Math::Cephes::tanh,$safeeval,'&tanh'); $safehole->wrap(\&Math::Cephes::asinh,$safeeval,'&asinh'); $safehole->wrap(\&Math::Cephes::acosh,$safeeval,'&acosh'); $safehole->wrap(\&Math::Cephes::atanh,$safeeval,'&atanh'); $safehole->wrap(\&Math::Cephes::erf,$safeeval,'&erf'); $safehole->wrap(\&Math::Cephes::erfc,$safeeval,'&erfc'); $safehole->wrap(\&Math::Cephes::j0,$safeeval,'&j0'); $safehole->wrap(\&Math::Cephes::j1,$safeeval,'&j1'); $safehole->wrap(\&Math::Cephes::jn,$safeeval,'&jn'); $safehole->wrap(\&Math::Cephes::jv,$safeeval,'&jv'); $safehole->wrap(\&Math::Cephes::y0,$safeeval,'&y0'); $safehole->wrap(\&Math::Cephes::y1,$safeeval,'&y1'); $safehole->wrap(\&Math::Cephes::yn,$safeeval,'&yn'); $safehole->wrap(\&Math::Cephes::yv,$safeeval,'&yv'); $safehole->wrap(\&Math::Cephes::bdtr ,$safeeval,'&bdtr' ); $safehole->wrap(\&Math::Cephes::bdtrc ,$safeeval,'&bdtrc' ); $safehole->wrap(\&Math::Cephes::bdtri ,$safeeval,'&bdtri' ); $safehole->wrap(\&Math::Cephes::btdtr ,$safeeval,'&btdtr' ); $safehole->wrap(\&Math::Cephes::chdtr ,$safeeval,'&chdtr' ); $safehole->wrap(\&Math::Cephes::chdtrc,$safeeval,'&chdtrc'); $safehole->wrap(\&Math::Cephes::chdtri,$safeeval,'&chdtri'); $safehole->wrap(\&Math::Cephes::fdtr ,$safeeval,'&fdtr' ); $safehole->wrap(\&Math::Cephes::fdtrc ,$safeeval,'&fdtrc' ); $safehole->wrap(\&Math::Cephes::fdtri ,$safeeval,'&fdtri' ); $safehole->wrap(\&Math::Cephes::gdtr ,$safeeval,'&gdtr' ); $safehole->wrap(\&Math::Cephes::gdtrc ,$safeeval,'&gdtrc' ); $safehole->wrap(\&Math::Cephes::nbdtr ,$safeeval,'&nbdtr' ); $safehole->wrap(\&Math::Cephes::nbdtrc,$safeeval,'&nbdtrc'); $safehole->wrap(\&Math::Cephes::nbdtri,$safeeval,'&nbdtri'); $safehole->wrap(\&Math::Cephes::ndtr ,$safeeval,'&ndtr' ); $safehole->wrap(\&Math::Cephes::ndtri ,$safeeval,'&ndtri' ); $safehole->wrap(\&Math::Cephes::pdtr ,$safeeval,'&pdtr' ); $safehole->wrap(\&Math::Cephes::pdtrc ,$safeeval,'&pdtrc' ); $safehole->wrap(\&Math::Cephes::pdtri ,$safeeval,'&pdtri' ); $safehole->wrap(\&Math::Cephes::stdtr ,$safeeval,'&stdtr' ); $safehole->wrap(\&Math::Cephes::stdtri,$safeeval,'&stdtri'); $safehole->wrap(\&Math::Cephes::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'); # $safehole->wrap(\&Math::Cephes::rmul,$safeeval,'&rmul'); # $safehole->wrap(\&Math::Cephes::rdiv,$safeeval,'&rdiv'); # $safehole->wrap(\&Math::Cephes::euclid,$safeeval,'&euclid'); $safehole->wrap(\&Math::Random::random_beta,$safeeval,'&math_random_beta'); $safehole->wrap(\&Math::Random::random_chi_square,$safeeval,'&math_random_chi_square'); $safehole->wrap(\&Math::Random::random_exponential,$safeeval,'&math_random_exponential'); $safehole->wrap(\&Math::Random::random_f,$safeeval,'&math_random_f'); $safehole->wrap(\&Math::Random::random_gamma,$safeeval,'&math_random_gamma'); $safehole->wrap(\&Math::Random::random_multivariate_normal,$safeeval,'&math_random_multivariate_normal'); $safehole->wrap(\&Math::Random::random_multinomial,$safeeval,'&math_random_multinomial'); $safehole->wrap(\&Math::Random::random_noncentral_chi_square,$safeeval,'&math_random_noncentral_chi_square'); $safehole->wrap(\&Math::Random::random_noncentral_f,$safeeval,'&math_random_noncentral_f'); $safehole->wrap(\&Math::Random::random_normal,$safeeval,'&math_random_normal'); $safehole->wrap(\&Math::Random::random_permutation,$safeeval,'&math_random_permutation'); $safehole->wrap(\&Math::Random::random_permuted_index,$safeeval,'&math_random_permuted_index'); $safehole->wrap(\&Math::Random::random_uniform,$safeeval,'&math_random_uniform'); $safehole->wrap(\&Math::Random::random_poisson,$safeeval,'&math_random_poisson'); $safehole->wrap(\&Math::Random::random_uniform_integer,$safeeval,'&math_random_uniform_integer'); $safehole->wrap(\&Math::Random::random_negative_binomial,$safeeval,'&math_random_negative_binomial'); $safehole->wrap(\&Math::Random::random_binomial,$safeeval,'&math_random_binomial'); $safehole->wrap(\&Math::Random::random_seed_from_phrase,$safeeval,'&random_seed_from_phrase'); $safehole->wrap(\&Math::Random::random_set_seed_from_phrase,$safeeval,'&random_set_seed_from_phrase'); $safehole->wrap(\&Math::Random::random_get_seed,$safeeval,'&random_get_seed'); $safehole->wrap(\&Math::Random::random_set_seed,$safeeval,'&random_set_seed'); $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'); $safehole->wrap(\&Apache::functionplotresponse::fpr_val,$safeeval,'&fpr_val'); $safehole->wrap(\&Apache::functionplotresponse::fpr_f,$safeeval,'&fpr_f'); $safehole->wrap(\&Apache::functionplotresponse::fpr_dfdx,$safeeval,'&fpr_dfdx'); $safehole->wrap(\&Apache::functionplotresponse::fpr_d2fdx2,$safeeval,'&fpr_d2fdx2'); $safehole->wrap(\&Apache::functionplotresponse::fpr_vectorcoords,$safeeval,'&fpr_vectorcoords'); $safehole->wrap(\&Apache::functionplotresponse::fpr_objectcoords,$safeeval,'&fpr_objectcoords'); $safehole->wrap(\&Apache::functionplotresponse::fpr_vectorlength,$safeeval,'&fpr_vectorlength'); $safehole->wrap(\&Apache::functionplotresponse::fpr_vectorangle,$safeeval,'&fpr_vectorangle'); $safehole->wrap(\&Math::Calculus::Expression::math_calculus_expression,$safeeval,'&math_calculus_expression'); $safehole->wrap(\&Number::FormatEng::format_eng,$safeeval,'&number_format_eng'); $safehole->wrap(\&Number::FormatEng::format_pref,$safeeval,'&number_format_pref'); # 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.'";'; &Apache::run::run($safeinit,$safeeval); my $rawrndseed = &initialize_rndseed($safeeval); if ($target eq 'grade') { $Apache::lonhomework::rawrndseed = $rawrndseed; } } 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); return $rndseed; } sub default_homework_load { my ($safeeval)=@_; &Apache::lonxml::debug('Loading default_homework'); my $default=&Apache::lonnet::getfile($Apache::lonnet::perlvar{'lonIncludes'}. '/default_homework.lcpm'); if ($default eq -1) { &Apache::lonxml::error("Unable to find default_homework.lcpm"); } else { &Apache::run::run($default,$safeeval); $Apache::lonxml::default_homework_loaded=1; } } { my $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) { $metamode_was=$Apache::lonxml::metamode; } $Apache::lonxml::metamode=0; $Apache::lonxml::redirection++; push (@Apache::lonxml::outputstack, ''); } sub endredirection { if (!$Apache::lonxml::redirection) { &Apache::lonxml::error("Endredirection was called before a startredirection, perhaps you have unbalanced tags. Some debugging information:".join ":",caller); return ''; } $Apache::lonxml::redirection--; if (!$Apache::lonxml::redirection) { $Apache::lonxml::metamode=$metamode_was; } pop @Apache::lonxml::outputstack; } sub in_redirection { return ($Apache::lonxml::redirection > 0) } sub end_tag { my ($tagstack,$parstack,$token)=@_; pop(@$tagstack); pop(@$parstack); &decreasedepth($token); } sub initdepth { @Apache::lonxml::depthcounter=(); 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) = @_; 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::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) = @_; 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::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\s\-])/) { &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)= @_; my $token; my $result=''; $tag='<'.$tag.'>'; while ($token = $$pars[-1]->get_token) { if (($token->[0] eq 'T')||($token->[0] eq 'C')||($token->[0] eq 'D')) { 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') { $result.=$token->[4]; } elsif ($token->[0] eq 'E') { $result.=$token->[2]; } if ($result =~ /\Q$tag\E/is) { ($result,my $redo)=$result =~ /(.*)\Q$tag\E(.*)/is; #&Apache::lonxml::debug('Got a winner with leftovers ::'.$2); #&Apache::lonxml::debug('Result is :'.$1); $redo=$tag.$redo; &Apache::lonxml::newparser($pars,\$redo); last; } } return $result } ######################################################################### # # # bubble line counter management # # # ######################################################################### =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, $part_response); Increments the internal counter environment variable a specified amount Optional Arguments: $increment - amount to increment by (defaults to 1) Also 1 if the value is negative or zero. $part_response - A concatenation of the part and response id identifying exactly what is being 'answered'. =cut sub increment_counter { my ($increment, $part_response) = @_; if ($env{'form.grade_noincrement'}) { return; } if (!defined($increment) || $increment le 0) { $increment = 1; } $Apache::lonxml::counter += $increment; # If the caller supplied the response_id parameter, # Maintain its counter.. creating if necessary. if (defined($part_response)) { if (!defined($Apache::lonxml::counters_per_part{$part_response})) { $Apache::lonxml::counters_per_part{$part_response} = 0; } $Apache::lonxml::counters_per_part{$part_response} += $increment; my $new_value = $Apache::lonxml::counters_per_part{$part_response}; } $Apache::lonxml::counter_changed=1; } =pod =item &init_counter($increment); Initialize the internal counter environment variable =cut sub init_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; $Apache::lonxml::counter_changed=1; } } 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'}; } } =pod =item bubble_lines_for_part(part_response) Returns the number of lines required to get a response for $part_response (this is just $Apache::lonxml::counters_per_part{$part_response} =cut sub bubble_lines_for_part { my ($part_response) = @_; if (!defined($Apache::lonxml::counters_per_part{$part_response})) { return 0; } else { return $Apache::lonxml::counters_per_part{$part_response}; } } =pod =item clear_bubble_lines_for_part Clears the hash of bubble lines per part. If a caller needs to analyze several resources this should be called between resources to reset the hash for each problem being analyzed. =cut sub clear_bubble_lines_for_part { undef(%Apache::lonxml::counters_per_part); } =pod =item set_bubble_lines(part_response, value) If there is a problem part, that for whatever reason requires bubble lines that are not the same as the counter increment, it can call this sub during analysis to set its hash value explicitly. =cut sub set_bubble_lines { my ($part_response, $value) = @_; $Apache::lonxml::counters_per_part{$part_response} = $value; } =pod =item get_bubble_line_hash Returns the current bubble line hash. This is assumed to be small so we return a copy =cut sub get_bubble_line_hash { return %Apache::lonxml::counters_per_part; } #-------------------------------------------------- sub get_all_text { my($tag,$pars,$style)= @_; my $gotfullstack=1; if (ref($pars) ne 'ARRAY') { $gotfullstack=0; $pars=[$pars]; } if (ref($style) ne 'HASH') { $style={}; } my $depth=0; my $token; my $result=''; if ( $tag =~ m:^/: ) { my $tag=substr($tag,1); #&Apache::lonxml::debug("have:$tag:"); my $top_empty=0; while (($depth >=0) && ($#$pars > -1) && (!$top_empty)) { while (($depth >=0) && ($token = $$pars[-1]->get_token)) { #&Apache::lonxml::debug("e token:$token->[0]:$depth:$token->[1]:".$#$pars.":".$#Apache::lonxml::pwd); if (($token->[0] eq 'T')||($token->[0] eq 'C')||($token->[0] eq 'D')) { if ($token->[2]) { $result.='[1].']]>'; } else { $result.=$token->[1]; } } elsif ($token->[0] eq 'PI') { $result.=$token->[2]; } elsif ($token->[0] eq 'S') { if ($token->[1] =~ /^\Q$tag\E$/i) { $depth++; } if ($token->[1] =~ /^LONCAPA_INTERNAL_TURN_STYLE_ON$/) { $Apache::lonxml::usestyle=1; } if ($token->[1] =~ /^LONCAPA_INTERNAL_TURN_STYLE_OFF$/) { $Apache::lonxml::usestyle=0; } $result.=$token->[4]; } elsif ($token->[0] eq 'E') { if ( $token->[1] =~ /^\Q$tag\E$/i) { $depth--; } #skip sending back the last end tag if ($depth == 0 && exists($$style{'/'.$token->[1]}) && $Apache::lonxml::usestyle) { my $string= ''. $$style{'/'.$token->[1]}. $token->[2]. ''; &Apache::lonxml::newparser($pars,\$string); #&Apache::lonxml::debug("reParsing $string"); next; } if ($depth > -1) { $result.=$token->[2]; } else { $$pars[-1]->unget_token($token); } } } if (($depth >=0) && ($#$pars == 0) ) { $top_empty=1; } if (($depth >=0) && ($#$pars > 0) ) { pop(@$pars); pop(@Apache::lonxml::pwd); } } if ($top_empty && $depth >= 0) { #never found the end tag ran out of text, throw error send back blank &error('Never found end tag for <'.$tag. '> current string
'.
		   &HTML::Entities::encode($result,'<>&"').
		   '
'); if ($gotfullstack) { my $newstring=''.$result; &Apache::lonxml::newparser($pars,\$newstring); } $result=''; } } else { while ($#$pars > -1) { while ($token = $$pars[-1]->get_token) { #&Apache::lonxml::debug("s token:$token->[0]:$depth:$token->[1]"); if (($token->[0] eq 'T')||($token->[0] eq 'C')|| ($token->[0] eq 'D')) { if ($token->[2]) { $result.='[1].']]>'; } else { $result.=$token->[1]; } } elsif ($token->[0] eq 'PI') { $result.=$token->[2]; } elsif ($token->[0] eq 'S') { if ( $token->[1] =~ /^\Q$tag\E$/i) { $$pars[-1]->unget_token($token); last; } else { $result.=$token->[4]; } if ($token->[1] =~ /^LONCAPA_INTERNAL_TURN_STYLE_ON$/) { $Apache::lonxml::usestyle=1; } if ($token->[1] =~ /^LONCAPA_INTERNAL_TURN_STYLE_OFF$/) { $Apache::lonxml::usestyle=0; } } elsif ($token->[0] eq 'E') { $result.=$token->[2]; } } if (($#$pars > 0) ) { pop(@$pars); pop(@Apache::lonxml::pwd); } else { last; } } } #&Apache::lonxml::debug("Exit:$result:"); return $result } sub newparser { my ($parser,$contentref,$dir) = @_; push (@$parser,HTML::LCParser->new($contentref)); $$parser[-1]->xml_mode(1); $$parser[-1]->marked_sections(1); if ( $dir eq '' ) { push (@Apache::lonxml::pwd, $Apache::lonxml::pwd[$#Apache::lonxml::pwd]); } else { push (@Apache::lonxml::pwd, $dir); } } sub parstring { 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); } push(@Apache::lonxml::extlinks,$res); } sub writeallows { unless ($#extlinks>=0) { return; } 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,&unescape($_))}=$thisurl; } @extlinks=(); &Apache::lonnet::appenv(\%httpref); } sub register_ssi { my ($url,%form)=@_; push (@Apache::lonxml::ssi_info,{'url'=>$url,'form'=>\%form}); return ''; } sub do_registered_ssi { foreach my $info (@Apache::lonxml::ssi_info) { my %form=%{ $info->{'form'}}; my $url=$info->{'url'}; &Apache::lonnet::ssi($url,%form); } } sub add_script_result { my ($display) = @_; if ($display ne '') { push(@script_var_displays, $display); } } # # Afterburner handles anchors, highlights and links # sub afterburn { my $result=shift; &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'}, ['highlight','anchor','link']); if ($env{'form.highlight'}) { foreach (split(/\,/,$env{'form.highlight'})) { my $anchorname=$_; my $matchthis=$anchorname; $matchthis=~s/\_+/\\s\+/g; $result=~s/(\Q$matchthis\E)/\$1\<\/font\>/gs; } } if ($env{'form.link'}) { foreach (split(/\,/,$env{'form.link'})) { my ($anchorname,$linkurl)=split(/\>/,$_); my $matchthis=$anchorname; $matchthis=~s/\_+/\\s\+/g; $result=~s/(\Q$matchthis\E)/\$1\<\/a\>/gs; } } if ($env{'form.anchor'}) { my $anchorname=$env{'form.anchor'}; my $matchthis=$anchorname; $matchthis=~s/\_+/\\s\+/g; $result=~s/(\Q$matchthis\E)/\$1\<\/a\>/s; $result.=(<<"ENDSCRIPT"); ENDSCRIPT } return $result; } sub storefile { my ($file,$contents)=@_; &Apache::lonnet::correct_line_ends(\$contents); if (my $fh=Apache::File->new('>'.$file)) { print $fh $contents; $fh->close(); return 1; } else { &warning(&mt('Unable to save file [_1]',''.$file.'')); return 0; } } sub createnewhtml { my $title=&mt('Title of document goes here'); my $body=&mt('Body of document goes here'); my $filecontents=(< $title $body SIMPLECONTENT return $filecontents; } sub createnewsty { my $filecontents=(< SIMPLECONTENT return $filecontents; } sub createnewjs { my $filecontents=(< SIMPLECONTENT return $filecontents; } sub verify_html { my ($filecontents)=@_; my ($is_html,$is_xml,$is_physnet); if ($filecontents =~/(?:\<|\<\;)\?xml[^\<]*\?(?:\>|\>\;)/is) { $is_xml = 1; } elsif ($filecontents =~/(?:\<|\<\;)html(?:\s+[^\<]+|\s*)(?:\>|\>\;)/is) { $is_html = 1; } elsif ($filecontents =~/(?:\<|\<\;)physnet[^\<]*(?:\>|\>\;)/is) { $is_physnet = 1; } unless ($is_xml || $is_html || $is_physnet) { return &mt('File does not have [_1] or [_2] starting tag','<html>','<?xml ?>'); } if ($is_html) { if ($filecontents!~/(?:\<|\<\;)\/html(?:\>|\>\;)/is) { return &mt('File does not have [_1] ending tag','<html>'); } if ($filecontents!~/(?:\<|\<\;)(?:body|frameset)[^\<]*(?:\>|\>\;)/is) { return &mt('File does not have [_1] or [_2] starting tag','<body>','<frameset>'); } if ($filecontents!~/(?:\<|\<\;)\/(?:body|frameset)[^\<]*(?:\>|\>\;)/is) { return &mt('File does not have [_1] or [_2] ending tag','<body>','<frameset>'); } } return ''; } sub renderingoptions { my %langchoices=('' => ''); foreach (&Apache::loncommon::languageids()) { if (&Apache::loncommon::supportedlanguagecode($_)) { $langchoices{&Apache::loncommon::supportedlanguagecode($_)} = &Apache::loncommon::plainlanguagedescription($_); } } my $output; unless ($env{'form.forceedit'}) { $output .= ''. &mt('Language:').' '. &Apache::loncommon::select_form( $env{'form.languages'}, 'languages', {&Apache::lonlocal::texthash(%langchoices)}). ''; } $output .= ' '. &mt('Math Rendering:').' '. &Apache::loncommon::select_form( $env{'form.texengine'}, 'texengine', {&Apache::lonlocal::texthash ('' => '', 'tth' => 'tth (TeX to HTML)', 'MathJax' => 'MathJax', 'mimetex' => 'mimetex (Convert to Images)')}). ''; return $output; } sub inserteditinfo { my ($filecontents,$filetype,$filename,$symb,$itemtitle,$folderpath,$uri,$action) = @_; $filecontents = &HTML::Entities::encode($filecontents,'<>&"'); my $xml_help = ''; my $initialize=''; my $textarea_id = 'filecont'; my ($dragmath_button,$deps_button,$context,$cnum,$cdom,$add_to_onload, $add_to_onresize,$init_dragmath); $initialize=&Apache::lonhtmlcommon::spellheader(); if ($filetype eq 'html') { if ($env{'request.course.id'}) { $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'}; $cnum = $env{'course.'.$env{'request.course.id'}.'.num'}; if ($uri =~ m{^\Q/uploaded/$cdom/$cnum/portfolio/syllabus/\E}) { $context = 'syllabus'; } } if (&Apache::lonhtmlcommon::htmlareabrowser()) { my $lang = &Apache::lonhtmlcommon::htmlarea_lang(); my %textarea_args = ( fullpage => 'true', dragmath => 'math', ); $initialize .= &Apache::lonhtmlcommon::htmlareaselectactive(\%textarea_args); if ($context eq 'syllabus') { $init_dragmath = "editmath_visibility('filecont','none')"; } } } $initialize .= (< // FULLPAGE my $textareaclass; if ($filetype eq 'html') { if ($context eq 'syllabus') { $deps_button = &Apache::lonhtmlcommon::dependencies_button()."\n"; $initialize .= &Apache::lonhtmlcommon::dependencycheck_js(undef,&mt('Syllabus'), $uri,undef, "/public/$cdom/$cnum/syllabus"). "\n"; if (&Apache::lonhtmlcommon::htmlareabrowser()) { $textareaclass = 'class="LC_richDefaultOn"'; } } elsif ($symb || $folderpath) { $deps_button = &Apache::lonhtmlcommon::dependencies_button()."\n"; $initialize .= &Apache::lonhtmlcommon::dependencycheck_js($symb,$itemtitle, undef,$folderpath,$uri)."\n"; } $dragmath_button = ''.&Apache::lonhtmlcommon::dragmath_button('filecont',1).''; $initialize .= "\n".&Apache::lonhtmlcommon::dragmath_js('EditMathPopup'); } $add_to_onload = 'initDocument();'; $add_to_onresize = "resize_textarea('$textarea_id','LC_aftertextarea');"; if ($filetype eq 'html') { my $not_author; if ($uri =~ m{^/uploaded/}) { $not_author = 1; } $xml_help=&Apache::loncommon::helpLatexCheatsheet(undef,undef,$not_author); } my $titledisplay=&display_title(); my %lt=&Apache::lonlocal::texthash('st' => 'Save and Edit', 'vi' => 'Save and View', 'dv' => 'Discard Edits and View', 'un' => 'undo', 'ed' => 'Edit'); my $spelllink = &Apache::lonhtmlcommon::spelllink('xmledit','filecont'); my $textarea_events = &Apache::edit::element_change_detection(); my $form_events = &Apache::edit::form_change_detection(); my $htmlerror; if ($filetype eq 'html') { $htmlerror=&verify_html($filecontents); if ($htmlerror) { $htmlerror=''.$htmlerror.''; } if (&Apache::lonhtmlcommon::htmlareabrowser()) { unless ($textareaclass) { $textareaclass = 'class="LC_richDefaultOff"'; } } } my $undo; unless ($uri =~ m{^/uploaded/}) { $undo = ''."\n"; } my $editfooter=(<
$filename $xml_help
$undo $htmlerror $deps_button $dragmath_button

$spelllink

$titledisplay
ENDFOOTER 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'}) && ($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')); } # Embedded Flash movies from Camtasia served from https will not display in IE # if XML config file has expired from cache. if ($ENV{'SERVER_PORT'} == 443) { if ($request->uri =~ /\.xml$/) { my ($httpbrowser,$clientbrowser) = &Apache::loncommon::decode_user_agent($request); if ($clientbrowser =~ /^explorer$/i) { delete $request->headers_out->{'Cache-control'}; delete $request->headers_out->{'Pragma'}; my $expiration = time + 60; my $date=strftime("%a, %d %b %Y %H:%M:%S GMT",gmtime($expiration)); $request->headers_out->set("Expires" => $date); } } } $request->send_http_header; return OK if $request->header_only; my $file=&Apache::lonnet::filelocation("",$request->uri); my ($filetype,$breadcrumbtext); if ($file =~ /\.(sty|css|js|txt|tex)$/) { $filetype=$1; } else { $filetype='html'; } unless ($env{'request.uri'}) { $env{'request.uri'}=$request->uri; &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'}, ['todocs']); } my ($cdom,$cnum); if ($env{'request.course.id'}) { $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'}; $cnum = $env{'course.'.$env{'request.course.id'}.'.num'}; if ($filetype eq 'html') { if ($request->uri =~ m{^\Q/uploaded/$cdom/$cnum/portfolio/syllabus/\E.+$}) { if (&Apache::lonnet::allowed('mdc',$env{'request.course.id'})) { &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'}, ['editmode']); } } } } if ($filetype eq 'sty') { $breadcrumbtext = 'Style File Editor'; } elsif ($filetype eq 'js') { $breadcrumbtext = 'Javascript Editor'; } elsif ($filetype eq 'css') { $breadcrumbtext = 'CSS Editor'; } elsif ($filetype eq 'txt') { $breadcrumbtext = 'Text Editor'; } elsif ($filetype eq 'tex') { $breadcrumbtext = 'TeX Editor'; } else { $breadcrumbtext = 'HTML Editor'; } # # Edit action? Save file. # 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'}); if ($env{'form.savethisfile'}) { $env{'form.editmode'}='Edit'; #force edit mode } } } my $inhibit_menu; 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 $errormsg='

' .&mt('File not found: [_1]' ,''.$file.'') .'

'; $result=(< or need to clean # up if it did &Apache::structuretags::reset_problem_globals(); &Apache::lonhomework::finished_parsing(); } elsif ($filetype eq 'tex') { $result = &Apache::lontexconvert::converted(\$filecontents, $env{'form.texengine'}); if ($env{'form.return_only_error_and_warning_counts'}) { $result = "$errorcount:$warningcount"; } } else { $result = $filecontents; } &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'}, ['rawmode']); if ($env{'form.rawmode'}) { $result = $filecontents; } if (($env{'request.state'} eq 'construct') && (($filetype eq 'css') || ($filetype eq 'js')) && ($ENV{'HTTP_REFERER'})) { if ($ENV{'HTTP_REFERER'} =~ m{^https?\://[^\/]+/priv/$LONCAPA::match_domain/$LONCAPA::match_username/[^\?]+\.(x?html?|swf)(|\?)[^\?]*$}) { $inhibit_menu = 1; } } if (($filetype ne 'html') && (!$env{'form.return_only_error_and_warning_counts'}) && (!$inhibit_menu)) { my $nochgview = 1; my $controls = ''; if ($env{'request.state'} eq 'construct') { $controls = &Apache::loncommon::head_subbox( &Apache::loncommon::CSTR_pageheader() .&Apache::londefdef::edit_controls($nochgview)); } if ($filetype ne 'sty' && $filetype ne 'tex') { $result =~ s//>/g; $result = ''. '
'.$result.
                              '
'; } my $brcrum; if ($env{'request.state'} eq 'construct') { $brcrum = [{'href' => &Apache::loncommon::authorspace($request->uri), 'text' => 'Authoring Space'}, {'href' => '', 'text' => $breadcrumbtext}]; } else { $brcrum = ''; # FIXME: Where are we? } my %options = ('bread_crumbs' => $brcrum, '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') || ($inhibit_menu)) { if ($env{'form.editmode'} && (!($env{'form.viewmode'})) && (!($env{'form.discardview'}))) { my ($displayfile,$url,$symb,$itemtitle,$action); $displayfile=$request->uri; if ($request->uri =~ m{^/uploaded/}) { if ($env{'request.course.id'}) { if ($request->uri =~ m{^\Q/uploaded/$cdom/$cnum/supplemental/\E}) { &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'}, ['folderpath','title']); } elsif ($request->uri =~ m{^\Q/uploaded/$cdom/$cnum/portfolio/syllabus/\E(.+)$}) { my $filename = $1; if ($1 eq 'loncapa.html') { $displayfile = &mt('Syllabus (minimal template)'); $action = $request->uri.'?forceedit=1'; } else { $displayfile = &mt('Syllabus file: [_1]',$1); } $itemtitle = &mt('Syllabus'); } } unless ($itemtitle) { ($symb,$itemtitle,$displayfile) = &get_courseupload_hierarchy($request->uri, $env{'form.folderpath'}, $env{'form.title'}); } } else { $displayfile=~s/^\/[^\/]*//; } my ($edit_info, $add_to_onload, $add_to_onresize)= &inserteditinfo($filecontents,$filetype,$displayfile,$symb, $itemtitle,$env{'form.folderpath'},$request->uri,$action); my %options = ('add_entries' => {'onresize' => $add_to_onresize, 'onload' => $add_to_onload, }); my $header; if ($env{'request.state'} eq 'construct') { $options{'bread_crumbs'} = [{ 'href' => &Apache::loncommon::authorspace($request->uri), 'text' => 'Authoring Space'}, {'href' => '', 'text' => $breadcrumbtext}]; $header = &Apache::loncommon::head_subbox( &Apache::loncommon::CSTR_pageheader()); } 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 .$header .&Apache::lonxml::message_location() .$edit_info .&Apache::loncommon::end_page(); } } 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); } $result = ""; } return $result; } sub get_courseupload_hierarchy { my ($url,$folderpath,$title) = @_; my ($symb,$itemtitle,$displaypath); if ($env{'request.course.id'}) { if ($folderpath =~ /^supplemental/) { my @folders = split(/\&/,$folderpath); my @pathitems; while (@folders) { my $folder=shift(@folders); my $foldername=shift(@folders); $foldername =~ s/\:(\d*)\:(\w*)\:(\w*):(\d*)\:?(\d*)$//; push(@pathitems,&unescape($foldername)); } if ($title) { push(@pathitems,&unescape($title)); } $displaypath = join(' » ',@pathitems); } else { $symb = &Apache::lonnet::symbread($url); my ($map,$id,$res)=&Apache::lonnet::decode_symb($symb); my $navmap=Apache::lonnavmaps::navmap->new; if (ref($navmap)) { my $res = $navmap->getBySymb($symb); if (ref($res)) { my @pathitems = &Apache::loncommon::get_folder_hierarchy($navmap,$map,1); $itemtitle = $res->compTitle(); push(@pathitems,$itemtitle); $displaypath = join(' » ',@pathitems); } } } } return ($symb,$itemtitle,$displaypath); } sub debug { if ($Apache::lonxml::debug eq "1") { $|=1; my $request=$Apache::lonxml::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 $Apache::lonnet::perlvar{'lonDocRoot'}.'/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 { my @errors = @_; $errorcount++; $Apache::lonxml::internal_error=1; 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
             .'
' .''.&mt('ERROR:').' '.join("
\n",@errors) ."
\n"); $Apache::lonxml::warnings_error_header=''; } else { my $errormsg; my ($symb)=&Apache::lonnet::symbread(); if ( !$symb ) { #public or browsers $errormsg=&mt("An error occurred while processing this resource. The author has been notified."); } my $host=$Apache::lonnet::perlvar{'lonHostID'}; push(@errors, &mt("The error occurred on host [_1]", "$host")); my $msg = join('
', @errors); #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::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"); 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'}) { $errormsg=&mt("An error occurred while processing this resource. The course personnel ([_1]) and the author have been notified.",join(', ',@userlist)); } else { $errormsg=&mt("An error occurred 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 ( &show_error_warn_msg() ) { push(@Apache::lonxml::warning_messages, $Apache::lonxml::warnings_error_header .'
' .&mt('[_1]W[_2]ARNING','','').": ".join('
',@_) ."
\n" ); $Apache::lonxml::warnings_error_header=''; } } } 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, $noelide) = @_; if ( ! $context ) { $context = -1; } my $args =''; if ( $#$parstack > (-2-$context) ) { $args=$$parstack[$context]; } if ( ! $Apache::lonxml::usestyle ) { $args=$Apache::lonxml::style_values.$args; } if ($noelide) { # $args =~ s/\\'/'/g; $args =~ s/'\$/'\\\$/g; } if ( ! $args ) { return undef; } if ( $case_insensitive ) { 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[,\)]/ ) { return &Apache::run::run("{$args;".'return $'.$param.'}', $safeeval); #' } else { return undef; } } } sub get_param_var { my ($param,$parstack,$safeeval,$context,$case_insensitive) = @_; if ( ! $context ) { $context = -1; } my $args =''; if ( $#$parstack > (-2-$context) ) { $args=$$parstack[$context]; } 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)/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_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'}; if (defined($tag)) { $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); } } } # 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); } } } } 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 $tag = &get_tag($token); return $insertlist{$tag.'.description'}; } # Returns a list containing the help file, and the description sub helpinfo { my ($token)=@_; my $tag = &get_tag($token); return ($insertlist{$tag.'.helpfile'}, &mt($insertlist{$tag.'.helpdesc'})); } 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"}; } ############################################################ # PDF-FORM-METHODS =pod =item &print_pdf_radiobutton(fieldname, value) Returns a latexline to generate a PDF-Form-Radiobutton. Note: Radiobuttons with equal names are automaticly grouped in a selection-group. $fieldname: PDF internalname of the radiobutton(group) $value: Value of radiobutton =cut sub print_pdf_radiobutton { my ($fieldname, $value) = @_; return '\radioButton[\symbolchoice{circle}]{' .$fieldname.'}{10bp}{10bp}{'.$value.'}'; } =pod =item &print_pdf_start_combobox(fieldname) Starts a latexline to generate a PDF-Form-Combobox with text. $fieldname: PDF internal name of the Combobox =cut sub print_pdf_start_combobox { my $result; my ($fieldName) = @_; $result .= '\begin{tabularx}{\textwidth}{p{2.5cm}X}'."\n"; $result .= '\comboBox[]{'.$fieldName.'}{2.3cm}{14bp}{'; # return $result; } =pod =item &print_pdf_add_combobox_option(options) Generates a latexline to add Options to a PDF-Form-ComboBox. $option: PDF internal name of the Combobox-Option =cut sub print_pdf_add_combobox_option { my $result; my ($option) = @_; $result .= '('.$option.')'; return $result; } =pod =item &print_pdf_end_combobox(text) { Returns latexcode to end a PDF-Form-Combobox with text. =cut sub print_pdf_end_combobox { my $result; my ($text) = @_; $result .= '}&'.$text."\\\\\n"; $result .= '\end{tabularx}' . "\n"; $result .= '\hspace{2mm}' . "\n"; return $result; } =pod =item &print_pdf_hiddenField(fieldname, user, domain) Returns a latexline to generate a PDF-Form-hiddenField with userdata. $fieldname label for hiddentextfield $user: name of user $domain: domain of user =cut sub print_pdf_hiddenfield { my $result; my ($fieldname, $user, $domain) = @_; $result .= '\textField [\F{\FHidden}\F{-\FPrint}\V{'.$domain.'&'.$user.'}]{'.$fieldname.'}{0in}{0in}'."\n"; return $result; } 1; __END__