loncom/xml/lonxml.pm - view

File: [LON-CAPA] / loncom / xml / lonxml.pm
Revision 1.179: download - view: text, annotated - select for diffs
Mon Jul 1 15:29:23 2002 UTC (21 years, 11 months ago) by matthew
Branches: MAIN
CVS tags: version_0_4, stable_2002_july, STABLE, HEAD

Fixes BUG 571 - 'browse' and 'search' buttons failed to work because the
javascript was not being output.  The javascript is now output via a call to
&Apache::loncommon::browser_and_searcher_javascript().  This bug was
introduced by the fix to BUG 232, which has *not* been reintroduced.
The function name "registerurl" should be changed to reflect its larger
role but this fix should go in the next stable release as is.

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