loncom/xml/lonxml.pm - view

File: [LON-CAPA] / loncom / xml / lonxml.pm
Revision 1.167: download - view: text, annotated - select for diffs
Wed Apr 10 15:19:59 2002 UTC (22 years, 1 month ago) by albertel
Branches: MAIN
CVS tags: HEAD

- revert the addiont of <pre> to error messages
- Start using LCParser, and attr_encoded
- Rencode any high characters found before shipping things out
- Addresses parts of BUG#68 and BUG#153

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