# The LearningOnline Network with CAPA # XML Parser Module # # $Id: lonxml.pm,v 1.161 2002/03/22 17:52:20 albertel Exp $ # # Copyright Michigan State University Board of Trustees # # This file is part of the LearningOnline Network with CAPA (LON-CAPA). # # LON-CAPA is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 of the License, or # (at your option) any later version. # # LON-CAPA is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with LON-CAPA; if not, write to the Free Software # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA # # /home/httpd/html/adm/gpl.txt # # http://www.lon-capa.org/ # # Copyright for TtHfunc and TtMfunc by Ian Hutchinson. # TtHfunc and TtMfunc (the "Code") may be compiled and linked into # binary executable programs or libraries distributed by the # Michigan State University (the "Licensee"), but any binaries so # distributed are hereby licensed only for use in the context # of a program or computational system for which the Licensee is the # primary author or distributor, and which performs substantial # additional tasks beyond the translation of (La)TeX into HTML. # The C source of the Code may not be distributed by the Licensee # to any other parties under any circumstances. # # last modified 06/26/00 by Alexander Sakharuk # 11/6 Gerd Kortemeyer # 6/1/1 Gerd Kortemeyer # 2/21,3/13 Guy # 3/29,5/4 Gerd Kortemeyer # 5/10 Scott Harrison # 5/26 Gerd Kortemeyer # 5/27 H. K. Ng # 6/2,6/3,6/8,6/9 Gerd Kortemeyer # 6/12,6/13 H. K. Ng # 6/16 Gerd Kortemeyer # 7/27 H. K. Ng # 8/7,8/9,8/10,8/11,8/15,8/16,8/17,8/18,8/20,8/23,8/24 Gerd Kortemeyer # Guy Albertelli # 9/26 Gerd Kortemeyer # Dec Guy Albertelli # YEAR=2002 # 1/1 Gerd Kortemeyer # 1/2 Matthew Hall # 1/3 Gerd Kortemeyer # package Apache::lonxml; use vars qw(@pwd @outputstack $redirection $import @extlinks $metamode $evaluate %insertlist @namespace); use strict; use HTML::TokeParser(); use HTML::TreeBuilder(); use HTML::Entities(); use Safe(); use Safe::Hole(); use Math::Cephes(); use Math::Random(); use Opcode(); sub register { my ($space,@taglist) = @_; foreach my $temptag (@taglist) { push(@{ $Apache::lonxml::alltags{$temptag} },$space); } } sub deregister { my ($space,@taglist) = @_; foreach my $temptag (@taglist) { my $tempspace = $Apache::lonxml::alltags{$temptag}[-1]; if ($tempspace eq $space) { pop(@{ $Apache::lonxml::alltags{$temptag} }); } } #&printalltags(); } use Apache::Constants qw(:common); use Apache::lontexconvert(); use Apache::style(); use Apache::run(); use Apache::londefdef(); use Apache::scripttag(); use Apache::edit(); use Apache::lonnet(); use Apache::File(); use Apache::loncommon(); #================================================== Main subroutine: xmlparse #debugging control, to turn on debugging modify the correct handler $Apache::lonxml::debug=0; #path to the directory containing the file currently being processed @pwd=(); #these two are used for capturing a subset of the output for later processing, #don't touch them directly use &startredirection and &endredirection @outputstack = (); $redirection = 0; #controls wheter the tag actually does $import = 1; @extlinks=(); # meta mode is a bit weird only some output is to be turned off # tag turns metamode off (defined in londefdef.pm) $metamode = 0; # turns on and of run::evaluate actually derefencing var refs $evaluate = 1; # data structure for eidt mode, determines what tags can go into what other tags %insertlist=(); # stores the list of active tag namespaces @namespace=(); # has the dynamic menu been updated to know about this resource $Apache::lonxml::registered=0; sub xmlbegin { my $output=''; if ($ENV{'browser.mathml'}) { $output='' .'' .']>' .''; } else { $output=''; } return $output; } sub xmlend { my $discussion=''; if ($ENV{'request.course.id'}) { my $crs='/'.$ENV{'request.course.id'}; if ($ENV{'request.course.sec'}) { $crs.='_'.$ENV{'request.course.sec'}; } $crs=~s/\_/\//g; my $seeid=&Apache::lonnet::allowed('rin',$crs); my $symb=&Apache::lonnet::symbread(); if ($symb) { my %contrib=&Apache::lonnet::restore($symb,$ENV{'request.course.id'}, $ENV{'course.'.$ENV{'request.course.id'}.'.domain'}, $ENV{'course.'.$ENV{'request.course.id'}.'.num'}); if ($contrib{'version'}) { $discussion.= '

Course Discussion of Resource

