loncom/xml/lonxml.pm - view

File: [LON-CAPA] / loncom / xml / lonxml.pm
Revision 1.434: download - view: text, annotated - select for diffs
Sun Dec 24 22:13:20 2006 UTC (17 years, 4 months ago) by raeburn
Branches: MAIN
CVS tags: HEAD

Include symb in msgid when sending feedback about a resource.

Include an error bit in msgid (1 if message is a "bomb" caused by an error when rendering a problem.

Include symb and resource title in messsage (<symb> and <resource_title> tags) when feedback is about a resource.

Navigate Contents page now checks for unread feedback or errors using symb instead of just resource url.

Navigate Contents page checks for resource context based on symb in msgid instead of in [url] included in message subject.  Backwards compatibility with old-style messages retained.

Subject for feedback messages about resources appends message title instead of url inside [].

Title on feedback page now avoids leaking unencrypted file name in cases where no title was assigned to a resource with hidden url.

When displaying feedback messages about a resource in a course, "Refers to" link displayed when viewer has corresponding course role selected includes symb in the link. Link text is now resource title.

"Refers to" link points to unencrypted resource url if feedback message is viewed under role other than original course, only if user has bre privilege for the resource, otherwise "Refers to" link is not displayed.

lonfeedback -- Some replacement of decode_symb() and &clutter() and &dewrapper() with &get_feedurl_and_clean_symb() for replies and edits of discussion posts.

lonfeedback -- More work on in ensuring hidden urls are encrypted or unencrypted as required.

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