loncom/xml/lonxml.pm - view

File: [LON-CAPA] / loncom / xml / lonxml.pm
Revision 1.217: download - view: text, annotated - select for diffs
Fri Dec 6 17:49:48 2002 UTC (21 years, 6 months ago) by matthew
Branches: MAIN
CVS tags: HEAD

Fix bug 262.  lonxml.pm now checks to see if you have permissions to edit
the currently view resource.  mydesk.tab no longer calls cstrgo in menu.html
so cstrgo and is_editable_resource (javascript functions) have been
removed from menu.html.  lonmenu.pm was cleaned up.
This has been tested for authors and co-authors and across domains.

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