'; my $idx; for ($idx=1;$idx<=$contrib{'version'};$idx++) { my $hidden=($contrib{'hidden'}=~/\.$idx\./); unless (($hidden) && (!$seeid)) { my $message=$contrib{$idx.':message'}; $message=~s/\n/\
/g; if ($message) { if ($hidden) { $message=''.$message.''; } my $sender='Anonymous'; if ((!$contrib{$idx.':anonymous'}) || ($seeid)) { $sender=$contrib{$idx.':sendername'}.' at '. $contrib{$idx.':senderdomain'}; if ($contrib{$idx.':anonymous'}) { $sender.=' (anonymous)'; } if ($seeid) { if ($hidden) { $sender.=' Make Visible'; } else { $sender.=' Hide'; } } } $discussion.='

'.$sender.' ('. localtime($contrib{$idx.':timestamp'}). '):

'.$message. '

'; } } } $discussion.='
'; } } } return $discussion.''; } sub tokeninputfield { my $defhost=$Apache::lonnet::perlvar{'lonHostID'}; $defhost=~tr/a-z/A-Z/; return (< function updatetoken() { var comp=new Array; var barcode=unescape(document.tokeninput.barcode.value); comp=barcode.split('*'); if (typeof(comp[0])!="undefined") { document.tokeninput.codeone.value=comp[0]; } if (typeof(comp[1])!="undefined") { document.tokeninput.codetwo.value=comp[1]; } if (typeof(comp[2])!="undefined") { comp[2]=comp[2].toUpperCase(); document.tokeninput.codethree.value=comp[2]; } document.tokeninput.barcode.value=''; }
DocID Checkin
Scan in Barcode
or Type in DocID * *
ENDINPUTFIELD } sub maketoken { my ($symb,$tuname,$tudom,$tcrsid)=@_; unless ($symb) { $symb=&Apache::lonnet::symbread(); } unless ($tuname) { $tuname=$ENV{'user.name'}; $tudom=$ENV{'user.domain'}; $tcrsid=$ENV{'request.course.id'}; } return &Apache::lonnet::checkout($symb,$tuname,$tudom,$tcrsid); } sub printtokenheader { my ($target,$token,$tsymb,$tcrsid,$tudom,$tuname)=@_; unless ($token) { return ''; } my ($symb,$courseid,$domain,$name) = &Apache::lonxml::whichuser(); unless ($tsymb) { $tsymb=$symb; } unless ($tuname) { $tuname=$name; $tudom=$domain; $tcrsid=$courseid; } my %reply=&Apache::lonnet::get('environment', ['firstname','middlename','lastname','generation'], $tudom,$tuname); my $plainname=$reply{'firstname'}.' '. $reply{'middlename'}.' '. $reply{'lastname'}.' '. $reply{'generation'}; if ($target eq 'web') { my %idhash=&Apache::lonnet::idrget($tudom,($tuname)); return ''. 'Checked out for '.$plainname. '
User: '.$tuname.' at '.$tudom. '
ID: '.$idhash{$tuname}. '
CourseID: '.$tcrsid. '
Course: '.$ENV{'course.'.$tcrsid.'.description'}. '
DocID: '.$token. '
Time: '.localtime().'
'; } else { return $token; } } sub fontsettings() { my $headerstring=''; if (($ENV{'browser.os'} eq 'mac') && (!$ENV{'browser.mathml'})) { $headerstring.= ''; } return $headerstring; } sub registerurl { my $forcereg=shift; my $target = shift; my $result = ''; if (($ENV{'request.publicaccess'}) || ($ENV{'REQUEST_URI'} eq '/res/adm/pages/menu.html')) { return ''; } if ($Apache::lonxml::registered && !$forcereg) { return ''; } $Apache::lonxml::registered=1; my $nothing=''; if ($ENV{'browser.type'} eq 'explorer') { $nothing='javascript:void(0);'; } if (($ENV{'REQUEST_URI'}!~/^\/(res\/)*adm\//) || ($forcereg)) { my $hwkadd=''; if ($ENV{'REQUEST_URI'}=~/\.(problem|exam|quiz|assess|survey|form)$/) { if (&Apache::lonnet::allowed('vgr',$ENV{'request.course.id'})) { $hwkadd.=(< // BEGIN LON-CAPA Internal function LONCAPAreg() { menu=window.open("$nothing","LONCAPAmenu","",false); menu.clearTimeout(menu.menucltim); menu.currentURL=window.location.pathname; menu.currentStale=0; menu.clearbut(3,1); menu.switchbutton (6,3,'catalog.gif','catalog','info','catalog_info()'); menu.switchbutton (8,1,'eval.gif','evaluate','this','gopost("/adm/evaluate",currentURL)'); menu.switchbutton (8,2,'fdbk.gif','feedback','on this','gopost("/adm/feedback",currentURL)'); menu.switchbutton (8,3,'prt.gif','prepare','printout','gopost("/adm/printout",currentURL)'); menu.switchbutton (2,1,'back.gif','backward','','gopost("/adm/flip","back:"+currentURL)'); menu.switchbutton (2,3,'forw.gif','forward','','gopost("/adm/flip","forward:"+currentURL)'); menu.switchbutton (9,1,'sbkm.gif','set','bookmark','set_bookmark()'); menu.switchbutton (9,2,'vbkm.gif','view','bookmark','edit_bookmarks()'); menu.switchbutton (9,3,'anot.gif','anno-','tations','annotate()'); $hwkadd } function LONCAPAstale() { menu=window.open("$nothing","LONCAPAmenu","",false); menu.currentStale=1; menu.switchbutton (3,1,'reload.gif','return','location','go(currentURL)'); menu.clearbut(7,1); menu.clearbut(7,2); menu.clearbut(7,3); menu.menucltim=menu.setTimeout( 'clearbut(2,1);clearbut(2,3);clearbut(8,1);clearbut(8,2);clearbut(8,3);'+ 'clearbut(9,1);clearbut(9,2);clearbut(9,3);clearbut(6,3)', 2000); } // END LON-CAPA Internal ENDREGTHIS } else { $result = (< // BEGIN LON-CAPA Internal function LONCAPAreg() { menu=window.open("$nothing","LONCAPAmenu","",false); menu.currentStale=1; menu.clearbut(2,1); menu.clearbut(2,3); menu.clearbut(8,1); menu.clearbut(8,2); menu.clearbut(8,3); if (menu.currentURL) { menu.switchbutton (3,1,'reload.gif','return','location','go(currentURL)'); } else { menu.clearbut(3,1); } } function LONCAPAstale() { } // END LON-CAPA Internal ENDDONOTREGTHIS } if ($target eq 'edit') { # Javascript routines for construction space: # openbrowser and opensearcher will start the file browser # (lonindexer) and searcher (lonsearchcat) respectively. # Inputs are the name of the html form being used # and the name of the element the selected URL should # be placed in. $result .=<<"ENDBROWSERSCRIPT"; ENDBROWSERSCRIPT } return $result; } sub loadevents() { return 'LONCAPAreg();'; } sub unloadevents() { return 'LONCAPAstale();'; } sub printalltags { my $temp; foreach $temp (sort keys %Apache::lonxml::alltags) { &Apache::lonxml::debug("$temp -- ". join(',',@{ $Apache::lonxml::alltags{$temp} })); } } sub xmlparse { my ($target,$content_file_string,$safeinit,%style_for_target) = @_; &setup_globals($target); #&printalltags(); my @pars = (); my $pwd=$ENV{'request.filename'}; $pwd =~ s:/[^/]*$::; &newparser(\@pars,\$content_file_string,$pwd); my $safeeval = new Safe; my $safehole = new Safe::Hole; &init_safespace($target,$safeeval,$safehole,$safeinit); #-------------------- Redefinition of the target in the case of compound target ($target, my @tenta) = split('&&',$target); my @stack = (); my @parstack = (); &initdepth; my $finaloutput = &inner_xmlparse($target,\@stack,\@parstack,\@pars, $safeeval,\%style_for_target); if ($ENV{'request.uri'}) { &writeallows($ENV{'request.uri'}); } 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; } $tree = $tree->delete; return $output; } sub inner_xmlparse { my ($target,$stack,$parstack,$pars,$safeeval,$style_for_target)=@_; my $finaloutput = ''; my $result; my $token; while ( $#$pars > -1 ) { while ($token = $$pars['-1']->get_token) { if (($token->[0] eq 'T') || ($token->[0] eq 'C') || ($token->[0] eq 'D') ) { if ($metamode<1) { $result=$token->[1]; } } elsif ($token->[0] eq 'PI') { if ($metamode<1) { $result=$token->[2]; } } elsif ($token->[0] eq 'S') { # add tag to stack push (@$stack,$token->[1]); # add parameters list to another stack push (@$parstack,&parstring($token)); &increasedepth($token); if (exists $$style_for_target{$token->[1]}) { if ($Apache::lonxml::redirection) { $Apache::lonxml::outputstack['-1'] .= &recurse($$style_for_target{$token->[1]},$target,$safeeval, $style_for_target,@$parstack); } else { $finaloutput .= &recurse($$style_for_target{$token->[1]},$target, $safeeval,$style_for_target,@$parstack); } } else { $result = &callsub("start_$token->[1]", $target, $token, $stack, $parstack, $pars, $safeeval, $style_for_target); } } elsif ($token->[0] eq 'E') { #clear out any tags that didn't end while ($token->[1] ne $$stack['-1'] && ($#$stack > -1)) { my $lasttag=$$stack[-1]; if ($token->[1] =~ /^$lasttag$/i) { &Apache::lonxml::warning('Using tag </'.$token->[1].'> as end tag to <'.$$stack[-1].'>'); last; } else { &Apache::lonxml::warning('Found tag </'.$token->[1].'> when looking for </'.$$stack[-1].'> in file'); &end_tag($stack,$parstack,$token); } } if (exists($$style_for_target{'/'."$token->[1]"})) { if ($Apache::lonxml::redirection) { $Apache::lonxml::outputstack['-1'] .= &recurse($$style_for_target{'/'."$token->[1]"}, $target,$safeeval,$style_for_target,@$parstack); } else { $finaloutput .= &recurse($$style_for_target{'/'."$token->[1]"}, $target,$safeeval,$style_for_target, @$parstack); } } else { $result = &callsub("end_$token->[1]", $target, $token, $stack, $parstack, $pars,$safeeval, $style_for_target); } } else { &Apache::lonxml::error("Unknown token event :$token->[0]:$token->[1]:"); } #evaluate variable refs in result if ($result ne "") { if ( $#$parstack > -1 ) { if ($Apache::lonxml::redirection) { $Apache::lonxml::outputstack['-1'] .= &Apache::run::evaluate($result,$safeeval,$$parstack['-1']); } else { $finaloutput .= &Apache::run::evaluate($result,$safeeval, $$parstack['-1']); } } else { $finaloutput .= &Apache::run::evaluate($result,$safeeval,''); } $result = ''; } if ($token->[0] eq 'E') { &end_tag($stack,$parstack,$token); } } pop @$pars; pop @Apache::lonxml::pwd; } # if ($target eq 'meta') { # $finaloutput.=&endredirection; # } if (($ENV{'QUERY_STRING'}) && ($target eq 'web')) { $finaloutput=&afterburn($finaloutput); } return $finaloutput; } sub recurse { my @innerstack = (); my @innerparstack = (); my ($newarg,$target,$safeeval,$style_for_target,@parstack) = @_; my @pat = (); &newparser(\@pat,\$newarg); my $tokenpat; my $partstring = ''; my $output=''; my $decls=''; &Apache::lonxml::debug("Recursing"); while ( $#pat > -1 ) { while ($tokenpat = $pat[$#pat]->get_token) { if (($tokenpat->[0] eq 'T') || ($tokenpat->[0] eq 'C') || ($tokenpat->[0] eq 'D') ) { if ($metamode<1) { $partstring=$tokenpat->[1]; } } elsif ($tokenpat->[0] eq 'PI') { if ($metamode<1) { $partstring=$tokenpat->[2]; } } elsif ($tokenpat->[0] eq 'S') { push (@innerstack,$tokenpat->[1]); push (@innerparstack,&parstring($tokenpat)); &increasedepth($tokenpat); $partstring = &callsub("start_$tokenpat->[1]", $target, $tokenpat, \@innerstack, \@innerparstack, \@pat, $safeeval, $style_for_target); } elsif ($tokenpat->[0] eq 'E') { #clear out any tags that didn't end while ($tokenpat->[1] ne $innerstack[$#innerstack] && ($#innerstack > -1)) { my $lasttag=$innerstack[-1]; if ($tokenpat->[1] =~ /^$lasttag$/i) { &Apache::lonxml::warning('Using tag </'.$tokenpat->[1].'> as end tag to <'.$innerstack[-1].'>'); last; } else { &Apache::lonxml::warning('Found tag </'.$tokenpat->[1].'> when looking for </'.$innerstack[-1].'> in file'); &end_tag(\@innerstack,\@innerparstack,$tokenpat); } } $partstring = &callsub("end_$tokenpat->[1]", $target, $tokenpat, \@innerstack, \@innerparstack, \@pat, $safeeval, $style_for_target); } else { &Apache::lonxml::error("Unknown token event :$tokenpat->[0]:$tokenpat->[1]:"); } #pass both the variable to the style tag, and the tag we #are processing inside the if ( $partstring ne "" ) { if ( $#parstack > -1 ) { if ( $#innerparstack > -1 ) { $decls= $parstack[$#parstack].$innerparstack[$#innerparstack]; } else { $decls= $parstack[$#parstack]; } } else { if ( $#innerparstack > -1 ) { $decls=$innerparstack[$#innerparstack]; } else { $decls=''; } } $output .= &Apache::run::evaluate($partstring,$safeeval,$decls); $partstring = ''; } if ($tokenpat->[0] eq 'E') { pop @innerstack;pop @innerparstack; &decreasedepth($tokenpat);} } pop @pat; pop @Apache::lonxml::pwd; } &Apache::lonxml::debug("Exiting Recursing"); return $output; } sub callsub { my ($sub,$target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; my $currentstring=''; my $nodefault; { my $sub1; no strict 'refs'; my $tag=$token->[1]; my $space=$Apache::lonxml::alltags{$tag}[-1]; if (!$space) { $tag=~tr/A-Z/a-z/; $sub=~tr/A-Z/a-z/; $space=$Apache::lonxml::alltags{$tag}[-1] } my $deleted=0; $Apache::lonxml::curdepth=join('_',@Apache::lonxml::depthcounter); if (($token->[0] eq 'S') && ($target eq 'modified')) { $deleted=&Apache::edit::handle_delete($space,$target,$token,$tagstack, $parstack,$parser,$safeeval, $style); } if (!$deleted) { if ($space) { #&Apache::lonxml::debug("Calling sub $sub in $space $metamode"); $sub1="$space\:\:$sub"; ($currentstring,$nodefault) = &$sub1($target,$token,$tagstack, $parstack,$parser,$safeeval, $style); } else { #&Apache::lonxml::debug("NOT Calling sub $sub in $space $metamode"); if ($metamode <1) { if (defined($token->[4]) && ($metamode < 1)) { $currentstring = $token->[4]; } else { $currentstring = $token->[2]; } } } # &Apache::lonxml::debug("nodefalt:$nodefault:"); if ($currentstring eq '' && $nodefault eq '') { if ($target eq 'edit') { &Apache::lonxml::debug("doing default edit for $token->[1]"); if ($token->[0] eq 'S') { $currentstring = &Apache::edit::tag_start($target,$token); } elsif ($token->[0] eq 'E') { $currentstring = &Apache::edit::tag_end($target,$token); } } elsif ($target eq 'modified') { if ($token->[0] eq 'S') { $currentstring = $token->[4]; $currentstring.=&Apache::edit::handle_insert(); } else { $currentstring = $token->[2]; } } } } use strict 'refs'; } return $currentstring; } sub setup_globals { my ($target)=@_; $Apache::lonxml::registered = 0; @Apache::lonxml::pwd=(); @Apache::lonxml::extlinks=(); if ($target eq 'meta') { $Apache::lonxml::redirection = 0; $Apache::lonxml::metamode = 1; $Apache::lonxml::evaluate = 1; $Apache::lonxml::import = 0; } elsif ($target eq 'answer') { $Apache::lonxml::redirection = 0; $Apache::lonxml::metamode = 1; $Apache::lonxml::evaluate = 1; $Apache::lonxml::import = 1; } elsif ($target eq 'grade') { &startredirection; $Apache::lonxml::metamode = 0; $Apache::lonxml::evaluate = 1; $Apache::lonxml::import = 1; } elsif ($target eq 'modified') { $Apache::lonxml::redirection = 0; $Apache::lonxml::metamode = 0; $Apache::lonxml::evaluate = 0; $Apache::lonxml::import = 0; } elsif ($target eq 'edit') { $Apache::lonxml::redirection = 0; $Apache::lonxml::metamode = 0; $Apache::lonxml::evaluate = 0; $Apache::lonxml::import = 0; } 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->permit("entereval"); $safeeval->permit(":base_math"); $safeeval->permit("sort"); $safeeval->deny(":base_io"); $safehole->wrap(\&Apache::scripttag::xmlparse,$safeeval,'&xmlparse'); $safehole->wrap(\&Apache::lonnet::EXT,$safeeval,'&EXT'); $safehole->wrap(\&Math::Cephes::asin,$safeeval,'&asin'); $safehole->wrap(\&Math::Cephes::acos,$safeeval,'&acos'); $safehole->wrap(\&Math::Cephes::atan,$safeeval,'&atan'); $safehole->wrap(\&Math::Cephes::sinh,$safeeval,'&sinh'); $safehole->wrap(\&Math::Cephes::cosh,$safeeval,'&cosh'); $safehole->wrap(\&Math::Cephes::tanh,$safeeval,'&tanh'); $safehole->wrap(\&Math::Cephes::asinh,$safeeval,'&asinh'); $safehole->wrap(\&Math::Cephes::acosh,$safeeval,'&acosh'); $safehole->wrap(\&Math::Cephes::atanh,$safeeval,'&atanh'); $safehole->wrap(\&Math::Cephes::erf,$safeeval,'&erf'); $safehole->wrap(\&Math::Cephes::erfc,$safeeval,'&erfc'); $safehole->wrap(\&Math::Cephes::j0,$safeeval,'&j0'); $safehole->wrap(\&Math::Cephes::j1,$safeeval,'&j1'); $safehole->wrap(\&Math::Cephes::jn,$safeeval,'&jn'); $safehole->wrap(\&Math::Cephes::jv,$safeeval,'&jv'); $safehole->wrap(\&Math::Cephes::y0,$safeeval,'&y0'); $safehole->wrap(\&Math::Cephes::y1,$safeeval,'&y1'); $safehole->wrap(\&Math::Cephes::yn,$safeeval,'&yn'); $safehole->wrap(\&Math::Cephes::yv,$safeeval,'&yv'); $safehole->wrap(\&Math::Random::random_beta,$safeeval,'&math_random_beta'); $safehole->wrap(\&Math::Random::random_chi_square,$safeeval,'&math_random_chi_square'); $safehole->wrap(\&Math::Random::random_exponential,$safeeval,'&math_random_exponential'); $safehole->wrap(\&Math::Random::random_f,$safeeval,'&math_random_f'); $safehole->wrap(\&Math::Random::random_gamma,$safeeval,'&math_random_gamma'); $safehole->wrap(\&Math::Random::random_multivariate_normal,$safeeval,'&math_random_multivariate_normal'); $safehole->wrap(\&Math::Random::random_multinomial,$safeeval,'&math_random_multinomial'); $safehole->wrap(\&Math::Random::random_noncentral_chi_square,$safeeval,'&math_random_noncentral_chi_square'); $safehole->wrap(\&Math::Random::random_noncentral_f,$safeeval,'&math_random_noncentral_f'); $safehole->wrap(\&Math::Random::random_normal,$safeeval,'&math_random_normal'); $safehole->wrap(\&Math::Random::random_permutation,$safeeval,'&math_random_permutation'); $safehole->wrap(\&Math::Random::random_permuted_index,$safeeval,'&math_random_permuted_index'); $safehole->wrap(\&Math::Random::random_uniform,$safeeval,'&math_random_uniform'); $safehole->wrap(\&Math::Random::random_poisson,$safeeval,'&math_random_poisson'); $safehole->wrap(\&Math::Random::random_uniform_integer,$safeeval,'&math_random_uniform_integer'); $safehole->wrap(\&Math::Random::random_negative_binomial,$safeeval,'&math_random_negative_binomial'); $safehole->wrap(\&Math::Random::random_binomial,$safeeval,'&math_random_binomial'); $safehole->wrap(\&Math::Random::random_seed_from_phrase,$safeeval,'&random_seed_from_phrase'); $safehole->wrap(\&Math::Random::random_set_seed_from_phrase,$safeeval,'&random_set_seed_from_phrase'); $safehole->wrap(\&Math::Random::random_get_seed,$safeeval,'&random_get_seed'); $safehole->wrap(\&Math::Random::random_set_seed,$safeeval,'&random_set_seed'); #need to inspect this class of ops # $safeeval->deny(":base_orig"); $safeinit .= ';$external::target="'.$target.'";'; my $rndseed; my ($symb,$courseid,$domain,$name) = &Apache::lonxml::whichuser(); $rndseed=&Apache::lonnet::rndseed($symb,$courseid,$domain,$name); $safeinit .= ';$external::randomseed='.$rndseed.';'; &Apache::run::run($safeinit,$safeeval); } sub startredirection { $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 debuging information:".join ":",caller); return ''; } $Apache::lonxml::redirection--; pop @Apache::lonxml::outputstack; } sub end_tag { my ($tagstack,$parstack,$token)=@_; pop(@$tagstack); pop(@$parstack); &decreasedepth($token); } sub initdepth { @Apache::lonxml::depthcounter=(); $Apache::lonxml::depth=-1; $Apache::lonxml::olddepth=-1; } sub increasedepth { my ($token) = @_; $Apache::lonxml::depth++; $Apache::lonxml::depthcounter[$Apache::lonxml::depth]++; if ($Apache::lonxml::depthcounter[$Apache::lonxml::depth]==1) { $Apache::lonxml::olddepth=$Apache::lonxml::depth; } my $curdepth=join('_',@Apache::lonxml::depthcounter); &Apache::lonxml::debug("s $Apache::lonxml::depth : $Apache::lonxml::olddepth : $curdepth : $token->[1]\n"); #print "
s $Apache::lonxml::depth : $Apache::lonxml::olddepth : $curdepth : $token->[1]\n"; } sub decreasedepth { my ($token) = @_; $Apache::lonxml::depth--; if ($Apache::lonxml::depth<$Apache::lonxml::olddepth-1) { $#Apache::lonxml::depthcounter--; $Apache::lonxml::olddepth=$Apache::lonxml::depth+1; } if ( $Apache::lonxml::depth < -1) { &Apache::lonxml::warning("Missing tags, unable to properly run file."); $Apache::lonxml::depth='-1'; } my $curdepth=join('_',@Apache::lonxml::depthcounter); &Apache::lonxml::debug("e $Apache::lonxml::depth : $Apache::lonxml::olddepth : $token->[1] : $curdepth\n"); #print "
e $Apache::lonxml::depth : $Apache::lonxml::olddepth : $token->[1] : $curdepth\n"; } sub get_all_text { my($tag,$pars)= @_; my $depth=0; my $token; my $result=''; if ( $tag =~ m:^/: ) { my $tag=substr($tag,1); # &Apache::lonxml::debug("have:$tag:"); while (($depth >=0) && ($token = $pars->get_token)) { # &Apache::lonxml::debug("e token:$token->[0]:$depth:$token->[1]"); if (($token->[0] eq 'T')||($token->[0] eq 'C')||($token->[0] eq 'D')) { $result.=$token->[1]; } elsif ($token->[0] eq 'PI') { $result.=$token->[2]; } elsif ($token->[0] eq 'S') { if ($token->[1] =~ /^$tag$/i) { $depth++; } $result.=$token->[4]; } elsif ($token->[0] eq 'E') { if ( $token->[1] =~ /^$tag$/i) { $depth--; } #skip sending back the last end tag if ($depth > -1) { $result.=$token->[2]; } else { $pars->unget_token($token); } } } } else { while ($token = $pars->get_token) { # &Apache::lonxml::debug("s token:$token->[0]:$depth:$token->[1]"); if (($token->[0] eq 'T')||($token->[0] eq 'C')||($token->[0] eq 'D')) { $result.=$token->[1]; } elsif ($token->[0] eq 'PI') { $result.=$token->[2]; } elsif ($token->[0] eq 'S') { if ( $token->[1] =~ /^$tag$/i) { $pars->unget_token($token); last; } else { $result.=$token->[4]; } } elsif ($token->[0] eq 'E') { $result.=$token->[2]; } } } # &Apache::lonxml::debug("Exit:$result:"); return $result } sub newparser { my ($parser,$contentref,$dir) = @_; push (@$parser,HTML::TokeParser->new($contentref)); $$parser['-1']->xml_mode('1'); if ( $dir eq '' ) { push (@Apache::lonxml::pwd, $Apache::lonxml::pwd[$#Apache::lonxml::pwd]); } else { push (@Apache::lonxml::pwd, $dir); } # &Apache::lonxml::debug("pwd:$#Apache::lonxml::pwd"); # &Apache::lonxml::debug("pwd:$Apache::lonxml::pwd[$#Apache::lonxml::pwd]"); } sub parstring { my ($token) = @_; my $temp=''; foreach (@{$token->[3]}) { unless ($_=~/\W/) { my $val=$token->[2]->{$_}; $val =~ s/([\%\@\\\"])/\\$1/g; #if ($val =~ m/^[\%\@]/) { $val="\\".$val; } $temp .= "my \$$_=\"$val\";" } } return $temp; } sub writeallows { unless ($#extlinks>=0) { return; } my $thisurl='/res/'.&Apache::lonnet::declutter(shift); if ($ENV{'httpref.'.$thisurl}) { $thisurl=$ENV{'httpref.'.$thisurl}; } my $thisdir=$thisurl; $thisdir=~s/\/[^\/]+$//; my %httpref=(); foreach (@extlinks) { $httpref{'httpref.'. &Apache::lonnet::hreflocation($thisdir,$_)}=$thisurl; } @extlinks=(); &Apache::lonnet::appenv(%httpref); } # # Afterburner handles anchors, highlights and links # sub afterburn { my $result=shift; &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'}, ['highlight','anchor','link']); if ($ENV{'form.highlight'}) { foreach (split(/\,/,$ENV{'form.highlight'})) { my $anchorname=$_; my $matchthis=$anchorname; $matchthis=~s/\_+/\\s\+/g; $result=~s/($matchthis)/\$1\<\/font\>/gs; } } if ($ENV{'form.link'}) { foreach (split(/\,/,$ENV{'form.link'})) { my ($anchorname,$linkurl)=split(/\>/,$_); my $matchthis=$anchorname; $matchthis=~s/\_+/\\s\+/g; $result=~s/($matchthis)/\$1\<\/a\>/gs; } } if ($ENV{'form.anchor'}) { my $anchorname=$ENV{'form.anchor'}; my $matchthis=$anchorname; $matchthis=~s/\_+/\\s\+/g; $result=~s/($matchthis)/\$1\<\/a\>/s; $result.=(<<"ENDSCRIPT"); ENDSCRIPT } return $result; } sub storefile { my ($file,$contents)=@_; if (my $fh=Apache::File->new('>'.$file)) { print $fh $contents; $fh->close(); } else { &warning("Unable to save file $file"); } } sub createnewhtml { my $filecontents=(< Title of Document Goes Here Body of Document Goes Here SIMPLECONTENT return $filecontents; } sub inserteditinfo { my ($result,$filecontents)=@_; $filecontents = &HTML::Entities::encode($filecontents); # my $editheader='Edit below
'; my $buttons=(< BUTTONS my $editfooter=(<
$buttons $buttons
ENDFOOTER # $result=~s/(\]*\>)/$1$editheader/is; $result=~s/(\<\/body\>)/$editfooter/is; return $result; } sub get_target { my $viewgrades=&Apache::lonnet::allowed('vgr',$ENV{'request.course.id'}); if ( $ENV{'request.state'} eq 'published') { if ( defined($ENV{'form.grade_target'}) && ($viewgrades == 'F' )) { return ($ENV{'form.grade_target'}); } elsif (defined($ENV{'form.grade_target'})) { if (($ENV{'form.grade_target'} eq 'web') || ($ENV{'form.grade_target'} eq 'tex') ) { return $ENV{'form.grade_target'} } else { return 'web'; } } 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=0; if ($ENV{'browser.mathml'}) { $request->content_type('text/xml'); } else { $request->content_type('text/html'); } &Apache::loncommon::no_cache($request); $request->send_http_header; return OK if $request->header_only; my $file=&Apache::lonnet::filelocation("",$request->uri); # # Edit action? Save file. # unless ($ENV{'request.state'} eq 'published') { if (($ENV{'form.savethisfile'}) || ($ENV{'form.attemptclean'})) { &storefile($file,$ENV{'form.filecont'}); } } my %mystyle; my $result = ''; my $filecontents=&Apache::lonnet::getfile($file); if ($filecontents == -1) { $result=(< File not found File not found: $file ENDNOTFOUND $filecontents=''; if ($ENV{'request.state'} ne 'published') { $filecontents=&createnewhtml(); $ENV{'form.editmode'}='Edit'; #force edit mode } } else { unless ($ENV{'request.state'} eq 'published') { if ($ENV{'form.attemptclean'}) { $filecontents=&htmlclean($filecontents,1); } } if (!$ENV{'form.editmode'} || $ENV{'form.viewmode'}) { $result = &Apache::lonxml::xmlparse($target,$filecontents,'',%mystyle); } } # # Edit action? Insert editing commands # unless ($ENV{'request.state'} eq 'published') { if ($ENV{'form.editmode'} && (!($ENV{'form.viewmode'}))) { $result=''; $result=&inserteditinfo($result,$filecontents); } } writeallows($request->uri); $request->print($result); return OK; } sub debug { if ($Apache::lonxml::debug eq 1) { $|=1; print("DEBUG:".join('
',@_)."
\n"); } } sub error { if (($Apache::lonxml::debug eq 1) || ($ENV{'request.state'} eq 'construct') ) { print "ERROR:".join('
',@_)."
\n"; } else { print "An Error occured while processing this resource. The instructor has been notified.
"; #notify author &Apache::lonmsg::author_res_msg($ENV{'request.filename'},join('
',@_)); #notify course if ( $ENV{'request.course.id'} ) { my $users=$ENV{'course.'.$ENV{'request.course.id'}.'.comment.email'}; my $declutter=&Apache::lonnet::declutter($ENV{'request.filename'}); foreach my $user (split /\,/, $users) { ($user,my $domain) = split /:/, $user; &Apache::lonmsg::user_normal_msg($user,$domain, "Error [$declutter]",join('
',@_)); } } #FIXME probably shouldn't have me get everything forever. &Apache::lonmsg::user_normal_msg('albertel','msu',"Error in $ENV{'request.filename'}",join('
',@_)); #&Apache::lonmsg::user_normal_msg('albertel','103',"Error in $ENV{'request.filename'}",$_[0]); } } sub warning { if ($ENV{'request.state'} eq 'construct') { print "WARNING:".join('
',@_)."
\n"; } } sub get_param { my ($param,$parstack,$safeeval,$context) = @_; if ( ! $context ) { $context = -1; } my $args =''; if ( $#$parstack > (-2-$context) ) { $args=$$parstack[$context]; } if ( ! $args ) { return undef; } if ( $args =~ /my \$$param=\"/ ) { return &Apache::run::run("{$args;".'return $'.$param.'}',$safeeval); #' } else { return undef; } } sub get_param_var { my ($param,$parstack,$safeeval,$context) = @_; if ( ! $context ) { $context = -1; } my $args =''; if ( $#$parstack > (-2-$context) ) { $args=$$parstack[$context]; } if ( $args !~ /my \$$param=\"/ ) { return undef; } my $value=&Apache::run::run("{$args;".'return $'.$param.'}',$safeeval); #' if ($value =~ /^[\$\@\%]/) { return &Apache::run::run("return $value",$safeeval,1); } else { return $value; } } sub register_insert { my @data = split /\n/, &Apache::lonnet::getfile('/home/httpd/lonTabs/insertlist.tab'); my $i; my $tagnum=0; my @order; for ($i=0;$i < $#data; $i++) { my $line = $data[$i]; if ( $line =~ /^\#/ || $line =~ /^\s*\n/) { next; } if ( $line =~ /TABLE/ ) { last; } my ($tag,$descrip,$color,$function,$show) = split(/,/, $line); if ($tag) { $insertlist{"$tagnum.tag"} = $tag; $insertlist{"$tagnum.description"} = $descrip; $insertlist{"$tagnum.color"} = $color; $insertlist{"$tagnum.function"} = $function; if (!defined($show)) { $show='yes'; } $insertlist{"$tagnum.show"}= $show; $insertlist{"$tag.num"}=$tagnum; $tagnum++; } } $i++; #skipping TABLE line $tagnum = 0; for (;$i < $#data;$i++) { my $line = $data[$i]; my ($mnemonic,@which) = split(/ +/,$line); my $tag = $insertlist{"$tagnum.tag"}; for (my $j=0;$j <=$#which;$j++) { if ( $which[$j] eq 'Y' ) { if ($insertlist{"$j.show"} ne 'no') { push(@{ $insertlist{"$tag.which"} },$j); } } } $tagnum++; } } sub description { my ($token)=@_; my $tagnum; my $tag=$token->[1]; foreach my $namespace (reverse @Apache::lonxml::namespace) { my $testtag=$namespace.'::'.$tag; $tagnum=$insertlist{"$testtag.num"}; if (defined($tagnum)) { last; } } if (!defined ($tagnum)) { $tagnum=$Apache::lonxml::insertlist{"$tag.num"}; } return $insertlist{$tagnum.'.description'}; } # ----------------------------------------------------------------- whichuser # returns a list of $symb, $courseid, $domain, $name that is correct for # calls to lonnet functions for this setup. # - looks for form.grade_ parameters sub whichuser { my ($symb,$courseid,$domain,$name); if (defined($ENV{'form.grade_symb'})) { my $tmp_courseid=$ENV{'form.grade_courseid'}; my $allowed=&Apache::lonnet::allowed('mgr',$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 { $symb=&Apache::lonnet::symbread(); $courseid=$ENV{'request.course.id'}; $domain=$ENV{'user.domain'}; $name=$ENV{'user.name'}; } return ($symb,$courseid,$domain,$name); } 1; __END__ 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.