loncom/xml/lonxml.pm - view

File: [LON-CAPA] / loncom / xml / lonxml.pm
Revision 1.212: download - view: text, annotated - select for diffs
Wed Nov 6 23:05:02 2002 UTC (21 years, 6 months ago) by albertel
Branches: MAIN
CVS tags: HEAD

- Fixes most of BUG#793
- added new global var that controls wheter syle files defs are used
- use new tag <LONCAPA_INTERNAL_TURN_STYLE_ON /> to turn style def use back on
- removed recurse sub completely
- get_all_text now understands the Parser stack

Bugs:
- get_all_unbalanced_text needs to use parser stack
- get_all_text uses need to pass entrie parser stack
- style defs that have a tag that ends in a different style def can't use get_all_text


Need To Test:
- pars stack pops in end tags looking for start tags in get_all_text

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