loncom/xml/lonxml.pm - view

File: [LON-CAPA] / loncom / xml / lonxml.pm
Revision 1.319: download - view: text, annotated - select for diffs
Thu May 27 04:25:13 2004 UTC (20 years ago) by albertel
Branches: MAIN
CVS tags: HEAD

- fixes for randnumber generation
   - due to a error in coding the 64bit and 64bit2 rnd seeds were throwing away the second half of the seed, we now preserve this functionality and make it explicit
   - additionally 64bit3 now uses all 64bits of the seed
   - also added new function pushrandomnumber poprandomnumber to be called instead of setrandomnumber before we were crunching the Safe space random number generator state, as this function is used bu thing the <optionresponse> and <radoibuttonresponse> this meant changes in the internal randomization code could screw up later Safe space random calls the old method is preserved for blank 64bit and 64bit2 randomiztion env.

1: # The LearningOnline Network with CAPA 2: # XML Parser Module 3: # 4: # $Id: lonxml.pm,v 1.319 2004/05/27 04:25:13 albertel Exp $ 5: # 6: # Copyright Michigan State University Board of Trustees 7: # 8: # This file is part of the LearningOnline Network with CAPA (LON-CAPA). 9: # 10: # LON-CAPA is free software; you can redistribute it and/or modify 11: # it under the terms of the GNU General Public License as published by 12: # the Free Software Foundation; either version 2 of the License, or 13: # (at your option) any later version. 14: # 15: # LON-CAPA is distributed in the hope that it will be useful, 16: # but WITHOUT ANY WARRANTY; without even the implied warranty of 17: # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 18: # GNU General Public License for more details. 19: # 20: # You should have received a copy of the GNU General Public License 21: # along with LON-CAPA; if not, write to the Free Software 22: # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA 23: # 24: # /home/httpd/html/adm/gpl.txt 25: # 26: # http://www.lon-capa.org/ 27: # 28: # Copyright for TtHfunc and TtMfunc by Ian Hutchinson. 29: # TtHfunc and TtMfunc (the "Code") may be compiled and linked into 30: # binary executable programs or libraries distributed by the 31: # Michigan State University (the "Licensee"), but any binaries so 32: # distributed are hereby licensed only for use in the context 33: # of a program or computational system for which the Licensee is the 34: # primary author or distributor, and which performs substantial 35: # additional tasks beyond the translation of (La)TeX into HTML. 36: # The C source of the Code may not be distributed by the Licensee 37: # to any other parties under any circumstances. 38: # 39: 40: 41: package Apache::lonxml; 42: use vars 43: qw(@pwd @outputstack $redirection $import @extlinks $metamode $evaluate %insertlist @namespace $errorcount $warningcount); 44: use strict; 45: use HTML::LCParser(); 46: use HTML::TreeBuilder(); 47: use HTML::Entities(); 48: use Safe(); 49: use Safe::Hole(); 50: use Math::Cephes(); 51: use Math::Random(); 52: use Opcode(); 53: use POSIX qw(strftime); 54: 55: 56: sub register { 57: my ($space,@taglist) = @_; 58: foreach my $temptag (@taglist) { 59: push(@{ $Apache::lonxml::alltags{$temptag} },$space); 60: } 61: } 62: 63: sub deregister { 64: my ($space,@taglist) = @_; 65: foreach my $temptag (@taglist) { 66: my $tempspace = $Apache::lonxml::alltags{$temptag}[-1]; 67: if ($tempspace eq $space) { 68: pop(@{ $Apache::lonxml::alltags{$temptag} }); 69: } 70: } 71: #&printalltags(); 72: } 73: 74: use Apache::Constants qw(:common); 75: use Apache::lontexconvert(); 76: use Apache::style(); 77: use Apache::run(); 78: use Apache::londefdef(); 79: use Apache::scripttag(); 80: use Apache::languagetags(); 81: use Apache::edit(); 82: use Apache::inputtags(); 83: use Apache::outputtags(); 84: use Apache::lonnet(); 85: use Apache::File(); 86: use Apache::loncommon(); 87: use Apache::lonfeedback(); 88: use Apache::lonmsg(); 89: use Apache::loncacc(); 90: use Apache::lonlocal; 91: 92: #================================================== Main subroutine: xmlparse 93: #debugging control, to turn on debugging modify the correct handler 94: $Apache::lonxml::debug=0; 95: 96: # keeps count of the number of warnings and errors generated in a parse 97: $warningcount=0; 98: $errorcount=0; 99: 100: #path to the directory containing the file currently being processed 101: @pwd=(); 102: 103: #these two are used for capturing a subset of the output for later processing, 104: #don't touch them directly use &startredirection and &endredirection 105: @outputstack = (); 106: $redirection = 0; 107: 108: #controls wheter the <import> tag actually does 109: $import = 1; 110: @extlinks=(); 111: 112: # meta mode is a bit weird only some output is to be turned off 113: #<output> tag turns metamode off (defined in londefdef.pm) 114: $metamode = 0; 115: 116: # turns on and of run::evaluate actually derefencing var refs 117: $evaluate = 1; 118: 119: # data structure for eidt mode, determines what tags can go into what other tags 120: %insertlist=(); 121: 122: # stores the list of active tag namespaces 123: @namespace=(); 124: 125: # has the dynamic menu been updated to know about this resource 126: $Apache::lonxml::registered=0; 127: 128: # a pointer the the Apache request object 129: $Apache::lonxml::request=''; 130: 131: # a problem number counter, and check on ether it is used 132: $Apache::lonxml::counter=1; 133: $Apache::lonxml::counter_changed=0; 134: 135: #internal check on whether to look at style defs 136: $Apache::lonxml::usestyle=1; 137: 138: #locations used to store the parameter string for style substitutions 139: $Apache::lonxml::style_values=''; 140: $Apache::lonxml::style_end_values=''; 141: 142: #array of ssi calls that need to occur after we are done parsing 143: @Apache::lonxml::ssi_info=(); 144: 145: #should we do the postag variable interpolation 146: $Apache::lonxml::post_evaluate=1; 147: 148: #a header message to emit in the case of any generated warning or errors 149: $Apache::lonxml::warnings_error_header=''; 150: 151: sub xmlbegin { 152: my $output=''; 153: if ($ENV{'browser.mathml'}) { 154: $output='<?xml version="1.0"?>' 155: .'<?xml-stylesheet type="text/css" href="/adm/MathML/mathml.css"?>' 156: .'<!DOCTYPE html SYSTEM "/adm/MathML/mathml.dtd" ' 157: .'[<!ENTITY mathns "http://www.w3.org/1998/Math/MathML">]>' 158: .'<html xmlns:math="http://www.w3.org/1998/Math/MathML" ' 159: .'xmlns="http://www.w3.org/TR/REC-html40">'; 160: } else { 161: $output='<html>'; 162: } 163: return $output; 164: } 165: 166: sub xmlend { 167: my $mode='xml'; 168: my $status='OPEN'; 169: if ($Apache::lonhomework::parsing_a_problem) { 170: $mode='problem'; 171: $status=$Apache::inputtags::status[-1]; 172: } 173: return &Apache::lonfeedback::list_discussion($mode,$status).'</html>'; 174: } 175: 176: sub tokeninputfield { 177: my $defhost=$Apache::lonnet::perlvar{'lonHostID'}; 178: $defhost=~tr/a-z/A-Z/; 179: return (<<ENDINPUTFIELD) 180: <script type="text/javascript"> 181: function updatetoken() { 182: var comp=new Array; 183: var barcode=unescape(document.tokeninput.barcode.value); 184: comp=barcode.split('*'); 185: if (typeof(comp[0])!="undefined") { 186: document.tokeninput.codeone.value=comp[0]; 187: } 188: if (typeof(comp[1])!="undefined") { 189: document.tokeninput.codetwo.value=comp[1]; 190: } 191: if (typeof(comp[2])!="undefined") { 192: comp[2]=comp[2].toUpperCase(); 193: document.tokeninput.codethree.value=comp[2]; 194: } 195: document.tokeninput.barcode.value=''; 196: } 197: </script> 198: <form method="post" name="tokeninput"> 199: <table border="2" bgcolor="#FFFFBB"> 200: <tr><th>DocID Checkin</th></tr> 201: <tr><td> 202: <table> 203: <tr> 204: <td>Scan in Barcode</td> 205: <td><input type="text" size="22" name="barcode" 206: onChange="updatetoken()"/></td> 207: </tr> 208: <tr><td><i>or</i> Type in DocID</td> 209: <td> 210: <input type="text" size="5" name="codeone" /> 211: <b><font size="+2">*</font></b> 212: <input type="text" size="5" name="codetwo" /> 213: <b><font size="+2">*</font></b> 214: <input type="text" size="10" name="codethree" value="$defhost" 215: onChange="this.value=this.value.toUpperCase()" /> 216: </td></tr> 217: </table> 218: </td></tr> 219: <tr><td><input type="submit" value="Check in DocID" /></td></tr> 220: </table> 221: </form> 222: ENDINPUTFIELD 223: } 224: 225: sub maketoken { 226: my ($symb,$tuname,$tudom,$tcrsid)=@_; 227: unless ($symb) { 228: $symb=&Apache::lonnet::symbread(); 229: } 230: unless ($tuname) { 231: $tuname=$ENV{'user.name'}; 232: $tudom=$ENV{'user.domain'}; 233: $tcrsid=$ENV{'request.course.id'}; 234: } 235: 236: return &Apache::lonnet::checkout($symb,$tuname,$tudom,$tcrsid); 237: } 238: 239: sub printtokenheader { 240: my ($target,$token,$tsymb,$tcrsid,$tudom,$tuname)=@_; 241: unless ($token) { return ''; } 242: 243: my ($symb,$courseid,$domain,$name) = &Apache::lonxml::whichuser(); 244: unless ($tsymb) { 245: $tsymb=$symb; 246: } 247: unless ($tuname) { 248: $tuname=$name; 249: $tudom=$domain; 250: $tcrsid=$courseid; 251: } 252: 253: my %reply=&Apache::lonnet::get('environment', 254: ['firstname','middlename','lastname','generation'], 255: $tudom,$tuname); 256: my $plainname=$reply{'firstname'}.' '. 257: $reply{'middlename'}.' '. 258: $reply{'lastname'}.' '. 259: $reply{'generation'}; 260: 261: if ($target eq 'web') { 262: my %idhash=&Apache::lonnet::idrget($tudom,($tuname)); 263: return 264: '<img align="right" src="/cgi-bin/barcode.png?encode='.$token.'" />'. 265: &mt('Checked out for').' '.$plainname. 266: '<br />'.&mt('User').': '.$tuname.' at '.$tudom. 267: '<br />'.&mt('ID').': '.$idhash{$tuname}. 268: '<br />'.&mt('CourseID').': '.$tcrsid. 269: '<br />'.&mt('Course').': '.$ENV{'course.'.$tcrsid.'.description'}. 270: '<br />'.&mt('DocID').': '.$token. 271: '<br />'.&mt('Time').': '.&Apache::lonlocal::locallocaltime().'<hr />'; 272: } else { 273: return $token; 274: } 275: } 276: 277: sub fontsettings() { 278: my $headerstring=''; 279: if (($ENV{'browser.os'} eq 'mac') && (!$ENV{'browser.mathml'})) { 280: $headerstring.= 281: '<meta Content-Type="text/html; charset=x-mac-roman">'; 282: } elsif (!$ENV{'browser.mathml'} && $ENV{'browser.unicode'}) { 283: $headerstring.= 284: '<meta http-equiv="Content-Type" content="text/html; charset=utf-8" />'; 285: } 286: return $headerstring; 287: } 288: 289: sub printalltags { 290: my $temp; 291: foreach $temp (sort keys %Apache::lonxml::alltags) { 292: &Apache::lonxml::debug("$temp -- ". 293: join(',',@{ $Apache::lonxml::alltags{$temp} })); 294: } 295: } 296: 297: sub xmlparse { 298: my ($request,$target,$content_file_string,$safeinit,%style_for_target) = @_; 299: 300: &setup_globals($request,$target); 301: &Apache::inputtags::initialize_inputtags(); 302: &Apache::outputtags::initialize_outputtags(); 303: &Apache::edit::initialize_edit(); 304: &Apache::londefdef::initialize_londefdef(); 305: 306: # 307: # do we have a course style file? 308: # 309: 310: if ($ENV{'request.course.id'} && $ENV{'request.state'} ne 'construct') { 311: my $bodytext= 312: $ENV{'course.'.$ENV{'request.course.id'}.'.default_xml_style'}; 313: if ($bodytext) { 314: my $location=&Apache::lonnet::filelocation('',$bodytext); 315: my $styletext=&Apache::lonnet::getfile($location); 316: if ($styletext ne '-1') { 317: %style_for_target = (%style_for_target, 318: &Apache::style::styleparser($target,$styletext)); 319: } 320: } 321: } elsif ($ENV{'construct.style'} && ($ENV{'request.state'} eq 'construct')) { 322: my $location=&Apache::lonnet::filelocation('',$ENV{'construct.style'}); 323: my $styletext=&Apache::lonnet::getfile($location); 324: if ($styletext ne '-1') { 325: %style_for_target = (%style_for_target, 326: &Apache::style::styleparser($target,$styletext)); 327: } 328: } 329: #&printalltags(); 330: my @pars = (); 331: my $pwd=$ENV{'request.filename'}; 332: $pwd =~ s:/[^/]*$::; 333: &newparser(\@pars,\$content_file_string,$pwd); 334: 335: my $safeeval = new Safe; 336: my $safehole = new Safe::Hole; 337: &init_safespace($target,$safeeval,$safehole,$safeinit); 338: #-------------------- Redefinition of the target in the case of compound target 339: 340: ($target, my @tenta) = split('&&',$target); 341: 342: my @stack = (); 343: my @parstack = (); 344: &initdepth; 345: 346: my $finaloutput = &inner_xmlparse($target,\@stack,\@parstack,\@pars, 347: $safeeval,\%style_for_target); 348: 349: if ($ENV{'request.uri'}) { 350: &writeallows($ENV{'request.uri'}); 351: } 352: &do_registered_ssi(); 353: if ($Apache::lonxml::counter_changed) { &store_counter() } 354: return $finaloutput; 355: } 356: 357: sub htmlclean { 358: my ($raw,$full)=@_; 359: 360: my $tree = HTML::TreeBuilder->new; 361: $tree->ignore_unknown(0); 362: 363: $tree->parse($raw); 364: 365: my $output= $tree->as_HTML(undef,' '); 366: 367: $output=~s/\<(br|hr|img|meta|allow)(.*?)\>/\<$1$2 \/\>/gis; 368: $output=~s/\<\/(br|hr|img|meta|allow)\>//gis; 369: unless ($full) { 370: $output=~s/\<[\/]*(body|head|html)\>//gis; 371: } 372: 373: $tree = $tree->delete; 374: 375: return $output; 376: } 377: 378: sub latex_special_symbols { 379: my ($string,$where)=@_; 380: if ($where eq 'header') { 381: $string =~ s/(\\|_|\^)/ /g; 382: $string =~ s/(\$|%|\{|\})/\\$1/g; 383: $string =~ s/_/ /g; 384: $string=&Apache::lonprintout::character_chart($string); 385: # any & or # leftover should be safe to just escape 386: $string=~s/([^\\])\&/$1\\\&/g; 387: $string=~s/([^\\])\#/$1\\\#/g; 388: } else { 389: $string=~s/\\/\\ensuremath{\\backslash}/g; 390: $string=~s/([^\\]|^)\%/$1\\\%/g; 391: $string=~s/([^\\]|^)(\$|_)/$1\\$2/g; 392: $string=~s/\$\$/\$\\\$/g; 393: $string=~s/\#\#/\#\\\#/g; 394: $string=~s/([^\\]|^)(\~|\^)/$1\\$2\\strut /g; 395: $string=~s/(>|<)/\\ensuremath\{$1\}/g; #more or less 396: $string=&Apache::lonprintout::character_chart($string); 397: # any & or # leftover should be safe to just escape 398: $string=~s/([^\\]|^)\&/$1\\\&/g; 399: $string=~s/([^\\]|^)\#/$1\\\#/g; 400: #single { or } How to escape? 401: } 402: return $string; 403: } 404: 405: sub inner_xmlparse { 406: my ($target,$stack,$parstack,$pars,$safeeval,$style_for_target)=@_; 407: my $finaloutput = ''; 408: my $result; 409: my $token; 410: my $dontpop=0; 411: while ( $#$pars > -1 ) { 412: while ($token = $$pars['-1']->get_token) { 413: if (($token->[0] eq 'T') || ($token->[0] eq 'C') ) { 414: if ($metamode<1) { 415: my $text=$token->[1]; 416: if ($token->[0] eq 'C' && $target eq 'tex') { 417: $text = ''; 418: # $text = '%'.$text."\n"; 419: } 420: $result.=$text; 421: } 422: } elsif (($token->[0] eq 'D')) { 423: if ($metamode<1 && $target eq 'web') { 424: my $text=$token->[1]; 425: $result.=$text; 426: } 427: } elsif ($token->[0] eq 'PI') { 428: if ($metamode<1 && $target eq 'web') { 429: $result=$token->[2]; 430: } 431: } elsif ($token->[0] eq 'S') { 432: # add tag to stack 433: push (@$stack,$token->[1]); 434: # add parameters list to another stack 435: push (@$parstack,&parstring($token)); 436: &increasedepth($token); 437: if ($Apache::lonxml::usestyle && 438: exists($$style_for_target{$token->[1]})) { 439: $Apache::lonxml::usestyle=0; 440: my $string=$$style_for_target{$token->[1]}. 441: '<LONCAPA_INTERNAL_TURN_STYLE_ON />'; 442: &Apache::lonxml::newparser($pars,\$string); 443: $Apache::lonxml::style_values=$$parstack[-1]; 444: $Apache::lonxml::style_end_values=$$parstack[-1]; 445: } else { 446: $result = &callsub("start_$token->[1]", $target, $token, $stack, 447: $parstack, $pars, $safeeval, $style_for_target); 448: } 449: } elsif ($token->[0] eq 'E') { 450: if ($Apache::lonxml::usestyle && 451: exists($$style_for_target{'/'."$token->[1]"})) { 452: $Apache::lonxml::usestyle=0; 453: my $string=$$style_for_target{'/'.$token->[1]}. 454: '<LONCAPA_INTERNAL_TURN_STYLE_ON end="'.$token->[1].'" />'; 455: &Apache::lonxml::newparser($pars,\$string); 456: $Apache::lonxml::style_values=$Apache::lonxml::style_end_values; 457: $Apache::lonxml::style_end_values=''; 458: $dontpop=1; 459: } else { 460: #clear out any tags that didn't end 461: while ($token->[1] ne $$stack['-1'] && ($#$stack > -1)) { 462: my $lasttag=$$stack[-1]; 463: if ($token->[1] =~ /^\Q$lasttag\E$/i) { 464: &Apache::lonxml::warning('Using tag </'.$token->[1].'> on line '.$token->[3].' as end tag to <'.$$stack[-1].'>'); 465: last; 466: } else { 467: &Apache::lonxml::warning('Found tag </'.$token->[1].'> on line '.$token->[3].' when looking for </'.$$stack[-1].'> in file'); 468: &end_tag($stack,$parstack,$token); 469: } 470: } 471: $result = &callsub("end_$token->[1]", $target, $token, $stack, 472: $parstack, $pars,$safeeval, $style_for_target); 473: } 474: } else { 475: &Apache::lonxml::error("Unknown token event :$token->[0]:$token->[1]:"); 476: } 477: #evaluate variable refs in result 478: if ($Apache::lonxml::post_evaluate &&$result ne "") { 479: my $extras; 480: if (!$Apache::lonxml::usestyle) { 481: $extras=$Apache::lonxml::style_values; 482: } 483: if ( $#$parstack > -1 ) { 484: $result=&Apache::run::evaluate($result,$safeeval,$extras.$$parstack[-1]); 485: } else { 486: $result= &Apache::run::evaluate($result,$safeeval,$extras); 487: } 488: } 489: $Apache::lonxml::post_evaluate=1; 490: 491: if (($token->[0] eq 'T') || ($token->[0] eq 'C') || ($token->[0] eq 'D') ) { 492: #Style file definitions should be correct 493: if ($target eq 'tex' && ($Apache::lonxml::usestyle)) { 494: $result=&latex_special_symbols($result); 495: } 496: } 497: 498: if ($Apache::lonxml::redirection) { 499: $Apache::lonxml::outputstack['-1'] .= $result; 500: } else { 501: $finaloutput.=$result; 502: } 503: $result = ''; 504: 505: if ($token->[0] eq 'E' && !$dontpop) { 506: &end_tag($stack,$parstack,$token); 507: } 508: $dontpop=0; 509: } 510: if ($#$pars > -1) { 511: pop @$pars; 512: pop @Apache::lonxml::pwd; 513: } 514: } 515: 516: # if ($target eq 'meta') { 517: # $finaloutput.=&endredirection; 518: # } 519: 520: 521: if (($ENV{'QUERY_STRING'}) && ($target eq 'web')) { 522: $finaloutput=&afterburn($finaloutput); 523: } 524: return $finaloutput; 525: } 526: 527: ## 528: ## Looks to see if there is a subroutine defined for this tag. If so, call it, 529: ## otherwise do not call it as we do not know what it is. 530: ## 531: sub callsub { 532: my ($sub,$target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; 533: my $currentstring=''; 534: my $nodefault; 535: { 536: my $sub1; 537: no strict 'refs'; 538: my $tag=$token->[1]; 539: # get utterly rid of extended html tags 540: if ($tag=~/^x\-/i) { return ''; } 541: my $space=$Apache::lonxml::alltags{$tag}[-1]; 542: if (!$space) { 543: $tag=~tr/A-Z/a-z/; 544: $sub=~tr/A-Z/a-z/; 545: $space=$Apache::lonxml::alltags{$tag}[-1] 546: } 547: 548: my $deleted=0; 549: $Apache::lonxml::curdepth=join('_',@Apache::lonxml::depthcounter); 550: if (($token->[0] eq 'S') && ($target eq 'modified')) { 551: $deleted=&Apache::edit::handle_delete($space,$target,$token,$tagstack, 552: $parstack,$parser,$safeeval, 553: $style); 554: } 555: if (!$deleted) { 556: if ($space) { 557: #&Apache::lonxml::debug("Calling sub $sub in $space $metamode"); 558: $sub1="$space\:\:$sub"; 559: ($currentstring,$nodefault) = &$sub1($target,$token,$tagstack, 560: $parstack,$parser,$safeeval, 561: $style); 562: } else { 563: if ($target eq 'tex') { 564: # throw away tag name 565: return ''; 566: } 567: #&Apache::lonxml::debug("NOT Calling sub $sub in $space $metamode"); 568: if ($metamode <1) { 569: if (defined($token->[4]) && ($metamode < 1)) { 570: $currentstring = $token->[4]; 571: } else { 572: $currentstring = $token->[2]; 573: } 574: } 575: } 576: # &Apache::lonxml::debug("nodefalt:$nodefault:"); 577: if ($currentstring eq '' && $nodefault eq '') { 578: if ($target eq 'edit') { 579: #&Apache::lonxml::debug("doing default edit for $token->[1]"); 580: if ($token->[0] eq 'S') { 581: $currentstring = &Apache::edit::tag_start($target,$token); 582: } elsif ($token->[0] eq 'E') { 583: $currentstring = &Apache::edit::tag_end($target,$token); 584: } 585: } elsif ($target eq 'modified') { 586: if ($token->[0] eq 'S') { 587: $currentstring = $token->[4]; 588: $currentstring.=&Apache::edit::handle_insert(); 589: } elsif ($token->[0] eq 'E') { 590: $currentstring = $token->[2]; 591: $currentstring.=&Apache::edit::handle_insertafter($token->[1]); 592: } else { 593: $currentstring = $token->[2]; 594: } 595: } 596: } 597: } 598: use strict 'refs'; 599: } 600: return $currentstring; 601: } 602: 603: sub setup_globals { 604: my ($request,$target)=@_; 605: $Apache::lonxml::request=$request; 606: $Apache::lonxml::registered = 0; 607: $errorcount=0; 608: $warningcount=0; 609: $Apache::lonxml::default_homework_loaded=0; 610: $Apache::lonxml::usestyle=1; 611: &init_counter(); 612: @Apache::lonxml::pwd=(); 613: @Apache::lonxml::extlinks=(); 614: @Apache::lonxml::ssi_info=(); 615: $Apache::lonxml::post_evaluate=1; 616: $Apache::lonxml::warnings_error_header=''; 617: if ($target eq 'meta') { 618: $Apache::lonxml::redirection = 0; 619: $Apache::lonxml::metamode = 1; 620: $Apache::lonxml::evaluate = 1; 621: $Apache::lonxml::import = 0; 622: } elsif ($target eq 'answer') { 623: $Apache::lonxml::redirection = 0; 624: $Apache::lonxml::metamode = 1; 625: $Apache::lonxml::evaluate = 1; 626: $Apache::lonxml::import = 1; 627: } elsif ($target eq 'grade') { 628: &startredirection; 629: $Apache::lonxml::metamode = 0; 630: $Apache::lonxml::evaluate = 1; 631: $Apache::lonxml::import = 1; 632: } elsif ($target eq 'modified') { 633: $Apache::lonxml::redirection = 0; 634: $Apache::lonxml::metamode = 0; 635: $Apache::lonxml::evaluate = 0; 636: $Apache::lonxml::import = 0; 637: } elsif ($target eq 'edit') { 638: $Apache::lonxml::redirection = 0; 639: $Apache::lonxml::metamode = 0; 640: $Apache::lonxml::evaluate = 0; 641: $Apache::lonxml::import = 0; 642: } elsif ($target eq 'analyze') { 643: $Apache::lonxml::redirection = 0; 644: $Apache::lonxml::metamode = 0; 645: $Apache::lonxml::evaluate = 1; 646: $Apache::lonxml::import = 1; 647: } else { 648: $Apache::lonxml::redirection = 0; 649: $Apache::lonxml::metamode = 0; 650: $Apache::lonxml::evaluate = 1; 651: $Apache::lonxml::import = 1; 652: } 653: } 654: 655: sub init_safespace { 656: my ($target,$safeeval,$safehole,$safeinit) = @_; 657: $safeeval->permit("entereval"); 658: $safeeval->permit(":base_math"); 659: $safeeval->permit("sort"); 660: $safeeval->permit("time"); 661: $safeeval->deny(":base_io"); 662: $safehole->wrap(\&Apache::scripttag::xmlparse,$safeeval,'&xmlparse'); 663: $safehole->wrap(\&Apache::outputtags::multipart,$safeeval,'&multipart'); 664: $safehole->wrap(\&Apache::lonnet::EXT,$safeeval,'&EXT'); 665: 666: $safehole->wrap(\&Math::Cephes::asin,$safeeval,'&asin'); 667: $safehole->wrap(\&Math::Cephes::acos,$safeeval,'&acos'); 668: $safehole->wrap(\&Math::Cephes::atan,$safeeval,'&atan'); 669: $safehole->wrap(\&Math::Cephes::sinh,$safeeval,'&sinh'); 670: $safehole->wrap(\&Math::Cephes::cosh,$safeeval,'&cosh'); 671: $safehole->wrap(\&Math::Cephes::tanh,$safeeval,'&tanh'); 672: $safehole->wrap(\&Math::Cephes::asinh,$safeeval,'&asinh'); 673: $safehole->wrap(\&Math::Cephes::acosh,$safeeval,'&acosh'); 674: $safehole->wrap(\&Math::Cephes::atanh,$safeeval,'&atanh'); 675: $safehole->wrap(\&Math::Cephes::erf,$safeeval,'&erf'); 676: $safehole->wrap(\&Math::Cephes::erfc,$safeeval,'&erfc'); 677: $safehole->wrap(\&Math::Cephes::j0,$safeeval,'&j0'); 678: $safehole->wrap(\&Math::Cephes::j1,$safeeval,'&j1'); 679: $safehole->wrap(\&Math::Cephes::jn,$safeeval,'&jn'); 680: $safehole->wrap(\&Math::Cephes::jv,$safeeval,'&jv'); 681: $safehole->wrap(\&Math::Cephes::y0,$safeeval,'&y0'); 682: $safehole->wrap(\&Math::Cephes::y1,$safeeval,'&y1'); 683: $safehole->wrap(\&Math::Cephes::yn,$safeeval,'&yn'); 684: $safehole->wrap(\&Math::Cephes::yv,$safeeval,'&yv'); 685: 686: $safehole->wrap(\&Math::Cephes::bdtr ,$safeeval,'&bdtr' ); 687: $safehole->wrap(\&Math::Cephes::bdtrc ,$safeeval,'&bdtrc' ); 688: $safehole->wrap(\&Math::Cephes::bdtri ,$safeeval,'&bdtri' ); 689: $safehole->wrap(\&Math::Cephes::btdtr ,$safeeval,'&btdtr' ); 690: $safehole->wrap(\&Math::Cephes::chdtr ,$safeeval,'&chdtr' ); 691: $safehole->wrap(\&Math::Cephes::chdtrc,$safeeval,'&chdtrc'); 692: $safehole->wrap(\&Math::Cephes::chdtri,$safeeval,'&chdtri'); 693: $safehole->wrap(\&Math::Cephes::fdtr ,$safeeval,'&fdtr' ); 694: $safehole->wrap(\&Math::Cephes::fdtrc ,$safeeval,'&fdtrc' ); 695: $safehole->wrap(\&Math::Cephes::fdtri ,$safeeval,'&fdtri' ); 696: $safehole->wrap(\&Math::Cephes::gdtr ,$safeeval,'&gdtr' ); 697: $safehole->wrap(\&Math::Cephes::gdtrc ,$safeeval,'&gdtrc' ); 698: $safehole->wrap(\&Math::Cephes::nbdtr ,$safeeval,'&nbdtr' ); 699: $safehole->wrap(\&Math::Cephes::nbdtrc,$safeeval,'&nbdtrc'); 700: $safehole->wrap(\&Math::Cephes::nbdtri,$safeeval,'&nbdtri'); 701: $safehole->wrap(\&Math::Cephes::ndtr ,$safeeval,'&ndtr' ); 702: $safehole->wrap(\&Math::Cephes::ndtri ,$safeeval,'&ndtri' ); 703: $safehole->wrap(\&Math::Cephes::pdtr ,$safeeval,'&pdtr' ); 704: $safehole->wrap(\&Math::Cephes::pdtrc ,$safeeval,'&pdtrc' ); 705: $safehole->wrap(\&Math::Cephes::pdtri ,$safeeval,'&pdtri' ); 706: $safehole->wrap(\&Math::Cephes::stdtr ,$safeeval,'&stdtr' ); 707: $safehole->wrap(\&Math::Cephes::stdtri,$safeeval,'&stdtri'); 708: 709: # $safehole->wrap(\&Math::Cephes::new_fract,$safeeval,'&new_fract'); 710: # $safehole->wrap(\&Math::Cephes::radd,$safeeval,'&radd'); 711: # $safehole->wrap(\&Math::Cephes::rsub,$safeeval,'&rsub'); 712: # $safehole->wrap(\&Math::Cephes::rmul,$safeeval,'&rmul'); 713: # $safehole->wrap(\&Math::Cephes::rdiv,$safeeval,'&rdiv'); 714: # $safehole->wrap(\&Math::Cephes::euclid,$safeeval,'&euclid'); 715: 716: $safehole->wrap(\&Math::Random::random_beta,$safeeval,'&math_random_beta'); 717: $safehole->wrap(\&Math::Random::random_chi_square,$safeeval,'&math_random_chi_square'); 718: $safehole->wrap(\&Math::Random::random_exponential,$safeeval,'&math_random_exponential'); 719: $safehole->wrap(\&Math::Random::random_f,$safeeval,'&math_random_f'); 720: $safehole->wrap(\&Math::Random::random_gamma,$safeeval,'&math_random_gamma'); 721: $safehole->wrap(\&Math::Random::random_multivariate_normal,$safeeval,'&math_random_multivariate_normal'); 722: $safehole->wrap(\&Math::Random::random_multinomial,$safeeval,'&math_random_multinomial'); 723: $safehole->wrap(\&Math::Random::random_noncentral_chi_square,$safeeval,'&math_random_noncentral_chi_square'); 724: $safehole->wrap(\&Math::Random::random_noncentral_f,$safeeval,'&math_random_noncentral_f'); 725: $safehole->wrap(\&Math::Random::random_normal,$safeeval,'&math_random_normal'); 726: $safehole->wrap(\&Math::Random::random_permutation,$safeeval,'&math_random_permutation'); 727: $safehole->wrap(\&Math::Random::random_permuted_index,$safeeval,'&math_random_permuted_index'); 728: $safehole->wrap(\&Math::Random::random_uniform,$safeeval,'&math_random_uniform'); 729: $safehole->wrap(\&Math::Random::random_poisson,$safeeval,'&math_random_poisson'); 730: $safehole->wrap(\&Math::Random::random_uniform_integer,$safeeval,'&math_random_uniform_integer'); 731: $safehole->wrap(\&Math::Random::random_negative_binomial,$safeeval,'&math_random_negative_binomial'); 732: $safehole->wrap(\&Math::Random::random_binomial,$safeeval,'&math_random_binomial'); 733: $safehole->wrap(\&Math::Random::random_seed_from_phrase,$safeeval,'&random_seed_from_phrase'); 734: $safehole->wrap(\&Math::Random::random_set_seed_from_phrase,$safeeval,'&random_set_seed_from_phrase'); 735: $safehole->wrap(\&Math::Random::random_get_seed,$safeeval,'&random_get_seed'); 736: $safehole->wrap(\&Math::Random::random_set_seed,$safeeval,'&random_set_seed'); 737: $safehole->wrap(\&Apache::lonxml::error,$safeeval,'&LONCAPA_INTERNAL_ERROR'); 738: $safehole->wrap(\&Apache::lonxml::debug,$safeeval,'&LONCAPA_INTERNAL_DEBUG'); 739: 740: #need to inspect this class of ops 741: # $safeeval->deny(":base_orig"); 742: $safeinit .= ';$external::target="'.$target.'";'; 743: my $rndseed; 744: my ($symb,$courseid,$domain,$name) = &Apache::lonxml::whichuser(); 745: $rndseed=&Apache::lonnet::rndseed($symb,$courseid,$domain,$name); 746: $safeinit .= ';$external::randomseed="'.$rndseed.'";'; 747: &Apache::lonxml::debug("Setting rndseed to $rndseed"); 748: &Apache::run::run($safeinit,$safeeval); 749: 750: my $subroutine=<<'EVALUATESUB'; 751: sub __LC_INTERNAL_EVALUATE__ { 752: my ($__LC__a,$__LC__b,$__LC__c)=@_; 753: my $__LC__prefix; 754: while(1){ 755: { 756: use strict; 757: no strict "vars"; 758: if (eval(defined(eval($__LC__a.$__LC__b)))) { 759: return $__LC__prefix.eval($__LC__a.$__LC__b.$__LC__c); 760: } 761: } 762: $__LC__prefix.=substr($__LC__a,0,1,""); 763: if ($__LC__a!~/^(\$|&|\#)/) { last; } 764: } 765: return $__LC__prefix.$__LC__a.$__LC__b.$__LC__c; 766: } 767: EVALUATESUB 768: $safeeval->permit("require"); 769: $safeeval->reval($subroutine); 770: $safeeval->deny("require"); 771: } 772: 773: sub default_homework_load { 774: my ($safeeval)=@_; 775: &Apache::lonxml::debug('Loading default_homework'); 776: my $default=&Apache::lonnet::getfile('/home/httpd/html/res/adm/includes/default_homework.lcpm'); 777: if ($default eq -1) { 778: &Apache::lonxml::error("<b>Unable to find <i>default_homework.lcpm</i></b>"); 779: } else { 780: &Apache::run::run($default,$safeeval); 781: $Apache::lonxml::default_homework_loaded=1; 782: } 783: } 784: 785: sub startredirection { 786: $Apache::lonxml::redirection++; 787: push (@Apache::lonxml::outputstack, ''); 788: } 789: 790: sub endredirection { 791: if (!$Apache::lonxml::redirection) { 792: &Apache::lonxml::error("Endredirection was called, before a startredirection, perhaps you have unbalanced tags. Some debuging information:".join ":",caller); 793: return ''; 794: } 795: $Apache::lonxml::redirection--; 796: pop @Apache::lonxml::outputstack; 797: } 798: 799: sub end_tag { 800: my ($tagstack,$parstack,$token)=@_; 801: pop(@$tagstack); 802: pop(@$parstack); 803: &decreasedepth($token); 804: } 805: 806: sub initdepth { 807: @Apache::lonxml::depthcounter=(); 808: $Apache::lonxml::depth=-1; 809: $Apache::lonxml::olddepth=-1; 810: } 811: 812: sub increasedepth { 813: my ($token) = @_; 814: $Apache::lonxml::depth++; 815: $Apache::lonxml::depthcounter[$Apache::lonxml::depth]++; 816: if ($Apache::lonxml::depthcounter[$Apache::lonxml::depth]==1) { 817: $Apache::lonxml::olddepth=$Apache::lonxml::depth; 818: } 819: my $curdepth=join('_',@Apache::lonxml::depthcounter); 820: &Apache::lonxml::debug("s $Apache::lonxml::depth : $Apache::lonxml::olddepth : $curdepth : $token->[1]\n"); 821: #print "<br />s $Apache::lonxml::depth : $Apache::lonxml::olddepth : $curdepth : $token->[1]\n"; 822: } 823: 824: sub decreasedepth { 825: my ($token) = @_; 826: $Apache::lonxml::depth--; 827: if ($Apache::lonxml::depth<$Apache::lonxml::olddepth-1) { 828: $#Apache::lonxml::depthcounter--; 829: $Apache::lonxml::olddepth=$Apache::lonxml::depth+1; 830: } 831: if ( $Apache::lonxml::depth < -1) { 832: &Apache::lonxml::warning(&mt("Missing tags, unable to properly run file.")); 833: $Apache::lonxml::depth='-1'; 834: } 835: my $curdepth=join('_',@Apache::lonxml::depthcounter); 836: &Apache::lonxml::debug("e $Apache::lonxml::depth : $Apache::lonxml::olddepth : $token->[1] : $curdepth\n"); 837: #print "<br />e $Apache::lonxml::depth : $Apache::lonxml::olddepth : $token->[1] : $curdepth\n"; 838: } 839: 840: sub get_all_text_unbalanced { 841: #there is a copy of this in lonpublisher.pm 842: my($tag,$pars)= @_; 843: my $token; 844: my $result=''; 845: $tag='<'.$tag.'>'; 846: while ($token = $$pars[-1]->get_token) { 847: if (($token->[0] eq 'T')||($token->[0] eq 'C')||($token->[0] eq 'D')) { 848: $result.=$token->[1]; 849: } elsif ($token->[0] eq 'PI') { 850: $result.=$token->[2]; 851: } elsif ($token->[0] eq 'S') { 852: $result.=$token->[4]; 853: } elsif ($token->[0] eq 'E') { 854: $result.=$token->[2]; 855: } 856: if ($result =~ /(.*)\Q$tag\E(.*)/is) { 857: &Apache::lonxml::debug('Got a winner with leftovers ::'.$2); 858: &Apache::lonxml::debug('Result is :'.$1); 859: $result=$1; 860: my $redo=$tag.$2; 861: &Apache::lonxml::newparser($pars,\$redo); 862: last; 863: } 864: } 865: return $result 866: } 867: 868: sub increment_counter { 869: my ($increment) = @_; 870: if (defined($increment) && $increment gt 0) { 871: $Apache::lonxml::counter+=$increment; 872: } else { 873: $Apache::lonxml::counter++; 874: } 875: $Apache::lonxml::counter_changed=1; 876: } 877: 878: sub init_counter { 879: if (defined($ENV{'form.counter'})) { 880: $Apache::lonxml::counter=$ENV{'form.counter'}; 881: $Apache::lonxml::counter_changed=0; 882: } else { 883: $Apache::lonxml::counter=1; 884: $Apache::lonxml::counter_changed=1; 885: } 886: } 887: 888: sub store_counter { 889: &Apache::lonnet::appenv(('form.counter' => $Apache::lonxml::counter)); 890: return ''; 891: } 892: 893: sub get_all_text { 894: my($tag,$pars,$style)= @_; 895: my $gotfullstack=1; 896: if (ref($pars) ne 'ARRAY') { 897: $gotfullstack=0; 898: $pars=[$pars]; 899: } 900: if (ref($style) ne 'HASH') { 901: $style={}; 902: } 903: my $depth=0; 904: my $token; 905: my $result=''; 906: if ( $tag =~ m:^/: ) { 907: my $tag=substr($tag,1); 908: #&Apache::lonxml::debug("have:$tag:"); 909: my $top_empty=0; 910: while (($depth >=0) && ($#$pars > -1) && (!$top_empty)) { 911: while (($depth >=0) && ($token = $$pars[-1]->get_token)) { 912: #&Apache::lonxml::debug("e token:$token->[0]:$depth:$token->[1]:".$#$pars.":".$#Apache::lonxml::pwd); 913: if (($token->[0] eq 'T')||($token->[0] eq 'C')||($token->[0] eq 'D')) { 914: $result.=$token->[1]; 915: } elsif ($token->[0] eq 'PI') { 916: $result.=$token->[2]; 917: } elsif ($token->[0] eq 'S') { 918: if ($token->[1] =~ /^\Q$tag\E$/i) { $depth++; } 919: if ($token->[1] =~ /^LONCAPA_INTERNAL_TURN_STYLE_ON$/) { $Apache::lonxml::usestyle=1; } 920: if ($token->[1] =~ /^LONCAPA_INTERNAL_TURN_STYLE_OFF$/) { $Apache::lonxml::usestyle=0; } 921: $result.=$token->[4]; 922: } elsif ($token->[0] eq 'E') { 923: if ( $token->[1] =~ /^\Q$tag\E$/i) { $depth--; } 924: #skip sending back the last end tag 925: if ($depth == 0 && exists($$style{'/'.$token->[1]}) && $Apache::lonxml::usestyle) { 926: my $string= 927: '<LONCAPA_INTERNAL_TURN_STYLE_OFF end="yes" />'. 928: $$style{'/'.$token->[1]}. 929: $token->[2]. 930: '<LONCAPA_INTERNAL_TURN_STYLE_ON />'; 931: &Apache::lonxml::newparser($pars,\$string); 932: #&Apache::lonxml::debug("reParsing $string"); 933: next; 934: } 935: if ($depth > -1) { 936: $result.=$token->[2]; 937: } else { 938: $$pars[-1]->unget_token($token); 939: } 940: } 941: } 942: if (($depth >=0) && ($#$pars == 0) ) { $top_empty=1; } 943: if (($depth >=0) && ($#$pars > 0) ) { 944: pop(@$pars); 945: pop(@Apache::lonxml::pwd); 946: } 947: } 948: if ($top_empty && $depth >= 0) { 949: #never found the end tag ran out of text, throw error send back blank 950: &error('Never found end tag for <'.$tag. 951: '> current string <pre>'. 952: &HTML::Entities::encode($result,'<>&"'). 953: '</pre>'); 954: if ($gotfullstack) { 955: my $newstring='</'.$tag.'>'.$result; 956: &Apache::lonxml::newparser($pars,\$newstring); 957: } 958: $result=''; 959: } 960: } else { 961: while ($#$pars > -1) { 962: while ($token = $$pars[-1]->get_token) { 963: #&Apache::lonxml::debug("s token:$token->[0]:$depth:$token->[1]"); 964: if (($token->[0] eq 'T')||($token->[0] eq 'C')|| 965: ($token->[0] eq 'D')) { 966: $result.=$token->[1]; 967: } elsif ($token->[0] eq 'PI') { 968: $result.=$token->[2]; 969: } elsif ($token->[0] eq 'S') { 970: if ( $token->[1] =~ /^\Q$tag\E$/i) { 971: $$pars[-1]->unget_token($token); last; 972: } else { 973: $result.=$token->[4]; 974: } 975: if ($token->[1] =~ /^LONCAPA_INTERNAL_TURN_STYLE_ON$/) { $Apache::lonxml::usestyle=1; } 976: if ($token->[1] =~ /^LONCAPA_INTERNAL_TURN_STYLE_OFF$/) { $Apache::lonxml::usestyle=0; } 977: } elsif ($token->[0] eq 'E') { 978: $result.=$token->[2]; 979: } 980: } 981: if (($#$pars > 0) ) { 982: pop(@$pars); 983: pop(@Apache::lonxml::pwd); 984: } else { last; } 985: } 986: } 987: #&Apache::lonxml::debug("Exit:$result:"); 988: return $result 989: } 990: 991: sub newparser { 992: my ($parser,$contentref,$dir) = @_; 993: push (@$parser,HTML::LCParser->new($contentref)); 994: $$parser['-1']->xml_mode('1'); 995: if ( $dir eq '' ) { 996: push (@Apache::lonxml::pwd, $Apache::lonxml::pwd[$#Apache::lonxml::pwd]); 997: } else { 998: push (@Apache::lonxml::pwd, $dir); 999: } 1000: } 1001: 1002: sub parstring { 1003: my ($token) = @_; 1004: my $temp=''; 1005: foreach (@{$token->[3]}) { 1006: unless ($_=~/\W/) { 1007: my $val=$token->[2]->{$_}; 1008: $val =~ s/([\%\@\\\"\'])/\\$1/g; 1009: #if ($val =~ m/^[\%\@]/) { $val="\\".$val; } 1010: $temp .= "my \$$_=\"$val\";"; 1011: } 1012: } 1013: return $temp; 1014: } 1015: 1016: sub writeallows { 1017: unless ($#extlinks>=0) { return; } 1018: my $thisurl='/res/'.&Apache::lonnet::declutter(shift); 1019: if ($ENV{'httpref.'.$thisurl}) { 1020: $thisurl=$ENV{'httpref.'.$thisurl}; 1021: } 1022: my $thisdir=$thisurl; 1023: $thisdir=~s/\/[^\/]+$//; 1024: my %httpref=(); 1025: foreach (@extlinks) { 1026: $httpref{'httpref.'. 1027: &Apache::lonnet::hreflocation($thisdir,$_)}=$thisurl; 1028: } 1029: @extlinks=(); 1030: &Apache::lonnet::appenv(%httpref); 1031: } 1032: 1033: sub register_ssi { 1034: my ($url,%form)=@_; 1035: push (@Apache::lonxml::ssi_info,{'url'=>$url,'form'=>\%form}); 1036: return ''; 1037: } 1038: 1039: sub do_registered_ssi { 1040: foreach my $info (@Apache::lonxml::ssi_info) { 1041: my %form=%{ $info->{'form'}}; 1042: my $url=$info->{'url'}; 1043: &Apache::lonnet::ssi($url,%form); 1044: } 1045: } 1046: # 1047: # Afterburner handles anchors, highlights and links 1048: # 1049: sub afterburn { 1050: my $result=shift; 1051: &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'}, 1052: ['highlight','anchor','link']); 1053: if ($ENV{'form.highlight'}) { 1054: foreach (split(/\,/,$ENV{'form.highlight'})) { 1055: my $anchorname=$_; 1056: my $matchthis=$anchorname; 1057: $matchthis=~s/\_+/\\s\+/g; 1058: $result=~s/(\Q$matchthis\E)/\<font color=\"red\"\>$1\<\/font\>/gs; 1059: } 1060: } 1061: if ($ENV{'form.link'}) { 1062: foreach (split(/\,/,$ENV{'form.link'})) { 1063: my ($anchorname,$linkurl)=split(/\>/,$_); 1064: my $matchthis=$anchorname; 1065: $matchthis=~s/\_+/\\s\+/g; 1066: $result=~s/(\Q$matchthis\E)/\<a href=\"$linkurl\"\>$1\<\/a\>/gs; 1067: } 1068: } 1069: if ($ENV{'form.anchor'}) { 1070: my $anchorname=$ENV{'form.anchor'}; 1071: my $matchthis=$anchorname; 1072: $matchthis=~s/\_+/\\s\+/g; 1073: $result=~s/(\Q$matchthis\E)/\<a name=\"$anchorname\"\>$1\<\/a\>/s; 1074: $result.=(<<"ENDSCRIPT"); 1075: <script type="text/javascript"> 1076: document.location.hash='$anchorname'; 1077: </script> 1078: ENDSCRIPT 1079: } 1080: return $result; 1081: } 1082: 1083: sub storefile { 1084: my ($file,$contents)=@_; 1085: &Apache::lonnet::correct_line_ends(\$contents); 1086: if (my $fh=Apache::File->new('>'.$file)) { 1087: print $fh $contents; 1088: $fh->close(); 1089: return 1; 1090: } else { 1091: &warning("Unable to save file $file"); 1092: return 0; 1093: } 1094: } 1095: 1096: sub createnewhtml { 1097: my $filecontents=(<<SIMPLECONTENT); 1098: <html> 1099: <head> 1100: <title> 1101: Title of Document Goes Here 1102: </title> 1103: </head> 1104: <body bgcolor="#FFFFFF"> 1105: 1106: Body of Document Goes Here 1107: 1108: </body> 1109: </html> 1110: SIMPLECONTENT 1111: return $filecontents; 1112: } 1113: 1114: sub createnewsty { 1115: my $filecontents=(<<SIMPLECONTENT); 1116: <definetag name=""> 1117: <render> 1118: <web></web> 1119: <tex></tex> 1120: </render> 1121: </definetag> 1122: SIMPLECONTENT 1123: return $filecontents; 1124: } 1125: 1126: 1127: sub inserteditinfo { 1128: my ($result,$filecontents,$filetype)=@_; 1129: $filecontents = &HTML::Entities::encode($filecontents,'<>&"'); 1130: # my $editheader='<a href="#editsection">Edit below</a><hr />'; 1131: my $xml_help = ''; 1132: if ($filetype eq 'html') { 1133: $xml_help=Apache::loncommon::helpLatexCheatsheet(); 1134: } 1135: my $cleanbut = ''; 1136: if ($filetype eq 'html') { 1137: $cleanbut='<input type="submit" name="attemptclean" value="'. 1138: &mt('Save and then attempt to clean HTML').'" />'; 1139: } 1140: my $titledisplay=&display_title(); 1141: my %lt=&Apache::lonlocal::texthash('st' => 'Save this', 1142: 'vi' => 'View', 1143: 'ed' => 'Edit'); 1144: my $buttons=(<<BUTTONS); 1145: $cleanbut 1146: <input type="submit" name="savethisfile" accesskey="s" value="$lt{'st'}" /> 1147: <input type="submit" name="viewmode" accesskey="v" value="$lt{'vi'}" /> 1148: BUTTONS 1149: my $editfooter=(<<ENDFOOTER); 1150: <hr /> 1151: <a name="editsection" /> 1152: <form method="post"> 1153: $xml_help 1154: <input type="hidden" name="editmode" value="$lt{'ed'}" /> 1155: $buttons<br /> 1156: <textarea cols="80" rows="40" name="filecont">$filecontents</textarea> 1157: <br />$buttons 1158: <br /> 1159: </form> 1160: $titledisplay 1161: ENDFOOTER 1162: # $result=~s/(\<body[^\>]*\>)/$1$editheader/is; 1163: $result=~s/(\<\/body\>)/$editfooter/is; 1164: return $result; 1165: } 1166: 1167: sub get_target { 1168: my $viewgrades=&Apache::lonnet::allowed('vgr',$ENV{'request.course.id'}); 1169: if ( $ENV{'request.state'} eq 'published') { 1170: if ( defined($ENV{'form.grade_target'}) 1171: && ($viewgrades == 'F' )) { 1172: return ($ENV{'form.grade_target'}); 1173: } elsif (defined($ENV{'form.grade_target'})) { 1174: if (($ENV{'form.grade_target'} eq 'web') || 1175: ($ENV{'form.grade_target'} eq 'tex') ) { 1176: return $ENV{'form.grade_target'} 1177: } else { 1178: return 'web'; 1179: } 1180: } else { 1181: return 'web'; 1182: } 1183: } elsif ($ENV{'request.state'} eq 'construct') { 1184: if ( defined($ENV{'form.grade_target'})) { 1185: return ($ENV{'form.grade_target'}); 1186: } else { 1187: return 'web'; 1188: } 1189: } else { 1190: return 'web'; 1191: } 1192: } 1193: 1194: sub handler { 1195: my $request=shift; 1196: 1197: my $target=&get_target(); 1198: 1199: $Apache::lonxml::debug=$ENV{'user.debug'}; 1200: 1201: if ($ENV{'browser.mathml'}) { 1202: &Apache::loncommon::content_type($request,'text/xml'); 1203: } else { 1204: &Apache::loncommon::content_type($request,'text/html'); 1205: } 1206: &Apache::loncommon::no_cache($request); 1207: $request->send_http_header; 1208: 1209: return OK if $request->header_only; 1210: 1211: 1212: my $file=&Apache::lonnet::filelocation("",$request->uri); 1213: my $filetype; 1214: if ($file =~ /\.sty$/) { 1215: $filetype='sty'; 1216: } else { 1217: $filetype='html'; 1218: } 1219: # 1220: # Edit action? Save file. 1221: # 1222: unless ($ENV{'request.state'} eq 'published') { 1223: if (($ENV{'form.savethisfile'}) || ($ENV{'form.attemptclean'})) { 1224: if (&storefile($file,$ENV{'form.filecont'})) { 1225: &Apache::lonxml::info("<font COLOR=\"#0000FF\">". 1226: &mt('Updated').": ". 1227: &Apache::lonlocal::locallocaltime(time). 1228: " </font>"); 1229: } 1230: } 1231: } 1232: my %mystyle; 1233: my $result = ''; 1234: my $filecontents=&Apache::lonnet::getfile($file); 1235: if ($filecontents eq -1) { 1236: my $bodytag=&Apache::loncommon::bodytag('File Error'); 1237: my $fnf=&mt('File not found'); 1238: $result=(<<ENDNOTFOUND); 1239: <html> 1240: <head> 1241: <title>$fnf</title> 1242: </head> 1243: $bodytag 1244: <b>$fnf: $file</b> 1245: </body> 1246: </html> 1247: ENDNOTFOUND 1248: $filecontents=''; 1249: if ($ENV{'request.state'} ne 'published') { 1250: if ($filetype eq 'sty') { 1251: $filecontents=&createnewsty(); 1252: } else { 1253: $filecontents=&createnewhtml(); 1254: } 1255: $ENV{'form.editmode'}='Edit'; #force edit mode 1256: } 1257: } else { 1258: unless ($ENV{'request.state'} eq 'published') { 1259: if ($ENV{'form.attemptclean'}) { 1260: $filecontents=&htmlclean($filecontents,1); 1261: } 1262: # 1263: # we are in construction space, see if edit mode forced 1264: &Apache::loncommon::get_unprocessed_cgi 1265: ($ENV{'QUERY_STRING'},['editmode']); 1266: } 1267: if (!$ENV{'form.editmode'} || $ENV{'form.viewmode'}) { 1268: $result = &Apache::lonxml::xmlparse($request,$target,$filecontents, 1269: '',%mystyle); 1270: } 1271: } 1272: 1273: # 1274: # Edit action? Insert editing commands 1275: # 1276: unless ($ENV{'request.state'} eq 'published') { 1277: if ($ENV{'form.editmode'} && (!($ENV{'form.viewmode'}))) { 1278: my $displayfile=$request->uri; 1279: $displayfile=~s/^\/[^\/]*//; 1280: $result='<html><body bgcolor="#FFFFFF">'. 1281: &Apache::lonxml::message_location().'<h3>'. 1282: $displayfile. 1283: '</h3></body></html>'; 1284: $result=&inserteditinfo($result,$filecontents,$filetype); 1285: } 1286: } 1287: if ($filetype eq 'html') { writeallows($request->uri); } 1288: 1289: 1290: &Apache::lonxml::add_messages(\$result); 1291: $request->print($result); 1292: 1293: return OK; 1294: } 1295: 1296: sub display_title { 1297: my $result; 1298: if ($ENV{'request.state'} eq 'construct') { 1299: my $title=&Apache::lonnet::gettitle(); 1300: if (!defined($title) || $title eq '') { 1301: $title = $ENV{'request.filename'}; 1302: $title = substr($title, rindex($title, '/') + 1); 1303: } 1304: $result = "<script type='text/javascript'>top.document.title = '$title - LON-CAPA Construction Space';</script>"; 1305: } 1306: return $result; 1307: } 1308: 1309: sub debug { 1310: if ($Apache::lonxml::debug eq "1") { 1311: $|=1; 1312: my $request=$Apache::lonxml::request; 1313: if (!$request) { $request=Apache->request; } 1314: $request->print('<font size="-2"><pre>DEBUG:'.&HTML::Entities::encode($_[0],'<>&"')."</pre></font>\n"); 1315: } 1316: } 1317: 1318: sub error { 1319: $errorcount++; 1320: my $request=$Apache::lonxml::request; 1321: if (!$request) { $request=Apache->request; } 1322: if (($Apache::lonxml::debug eq 1) || ($ENV{'request.state'} eq 'construct') ) { 1323: # If printing in construction space, put the error inside <pre></pre> 1324: push(@Apache::lonxml::error_messages, 1325: $Apache::lonxml::warnings_error_header. 1326: "<b>ERROR:</b>".join("<br />\n",@_)."<br />\n"); 1327: $Apache::lonxml::warnings_error_header=''; 1328: } else { 1329: push(@Apache::lonxml::error_messages, 1330: "<b>An Error occured while processing this resource. The instructor has been notified.</b> <br />"); 1331: #notify author 1332: &Apache::lonmsg::author_res_msg($ENV{'request.filename'},join('<br />',@_)); 1333: #notify course 1334: if ( $ENV{'request.course.id'} ) { 1335: my (undef,%users)=&Apache::lonfeedback::decide_receiver(undef,0,1,1,1); 1336: my $declutter=&Apache::lonnet::declutter($ENV{'request.filename'}); 1337: foreach (keys %users) { 1338: my ($user,$domain) = split(/:/, $_); 1339: &Apache::lonmsg::user_normal_msg($user,$domain, 1340: "Error [$declutter]",join('<br />',@_)); 1341: } 1342: } 1343: } 1344: } 1345: 1346: sub warning { 1347: $warningcount++; 1348: 1349: if ($ENV{'form.grade_target'} ne 'tex') { 1350: if ($ENV{'request.state'} eq 'construct' || $Apache::lonxml::debug) { 1351: my $request=$Apache::lonxml::request; 1352: if (!$request) { $request=Apache->request; } 1353: push(@Apache::lonxml::warning_messages, 1354: $Apache::lonxml::warnings_error_header. 1355: "<b>W</b>ARNING<b>:</b>".join('<br />',@_)."<br />\n"); 1356: $Apache::lonxml::warnings_error_header=''; 1357: } 1358: } 1359: } 1360: 1361: sub info { 1362: if ($ENV{'form.grade_target'} ne 'tex' 1363: && $ENV{'request.state'} eq 'construct') { 1364: push(@Apache::lonxml::info_messages,join('<br />',@_)."<br />\n"); 1365: } 1366: } 1367: 1368: sub message_location { 1369: return '__LONCAPA_INTERNAL_MESSAGE_LOCATION__'; 1370: } 1371: 1372: sub add_messages { 1373: my ($msg)=@_; 1374: my $result=join(' ', 1375: @Apache::lonxml::info_messages, 1376: @Apache::lonxml::error_messages, 1377: @Apache::lonxml::warning_messages); 1378: undef(@Apache::lonxml::info_messages); 1379: undef(@Apache::lonxml::error_messages); 1380: undef(@Apache::lonxml::warning_messages); 1381: $$msg=~s/__LONCAPA_INTERNAL_MESSAGE_LOCATION__/$result/; 1382: $$msg=~s/__LONCAPA_INTERNAL_MESSAGE_LOCATION__//g; 1383: } 1384: 1385: sub get_param { 1386: my ($param,$parstack,$safeeval,$context,$case_insensitive) = @_; 1387: if ( ! $context ) { $context = -1; } 1388: my $args =''; 1389: if ( $#$parstack > (-2-$context) ) { $args=$$parstack[$context]; } 1390: if ( ! $Apache::lonxml::usestyle ) { 1391: $args=$Apache::lonxml::style_values.$args; 1392: } 1393: if ( ! $args ) { return undef; } 1394: if ( $case_insensitive ) { 1395: if ($args =~ s/(my \$)(\Q$param\E)(=\")/$1.lc($2).$3/ei) { 1396: return &Apache::run::run("{$args;".'return $'.$param.'}', 1397: $safeeval); #' 1398: } else { 1399: return undef; 1400: } 1401: } else { 1402: if ( $args =~ /my \$\Q$param\E=\"/ ) { 1403: return &Apache::run::run("{$args;".'return $'.$param.'}', 1404: $safeeval); #' 1405: } else { 1406: return undef; 1407: } 1408: } 1409: } 1410: 1411: sub get_param_var { 1412: my ($param,$parstack,$safeeval,$context,$case_insensitive) = @_; 1413: if ( ! $context ) { $context = -1; } 1414: my $args =''; 1415: if ( $#$parstack > (-2-$context) ) { $args=$$parstack[$context]; } 1416: if ( ! $Apache::lonxml::usestyle ) { 1417: $args=$Apache::lonxml::style_values.$args; 1418: } 1419: &Apache::lonxml::debug("Args are $args param is $param"); 1420: if ($case_insensitive) { 1421: if (! ($args=~s/(my \$)(\Q$param\E)(=\")/$1.lc($2).$3/ei)) { 1422: return undef; 1423: } 1424: } elsif ( $args !~ /my \$\Q$param\E=\"/ ) { return undef; } 1425: my $value=&Apache::run::run("{$args;".'return $'.$param.'}',$safeeval); #' 1426: &Apache::lonxml::debug("first run is $value"); 1427: if ($value =~ /^[\$\@\%]\w+$/) { 1428: &Apache::lonxml::debug("doing second"); 1429: my @result=&Apache::run::run("return $value",$safeeval,1); 1430: if (!defined($result[0])) { 1431: return $value 1432: } else { 1433: if (wantarray) { return @result; } else { return $result[0]; } 1434: } 1435: } else { 1436: return $value; 1437: } 1438: } 1439: 1440: sub register_insert { 1441: my @data = split /\n/, &Apache::lonnet::getfile('/home/httpd/lonTabs/insertlist.tab'); 1442: my $i; 1443: my $tagnum=0; 1444: my @order; 1445: for ($i=0;$i < $#data; $i++) { 1446: my $line = $data[$i]; 1447: if ( $line =~ /^\#/ || $line =~ /^\s*\n/) { next; } 1448: if ( $line =~ /TABLE/ ) { last; } 1449: my ($tag,$descrip,$color,$function,$show,$helpfile,$helpdesc) = split(/,/, $line); 1450: if ($tag) { 1451: $insertlist{"$tagnum.tag"} = $tag; 1452: $insertlist{"$tagnum.description"} = $descrip; 1453: $insertlist{"$tagnum.color"} = $color; 1454: $insertlist{"$tagnum.function"} = $function; 1455: if (!defined($show)) { $show='yes'; } 1456: $insertlist{"$tagnum.show"}= $show; 1457: $insertlist{"$tagnum.helpfile"} = $helpfile; 1458: $insertlist{"$tagnum.helpdesc"} = $helpdesc; 1459: $insertlist{"$tag.num"}=$tagnum; 1460: $tagnum++; 1461: } 1462: } 1463: $i++; #skipping TABLE line 1464: $tagnum = 0; 1465: for (;$i < $#data;$i++) { 1466: my $line = $data[$i]; 1467: my ($mnemonic,@which) = split(/ +/,$line); 1468: my $tag = $insertlist{"$tagnum.tag"}; 1469: for (my $j=0;$j <=$#which;$j++) { 1470: if ( $which[$j] eq 'Y' ) { 1471: if ($insertlist{"$j.show"} ne 'no') { 1472: push(@{ $insertlist{"$tag.which"} },$j); 1473: } 1474: } 1475: } 1476: $tagnum++; 1477: } 1478: } 1479: 1480: sub description { 1481: my ($token)=@_; 1482: my $tagnum; 1483: my $tag=$token->[1]; 1484: foreach my $namespace (reverse @Apache::lonxml::namespace) { 1485: my $testtag=$namespace.'::'.$tag; 1486: $tagnum=$insertlist{"$testtag.num"}; 1487: if (defined($tagnum)) { last; } 1488: } 1489: if (!defined ($tagnum)) { $tagnum=$Apache::lonxml::insertlist{"$tag.num"}; } 1490: return $insertlist{$tagnum.'.description'}; 1491: } 1492: 1493: # Returns a list containing the help file, and the description 1494: sub helpinfo { 1495: my ($token)=@_; 1496: my $tagnum; 1497: my $tag=$token->[1]; 1498: foreach my $namespace (reverse @Apache::lonxml::namespace) { 1499: my $testtag=$namespace.'::'.$tag; 1500: $tagnum=$insertlist{"$testtag.num"}; 1501: if (defined($tagnum)) { last; } 1502: } 1503: if (!defined ($tagnum)) { $tagnum=$Apache::lonxml::insertlist{"$tag.num"}; } 1504: return ($insertlist{$tagnum.'.helpfile'}, $insertlist{$tagnum.'.helpdesc'}); 1505: } 1506: 1507: # ----------------------------------------------------------------- whichuser 1508: # returns a list of $symb, $courseid, $domain, $name that is correct for 1509: # calls to lonnet functions for this setup. 1510: # - looks for form.grade_ parameters 1511: sub whichuser { 1512: my ($passedsymb)=@_; 1513: my ($symb,$courseid,$domain,$name,$publicuser); 1514: if (defined($ENV{'form.grade_symb'})) { 1515: my $tmp_courseid=$ENV{'form.grade_courseid'}; 1516: my $allowed=&Apache::lonnet::allowed('vgr',$tmp_courseid); 1517: if ($allowed) { 1518: $symb=$ENV{'form.grade_symb'}; 1519: $courseid=$ENV{'form.grade_courseid'}; 1520: $domain=$ENV{'form.grade_domain'}; 1521: $name=$ENV{'form.grade_username'}; 1522: } 1523: } else { 1524: if (!$passedsymb) { 1525: $symb=&Apache::lonnet::symbread(); 1526: } else { 1527: $symb=$passedsymb; 1528: } 1529: $courseid=$ENV{'request.course.id'}; 1530: $domain=$ENV{'user.domain'}; 1531: $name=$ENV{'user.name'}; 1532: if ($name eq 'public' && $domain eq 'public') { 1533: if (!defined($ENV{'form.username'})) { 1534: $ENV{'form.username'}.=time.rand(10000000); 1535: } 1536: $name.=$ENV{'form.username'}; 1537: } 1538: } 1539: return ($symb,$courseid,$domain,$name,$publicuser); 1540: } 1541: 1542: 1; 1543: __END__ 1544: 1545: