loncom/xml/lonxml.pm - view

File: [LON-CAPA] / loncom / xml / lonxml.pm
Revision 1.569: download - view: text, annotated - select for diffs
Sun Mar 31 01:50:18 2024 UTC (8 weeks, 3 days ago) by raeburn
Branches: MAIN
CVS tags: HEAD

- Support "Save and Edit", "Save and View", and "Discard and View" buttons
  above Daxe Editor iframe, when editing HTML file in Daxe, for consistency
  with UI for standard "Text" Editor for this type of file.

1: # The LearningOnline Network with CAPA 2: # XML Parser Module 3: # 4: # $Id: lonxml.pm,v 1.569 2024/03/31 01:50:18 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: =pod 41: 42: =head1 NAME 43: 44: Apache::lonxml 45: 46: =head1 SYNOPSIS 47: 48: XML Parsing Module 49: 50: This is part of the LearningOnline Network with CAPA project 51: described at http://www.lon-capa.org. 52: 53: 54: =head1 SUBROUTINES 55: 56: =cut 57: 58: 59: 60: package Apache::lonxml; 61: use vars 62: qw(@pwd @outputstack $redirection $import @extlinks $metamode $evaluate %insertlist @namespace $errorcount $warningcount); 63: use strict; 64: use LONCAPA; 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 Math::Calculus::Expression(); 73: use Number::FormatEng(); 74: use Opcode(); 75: use POSIX qw(strftime); 76: use Time::HiRes qw( gettimeofday tv_interval ); 77: use Symbol(); 78: 79: sub register { 80: my ($space,@taglist) = @_; 81: foreach my $temptag (@taglist) { 82: push(@{ $Apache::lonxml::alltags{$temptag} },$space); 83: } 84: } 85: 86: sub deregister { 87: my ($space,@taglist) = @_; 88: foreach my $temptag (@taglist) { 89: my $tempspace = $Apache::lonxml::alltags{$temptag}[-1]; 90: if ($tempspace eq $space) { 91: pop(@{ $Apache::lonxml::alltags{$temptag} }); 92: } 93: } 94: #&printalltags(); 95: } 96: 97: use Apache::Constants qw(:common); 98: use Apache::lontexconvert(); 99: use Apache::style(); 100: use Apache::run(); 101: use Apache::londefdef(); 102: use Apache::scripttag(); 103: use Apache::languagetags(); 104: use Apache::edit(); 105: use Apache::inputtags(); 106: use Apache::outputtags(); 107: use Apache::lonnet; 108: use Apache::File(); 109: use Apache::loncommon(); 110: use Apache::lonfeedback(); 111: use Apache::lonmsg(); 112: use Apache::loncacc(); 113: use Apache::lonmaxima(); 114: use Apache::lonr(); 115: use Apache::lonlocal; 116: use Apache::lonhtmlcommon(); 117: use Apache::functionplotresponse(); 118: use Apache::lonnavmaps(); 119: 120: #==================================== Main subroutine: xmlparse 121: 122: #debugging control, to turn on debugging modify the correct handler 123: 124: $Apache::lonxml::debug=0; 125: 126: # keeps count of the number of warnings and errors generated in a parse 127: $warningcount=0; 128: $errorcount=0; 129: 130: #path to the directory containing the file currently being processed 131: @pwd=(); 132: 133: #these two are used for capturing a subset of the output for later processing, 134: #don't touch them directly use &startredirection and &endredirection 135: @outputstack = (); 136: $redirection = 0; 137: 138: #controls wheter the <import> tag actually does 139: $import = 1; 140: @extlinks=(); 141: 142: # meta mode is a bit weird only some output is to be turned off 143: #<output> tag turns metamode off (defined in londefdef.pm) 144: $metamode = 0; 145: 146: # turns on and of run::evaluate actually derefencing var refs 147: $evaluate = 1; 148: 149: # data structure for edit mode, determines what tags can go into what other tags 150: %insertlist=(); 151: 152: # stores the list of active tag namespaces 153: @namespace=(); 154: 155: # stores all Scrit Vars displays for later showing 156: my @script_var_displays=(); 157: 158: # a pointer the the Apache request object 159: $Apache::lonxml::request=''; 160: 161: # a problem number counter, and check on ether it is used 162: $Apache::lonxml::counter=1; 163: $Apache::lonxml::counter_changed=0; 164: 165: # Part counter hash. In analysis mode, the 166: # problems can use this to record which parts increment the counter 167: # by how much. The counter subs will maintain this hash via 168: # their optional part parameters. Note that the assumption is that 169: # analysis is done in one request and therefore it is not necessary to 170: # save this information request-to-request. 171: 172: 173: %Apache::lonxml::counters_per_part = (); 174: 175: #internal check on whether to look at style defs 176: $Apache::lonxml::usestyle=1; 177: 178: #locations used to store the parameter string for style substitutions 179: $Apache::lonxml::style_values=''; 180: $Apache::lonxml::style_end_values=''; 181: 182: #array of ssi calls that need to occur after we are done parsing 183: @Apache::lonxml::ssi_info=(); 184: 185: #should we do the postag variable interpolation 186: $Apache::lonxml::post_evaluate=1; 187: 188: #a header message to emit in the case of any generated warning or errors 189: $Apache::lonxml::warnings_error_header=''; 190: 191: # Control whether or not LaTeX symbols should be substituted for their 192: # \ style equivalents...this may be turned off e.g. in an verbatim 193: # environment. 194: 195: $Apache::lonxml::substitute_LaTeX_symbols = 1; # Starts out on. 196: 197: sub enable_LaTeX_substitutions { 198: $Apache::lonxml::substitute_LaTeX_symbols = 1; 199: } 200: sub disable_LaTeX_substitutions { 201: $Apache::lonxml::substitute_LaTeX_symbols = 0; 202: } 203: 204: sub xmlend { 205: my ($target,$parser)=@_; 206: my $mode='xml'; 207: my $status='OPEN'; 208: if ($Apache::lonhomework::parsing_a_problem || 209: $Apache::lonhomework::parsing_a_task ) { 210: $mode='problem'; 211: $status=$Apache::inputtags::status[-1]; 212: } 213: my $discussion; 214: &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'}, 215: ['LONCAPA_INTERNAL_no_discussion']); 216: if ( 217: ( (!exists($env{'form.LONCAPA_INTERNAL_no_discussion'})) 218: || ($env{'form.LONCAPA_INTERNAL_no_discussion'} ne 'true') 219: ) 220: && ($env{'form.inhibitmenu'} ne 'yes') 221: ) { 222: $discussion=&Apache::lonfeedback::list_discussion($mode,$status); 223: } 224: if ($target eq 'tex') { 225: $discussion.='<tex>\keephidden{ENDOFPROBLEM}\vskip 0.5mm\noindent\makebox[\textwidth/$number_of_columns][b]{\hrulefill}\end{document}</tex>'; 226: &Apache::lonxml::newparser($parser,\$discussion,''); 227: return ''; 228: } 229: 230: return $discussion; 231: } 232: 233: sub printalltags { 234: foreach my $temp (sort(keys(%Apache::lonxml::alltags))) { 235: &Apache::lonxml::debug("$temp -- ". 236: join(',',@{ $Apache::lonxml::alltags{$temp} })); 237: } 238: } 239: 240: sub xmlparse { 241: my ($request,$target,$content_file_string,$safeinit,%style_for_target) = @_; 242: 243: &setup_globals($request,$target); 244: &Apache::inputtags::initialize_inputtags(); 245: &Apache::bridgetask::initialize_bridgetask(); 246: &Apache::outputtags::initialize_outputtags(); 247: &Apache::edit::initialize_edit(); 248: &Apache::londefdef::initialize_londefdef(); 249: 250: # 251: # do we have a course style file? 252: # 253: 254: if ($env{'request.course.id'} && $env{'request.state'} ne 'construct') { 255: my $bodytext= 256: $env{'course.'.$env{'request.course.id'}.'.default_xml_style'}; 257: if ($bodytext) { 258: foreach my $file (split(',',$bodytext)) { 259: my $location=&Apache::lonnet::filelocation('',$file); 260: my $styletext=&Apache::lonnet::getfile($location); 261: if ($styletext ne '-1') { 262: %style_for_target = (%style_for_target, 263: &Apache::style::styleparser($target,$styletext)); 264: } 265: } 266: } 267: } elsif ($env{'construct.style'} 268: && ($env{'request.state'} eq 'construct')) { 269: my $location=&Apache::lonnet::filelocation('',$env{'construct.style'}); 270: my $styletext=&Apache::lonnet::getfile($location); 271: if ($styletext ne '-1') { 272: %style_for_target = (%style_for_target, 273: &Apache::style::styleparser($target,$styletext)); 274: } 275: } 276: #&printalltags(); 277: my @pars = (); 278: my $pwd=$env{'request.filename'}; 279: $pwd =~ s:/[^/]*$::; 280: &newparser(\@pars,\$content_file_string,$pwd); 281: 282: my $safeeval = new Safe; 283: my $safehole = new Safe::Hole; 284: &init_safespace($target,$safeeval,$safehole,$safeinit); 285: #-------------------- Redefinition of the target in the case of compound target 286: 287: ($target, my @tenta) = split('&&',$target); 288: 289: my @stack = (); 290: my @parstack = (); 291: &initdepth(); 292: &init_alarm(); 293: my $finaloutput = &inner_xmlparse($target,\@stack,\@parstack,\@pars, 294: $safeeval,\%style_for_target,1); 295: 296: if (@stack) { 297: &warning(&mt('At end of file some tags were still left unclosed:'). 298: ' <tt><'.join('></tt>, <tt><',reverse(@stack)). 299: '></tt>'); 300: } 301: if ($env{'request.uri'}) { 302: &writeallows($env{'request.uri'}); 303: } 304: &do_registered_ssi(); 305: if ($Apache::lonxml::counter_changed) { &store_counter() } 306: 307: &clean_safespace($safeeval); 308: 309: if (@script_var_displays) { 310: if ($finaloutput =~ m{</body>\s*</html>\s*$}s) { 311: my $scriptoutput = join('',@script_var_displays); 312: $finaloutput=~s{(</body>\s*</html>)\s*$}{$scriptoutput$1}s; 313: } else { 314: $finaloutput .= join('',@script_var_displays); 315: } 316: undef(@script_var_displays); 317: } 318: &init_state(); 319: if ($env{'form.return_only_error_and_warning_counts'}) { 320: if ($env{'request.filename'}=~/\.(html|htm|xml)$/i) { 321: my $error=&verify_html($content_file_string); 322: if ($error) { $errorcount++; } 323: } 324: return "$errorcount:$warningcount"; 325: } 326: return $finaloutput; 327: } 328: 329: sub latex_special_symbols { 330: my ($string,$where)=@_; 331: # 332: # If e.g. in verbatim mode, then don't substitute. 333: # but return original string. 334: # 335: if (!($Apache::lonxml::substitute_LaTeX_symbols)) { 336: return $string; 337: } 338: if ($where eq 'header') { 339: $string =~ s/\\/\$\\backslash\$/g; # \ -> $\backslash$ per LaTex line by line pg 10. 340: $string =~ s/(\$|%|\{|\})/\\$1/g; 341: $string=&Apache::lonprintout::character_chart($string); 342: # any & or # leftover should be safe to just escape 343: $string=~s/([^\\])\&/$1\\\&/g; 344: $string=~s/([^\\])\#/$1\\\#/g; 345: $string =~ s/_/\\_/g; # _ -> \_ 346: $string =~ s/\^/\\\^{}/g; # ^ -> \^{} 347: } else { 348: $string=~s/\\/\\ensuremath{\\backslash}/g; 349: $string=~s/\\\%|\%/\\\%/g; 350: $string=~s/\\\{|\{/\\{/g; 351: $string=~s/\\}|}/\\}/g; 352: $string=~s/\\ensuremath\\\{\\backslash\\}/\\ensuremath{\\backslash}/g; 353: $string=~s/\\\$|\$/\\\$/g; 354: $string=~s/\\\_|\_/\\\_/g; 355: $string=~s/([^\\]|^)(\~|\^)/$1\\$2\\strut /g; 356: $string=~s/(>|<)/\\ensuremath\{$1\}/g; #more or less 357: $string=&Apache::lonprintout::character_chart($string); 358: # any & or # leftover should be safe to just escape 359: $string=~s/\\\&|\&/\\\&/g; 360: $string=~s/\\\#|\#/\\\#/g; 361: $string=~s/\|/\$\\mid\$/g; 362: #single { or } How to escape? 363: } 364: return $string; 365: } 366: 367: sub inner_xmlparse { 368: my ($target,$stack,$parstack,$pars,$safeeval,$style_for_target,$start)=@_; 369: my $finaloutput = ''; 370: my $result; 371: my $token; 372: my $dontpop=0; 373: my $lastdontpop; 374: my $lastendtag; 375: my $startredirection = $Apache::lonxml::redirection; 376: while ( $#$pars > -1 ) { 377: while ($token = $$pars['-1']->get_token) { 378: if (($token->[0] eq 'T') || ($token->[0] eq 'C') ) { 379: if ($metamode<1) { 380: my $text=$token->[1]; 381: if ($token->[0] eq 'C' && $target eq 'tex') { 382: $text = ''; 383: # $text = '%'.$text."\n"; 384: } 385: $result.=$text; 386: } 387: } elsif (($token->[0] eq 'D')) { 388: if ($metamode<1 && $target eq 'web') { 389: my $text=$token->[1]; 390: $result.=$text; 391: } 392: } elsif ($token->[0] eq 'PI') { 393: if ($metamode<1 && $target eq 'web') { 394: $result=$token->[2]; 395: } 396: } elsif ($token->[0] eq 'S') { 397: # add tag to stack 398: push (@$stack,$token->[1]); 399: # add parameters list to another stack 400: push (@$parstack,&parstring($token)); 401: &increasedepth($token); 402: if ($Apache::lonxml::usestyle && 403: exists($$style_for_target{$token->[1]})) { 404: $Apache::lonxml::usestyle=0; 405: my $string=$$style_for_target{$token->[1]}. 406: '<LONCAPA_INTERNAL_TURN_STYLE_ON />'; 407: &Apache::lonxml::newparser($pars,\$string); 408: $Apache::lonxml::style_values=$$parstack[-1]; 409: $Apache::lonxml::style_end_values=$$parstack[-1]; 410: } else { 411: $result = &callsub("start_$token->[1]", $target, $token, $stack, 412: $parstack, $pars, $safeeval, $style_for_target); 413: } 414: } elsif ($token->[0] eq 'E') { 415: if ($Apache::lonxml::usestyle && 416: exists($$style_for_target{'/'."$token->[1]"})) { 417: $Apache::lonxml::usestyle=0; 418: my $string=$$style_for_target{'/'.$token->[1]}. 419: '<LONCAPA_INTERNAL_TURN_STYLE_ON end="'.$token->[1].'" />'; 420: &Apache::lonxml::newparser($pars,\$string); 421: $Apache::lonxml::style_values=$Apache::lonxml::style_end_values; 422: $Apache::lonxml::style_end_values=''; 423: $dontpop=1; 424: } else { 425: #clear out any tags that didn't end 426: while ($token->[1] ne $$stack['-1'] && ($#$stack > -1)) { 427: my $lasttag=$$stack[-1]; 428: if ($token->[1] =~ /^\Q$lasttag\E$/i) { 429: &Apache::lonxml::warning(&mt('Using tag [_1] on line [_2] as end tag to [_3]','</'.$token->[1].'>','.$token->[3].','<'.$$stack[-1].'>')); 430: last; 431: } else { 432: &Apache::lonxml::warning(&mt('Found tag [_1] on line [_2] when looking for [_3] in file.','</'.$token->[1].'>',$token->[3],'</'.$$stack[-1].'>')); 433: &end_tag($stack,$parstack,$token); 434: } 435: } 436: $result = &callsub("end_$token->[1]", $target, $token, $stack, 437: $parstack, $pars,$safeeval, $style_for_target); 438: } 439: } else { 440: &Apache::lonxml::error("Unknown token event :$token->[0]:$token->[1]:"); 441: } 442: #evaluate variable refs in result 443: if ($Apache::lonxml::post_evaluate &&$result ne "") { 444: my $extras; 445: if (!$Apache::lonxml::usestyle) { 446: $extras=$Apache::lonxml::style_values; 447: } 448: if ( $#$parstack > -1 ) { 449: $result=&Apache::run::evaluate($result,$safeeval,$extras.$$parstack[-1]); 450: } else { 451: $result= &Apache::run::evaluate($result,$safeeval,$extras); 452: } 453: } 454: $Apache::lonxml::post_evaluate=1; 455: 456: if (($token->[0] eq 'T') || ($token->[0] eq 'C') || ($token->[0] eq 'D') ) { 457: #Style file definitions should be correct 458: if ($target eq 'tex' && ($Apache::lonxml::usestyle)) { 459: $result=&latex_special_symbols($result); 460: } 461: } 462: 463: if ($Apache::lonxml::redirection) { 464: $Apache::lonxml::outputstack['-1'] .= $result; 465: } else { 466: $finaloutput.=$result; 467: } 468: $result = ''; 469: 470: if ($token->[0] eq 'E') { 471: if ($dontpop) { 472: $lastdontpop = $token; 473: } else { 474: $lastendtag = $token->[1]; 475: &end_tag($stack,$parstack,$token); 476: } 477: } 478: $dontpop=0; 479: } 480: if ($#$pars > -1) { 481: pop @$pars; 482: pop @Apache::lonxml::pwd; 483: } 484: } 485: 486: if (($#$stack == 0) && ($stack->[0] eq 'physnet') && ($target eq 'web') && 487: ($lastendtag eq 'LONCAPA_INTERNAL_TURN_STYLE_ON')) { 488: if ((ref($lastdontpop) eq 'ARRAY') && ($lastdontpop->[1] eq 'physnet')) { 489: &end_tag($stack,$parstack,$lastdontpop); 490: } 491: } 492: 493: # if ($target eq 'meta') { 494: # $finaloutput.=&endredirection; 495: # } 496: 497: if ( $start && $target eq 'grade') { &endredirection(); } 498: if ( $Apache::lonxml::redirection > $startredirection) { 499: while ($Apache::lonxml::redirection > $startredirection) { 500: $finaloutput .= &endredirection(); 501: } 502: } 503: if (($ENV{'QUERY_STRING'}) && ($target eq 'web')) { 504: $finaloutput=&afterburn($finaloutput); 505: } 506: if ($target eq 'modified') { 507: # if modfied, handle startpart and endpart 508: $finaloutput=~s/\<startpartmarker[^\>]*\>(.*)\<endpartmarker[^\>]*\>/<part>$1<\/part>/gs; 509: } 510: return $finaloutput; 511: } 512: 513: ## 514: ## Looks to see if there is a subroutine defined for this tag. If so, call it, 515: ## otherwise do not call it as we do not know what it is. 516: ## 517: sub callsub { 518: my ($sub,$target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; 519: my $currentstring=''; 520: my $nodefault; 521: { 522: my $sub1; 523: no strict 'refs'; 524: my $tag=$token->[1]; 525: # get utterly rid of extended html tags 526: if ($tag=~/^x\-/i) { return ''; } 527: my $space=$Apache::lonxml::alltags{$tag}[-1]; 528: if (!$space) { 529: $tag=~tr/A-Z/a-z/; 530: $sub=~tr/A-Z/a-z/; 531: $space=$Apache::lonxml::alltags{$tag}[-1] 532: } 533: 534: my $deleted=0; 535: if (($token->[0] eq 'S') && ($target eq 'modified')) { 536: $deleted=&Apache::edit::handle_delete($space,$target,$token,$tagstack, 537: $parstack,$parser,$safeeval, 538: $style); 539: } 540: if (!$deleted) { 541: if ($space) { 542: #&Apache::lonxml::debug("Calling sub $sub in $space $metamode"); 543: $sub1="$space\:\:$sub"; 544: ($currentstring,$nodefault) = &$sub1($target,$token,$tagstack, 545: $parstack,$parser,$safeeval, 546: $style); 547: } else { 548: if ($target eq 'tex') { 549: # throw away tag name 550: return ''; 551: } 552: #&Apache::lonxml::debug("NOT Calling sub $sub in $space $metamode"); 553: if ($metamode <1) { 554: if (defined($token->[4]) && ($metamode < 1)) { 555: $currentstring = $token->[4]; 556: } else { 557: $currentstring = $token->[2]; 558: } 559: } 560: } 561: # &Apache::lonxml::debug("nodefalt:$nodefault:"); 562: if ($currentstring eq '' && $nodefault eq '') { 563: if ($target eq 'edit') { 564: #&Apache::lonxml::debug("doing default edit for $token->[1]"); 565: if ($token->[0] eq 'S') { 566: $currentstring = &Apache::edit::tag_start($target,$token); 567: } elsif ($token->[0] eq 'E') { 568: $currentstring = &Apache::edit::tag_end($target,$token); 569: } 570: } 571: } 572: if ($target eq 'modified' && $nodefault eq '') { 573: if ($currentstring eq '') { 574: if ($token->[0] eq 'S') { 575: $currentstring = $token->[4]; 576: } elsif ($token->[0] eq 'E') { 577: $currentstring = $token->[2]; 578: } else { 579: $currentstring = $token->[2]; 580: } 581: } 582: if ($token->[0] eq 'S') { 583: $currentstring.=&Apache::edit::handle_insert(); 584: } elsif ($token->[0] eq 'E') { 585: $currentstring.=&Apache::edit::handle_insertafter($token->[1]); 586: } 587: } 588: } 589: use strict 'refs'; 590: } 591: return $currentstring; 592: } 593: 594: { 595: my %state; 596: 597: sub init_state { 598: undef(%state); 599: } 600: 601: sub set_state { 602: my ($key,$value) = @_; 603: $state{$key} = $value; 604: return $value; 605: } 606: sub get_state { 607: my ($key) = @_; 608: return $state{$key}; 609: } 610: } 611: 612: sub setup_globals { 613: my ($request,$target)=@_; 614: $Apache::lonxml::request=$request; 615: $errorcount=0; 616: $warningcount=0; 617: $Apache::lonxml::internal_error=0; 618: $Apache::lonxml::default_homework_loaded=0; 619: $Apache::lonxml::usestyle=1; 620: &init_counter(); 621: &clear_bubble_lines_for_part(); 622: &init_state(); 623: &set_state('target',$target); 624: @Apache::lonxml::pwd=(); 625: @Apache::lonxml::extlinks=(); 626: @script_var_displays=(); 627: @Apache::lonxml::ssi_info=(); 628: $Apache::lonxml::post_evaluate=1; 629: $Apache::lonxml::warnings_error_header=''; 630: $Apache::lonxml::substitute_LaTeX_symbols = 1; 631: if ($target eq 'meta') { 632: $Apache::lonxml::redirection = 0; 633: $Apache::lonxml::metamode = 1; 634: $Apache::lonxml::evaluate = 1; 635: $Apache::lonxml::import = 0; 636: } elsif ($target eq 'answer') { 637: $Apache::lonxml::redirection = 0; 638: $Apache::lonxml::metamode = 1; 639: $Apache::lonxml::evaluate = 1; 640: $Apache::lonxml::import = 1; 641: } elsif ($target eq 'grade') { 642: &startredirection(); #ended in inner_xmlparse on exit 643: $Apache::lonxml::metamode = 0; 644: $Apache::lonxml::evaluate = 1; 645: $Apache::lonxml::import = 1; 646: } elsif ($target eq 'modified') { 647: $Apache::lonxml::redirection = 0; 648: $Apache::lonxml::metamode = 0; 649: $Apache::lonxml::evaluate = 0; 650: $Apache::lonxml::import = 0; 651: } elsif ($target eq 'edit') { 652: $Apache::lonxml::redirection = 0; 653: $Apache::lonxml::metamode = 0; 654: $Apache::lonxml::evaluate = 0; 655: $Apache::lonxml::import = 0; 656: } elsif ($target eq 'analyze') { 657: $Apache::lonxml::redirection = 0; 658: $Apache::lonxml::metamode = 0; 659: $Apache::lonxml::evaluate = 1; 660: $Apache::lonxml::import = 1; 661: } else { 662: $Apache::lonxml::redirection = 0; 663: $Apache::lonxml::metamode = 0; 664: $Apache::lonxml::evaluate = 1; 665: $Apache::lonxml::import = 1; 666: } 667: } 668: 669: sub init_safespace { 670: my ($target,$safeeval,$safehole,$safeinit) = @_; 671: $safeeval->reval('use LaTeX::Table;'); 672: $safeeval->deny_only(':dangerous'); 673: $safeeval->reval('use LONCAPA::LCMathComplex;'); 674: $safeeval->permit_only(":default"); 675: $safeeval->permit("entereval"); 676: $safeeval->permit(":base_math"); 677: $safeeval->permit("sort"); 678: $safeeval->permit("time"); 679: $safeeval->permit("caller"); 680: $safeeval->deny("rand"); 681: $safeeval->deny("srand"); 682: $safeeval->deny(":base_io"); 683: $safehole->wrap(\&Apache::scripttag::xmlparse,$safeeval,'&xmlparse'); 684: $safehole->wrap(\&Apache::outputtags::multipart,$safeeval,'&multipart'); 685: $safehole->wrap(\&Apache::lonnet::EXT,$safeeval,'&EXT'); 686: $safehole->wrap(\&Apache::chemresponse::chem_standard_order,$safeeval, 687: '&chem_standard_order'); 688: $safehole->wrap(\&Apache::response::check_status,$safeeval,'&check_status'); 689: $safehole->wrap(\&Apache::response::implicit_multiplication,$safeeval,'&implicit_multiplication'); 690: 691: $safehole->wrap(\&Apache::lonmaxima::maxima_eval,$safeeval,'&maxima_eval'); 692: $safehole->wrap(\&Apache::lonmaxima::maxima_check,$safeeval,'&maxima_check'); 693: $safehole->wrap(\&Apache::lonmaxima::maxima_cas_formula_fix,$safeeval, 694: '&maxima_cas_formula_fix'); 695: 696: $safehole->wrap(\&Apache::lonr::r_eval,$safeeval,'&r_eval'); 697: $safehole->wrap(\&Apache::lonr::Rentry,$safeeval,'&Rentry'); 698: $safehole->wrap(\&Apache::lonr::Rarray,$safeeval,'&Rarray'); 699: $safehole->wrap(\&Apache::lonr::r_check,$safeeval,'&r_check'); 700: $safehole->wrap(\&Apache::lonr::r_cas_formula_fix,$safeeval, 701: '&r_cas_formula_fix'); 702: 703: $safehole->wrap(\&Apache::caparesponse::capa_formula_fix,$safeeval, 704: '&capa_formula_fix'); 705: 706: $safehole->wrap(\&Apache::lonlocal::locallocaltime,$safeeval, 707: '&locallocaltime'); 708: 709: $safehole->wrap(\&Math::Cephes::asin,$safeeval,'&asin'); 710: $safehole->wrap(\&Math::Cephes::acos,$safeeval,'&acos'); 711: $safehole->wrap(\&Math::Cephes::atan,$safeeval,'&atan'); 712: $safehole->wrap(\&Math::Cephes::sinh,$safeeval,'&sinh'); 713: $safehole->wrap(\&Math::Cephes::cosh,$safeeval,'&cosh'); 714: $safehole->wrap(\&Math::Cephes::tanh,$safeeval,'&tanh'); 715: $safehole->wrap(\&Math::Cephes::asinh,$safeeval,'&asinh'); 716: $safehole->wrap(\&Math::Cephes::acosh,$safeeval,'&acosh'); 717: $safehole->wrap(\&Math::Cephes::atanh,$safeeval,'&atanh'); 718: $safehole->wrap(\&Math::Cephes::erf,$safeeval,'&erf'); 719: $safehole->wrap(\&Math::Cephes::erfc,$safeeval,'&erfc'); 720: $safehole->wrap(\&Math::Cephes::j0,$safeeval,'&j0'); 721: $safehole->wrap(\&Math::Cephes::j1,$safeeval,'&j1'); 722: $safehole->wrap(\&Math::Cephes::jn,$safeeval,'&jn'); 723: $safehole->wrap(\&Math::Cephes::jv,$safeeval,'&jv'); 724: $safehole->wrap(\&Math::Cephes::y0,$safeeval,'&y0'); 725: $safehole->wrap(\&Math::Cephes::y1,$safeeval,'&y1'); 726: $safehole->wrap(\&Math::Cephes::yn,$safeeval,'&yn'); 727: $safehole->wrap(\&Math::Cephes::yv,$safeeval,'&yv'); 728: 729: $safehole->wrap(\&Math::Cephes::bdtr ,$safeeval,'&bdtr' ); 730: $safehole->wrap(\&Math::Cephes::bdtrc ,$safeeval,'&bdtrc' ); 731: $safehole->wrap(\&Math::Cephes::bdtri ,$safeeval,'&bdtri' ); 732: $safehole->wrap(\&Math::Cephes::btdtr ,$safeeval,'&btdtr' ); 733: $safehole->wrap(\&Math::Cephes::chdtr ,$safeeval,'&chdtr' ); 734: $safehole->wrap(\&Math::Cephes::chdtrc,$safeeval,'&chdtrc'); 735: $safehole->wrap(\&Math::Cephes::chdtri,$safeeval,'&chdtri'); 736: $safehole->wrap(\&Math::Cephes::fdtr ,$safeeval,'&fdtr' ); 737: $safehole->wrap(\&Math::Cephes::fdtrc ,$safeeval,'&fdtrc' ); 738: $safehole->wrap(\&Math::Cephes::fdtri ,$safeeval,'&fdtri' ); 739: $safehole->wrap(\&Math::Cephes::gdtr ,$safeeval,'&gdtr' ); 740: $safehole->wrap(\&Math::Cephes::gdtrc ,$safeeval,'&gdtrc' ); 741: $safehole->wrap(\&Math::Cephes::nbdtr ,$safeeval,'&nbdtr' ); 742: $safehole->wrap(\&Math::Cephes::nbdtrc,$safeeval,'&nbdtrc'); 743: $safehole->wrap(\&Math::Cephes::nbdtri,$safeeval,'&nbdtri'); 744: $safehole->wrap(\&Math::Cephes::ndtr ,$safeeval,'&ndtr' ); 745: $safehole->wrap(\&Math::Cephes::ndtri ,$safeeval,'&ndtri' ); 746: $safehole->wrap(\&Math::Cephes::pdtr ,$safeeval,'&pdtr' ); 747: $safehole->wrap(\&Math::Cephes::pdtrc ,$safeeval,'&pdtrc' ); 748: $safehole->wrap(\&Math::Cephes::pdtri ,$safeeval,'&pdtri' ); 749: $safehole->wrap(\&Math::Cephes::stdtr ,$safeeval,'&stdtr' ); 750: $safehole->wrap(\&Math::Cephes::stdtri,$safeeval,'&stdtri'); 751: 752: $safehole->wrap(\&Math::Cephes::Matrix::mat,$safeeval,'&mat'); 753: $safehole->wrap(\&Math::Cephes::Matrix::new,$safeeval, 754: '&Math::Cephes::Matrix::new'); 755: $safehole->wrap(\&Math::Cephes::Matrix::coef,$safeeval, 756: '&Math::Cephes::Matrix::coef'); 757: $safehole->wrap(\&Math::Cephes::Matrix::clr,$safeeval, 758: '&Math::Cephes::Matrix::clr'); 759: $safehole->wrap(\&Math::Cephes::Matrix::add,$safeeval, 760: '&Math::Cephes::Matrix::add'); 761: $safehole->wrap(\&Math::Cephes::Matrix::sub,$safeeval, 762: '&Math::Cephes::Matrix::sub'); 763: $safehole->wrap(\&Math::Cephes::Matrix::mul,$safeeval, 764: '&Math::Cephes::Matrix::mul'); 765: $safehole->wrap(\&Math::Cephes::Matrix::div,$safeeval, 766: '&Math::Cephes::Matrix::div'); 767: $safehole->wrap(\&Math::Cephes::Matrix::inv,$safeeval, 768: '&Math::Cephes::Matrix::inv'); 769: $safehole->wrap(\&Math::Cephes::Matrix::transp,$safeeval, 770: '&Math::Cephes::Matrix::transp'); 771: $safehole->wrap(\&Math::Cephes::Matrix::simq,$safeeval, 772: '&Math::Cephes::Matrix::simq'); 773: $safehole->wrap(\&Math::Cephes::Matrix::mat_to_vec,$safeeval, 774: '&Math::Cephes::Matrix::mat_to_vec'); 775: $safehole->wrap(\&Math::Cephes::Matrix::vec_to_mat,$safeeval, 776: '&Math::Cephes::Matrix::vec_to_mat'); 777: $safehole->wrap(\&Math::Cephes::Matrix::check,$safeeval, 778: '&Math::Cephes::Matrix::check'); 779: $safehole->wrap(\&Math::Cephes::Matrix::check,$safeeval, 780: '&Math::Cephes::Matrix::check'); 781: 782: # $safehole->wrap(\&Math::Cephes::new_fract,$safeeval,'&new_fract'); 783: # $safehole->wrap(\&Math::Cephes::radd,$safeeval,'&radd'); 784: # $safehole->wrap(\&Math::Cephes::rsub,$safeeval,'&rsub'); 785: # $safehole->wrap(\&Math::Cephes::rmul,$safeeval,'&rmul'); 786: # $safehole->wrap(\&Math::Cephes::rdiv,$safeeval,'&rdiv'); 787: # $safehole->wrap(\&Math::Cephes::euclid,$safeeval,'&euclid'); 788: 789: $safehole->wrap(\&Math::Random::random_beta,$safeeval,'&math_random_beta'); 790: $safehole->wrap(\&Math::Random::random_chi_square,$safeeval,'&math_random_chi_square'); 791: $safehole->wrap(\&Math::Random::random_exponential,$safeeval,'&math_random_exponential'); 792: $safehole->wrap(\&Math::Random::random_f,$safeeval,'&math_random_f'); 793: $safehole->wrap(\&Math::Random::random_gamma,$safeeval,'&math_random_gamma'); 794: $safehole->wrap(\&Math::Random::random_multivariate_normal,$safeeval,'&math_random_multivariate_normal'); 795: $safehole->wrap(\&Math::Random::random_multinomial,$safeeval,'&math_random_multinomial'); 796: $safehole->wrap(\&Math::Random::random_noncentral_chi_square,$safeeval,'&math_random_noncentral_chi_square'); 797: $safehole->wrap(\&Math::Random::random_noncentral_f,$safeeval,'&math_random_noncentral_f'); 798: $safehole->wrap(\&Math::Random::random_normal,$safeeval,'&math_random_normal'); 799: $safehole->wrap(\&Math::Random::random_permutation,$safeeval,'&math_random_permutation'); 800: $safehole->wrap(\&Math::Random::random_permuted_index,$safeeval,'&math_random_permuted_index'); 801: $safehole->wrap(\&Math::Random::random_uniform,$safeeval,'&math_random_uniform'); 802: $safehole->wrap(\&Math::Random::random_poisson,$safeeval,'&math_random_poisson'); 803: $safehole->wrap(\&Math::Random::random_uniform_integer,$safeeval,'&math_random_uniform_integer'); 804: $safehole->wrap(\&Math::Random::random_negative_binomial,$safeeval,'&math_random_negative_binomial'); 805: $safehole->wrap(\&Math::Random::random_binomial,$safeeval,'&math_random_binomial'); 806: $safehole->wrap(\&Math::Random::random_seed_from_phrase,$safeeval,'&random_seed_from_phrase'); 807: $safehole->wrap(\&Math::Random::random_set_seed_from_phrase,$safeeval,'&random_set_seed_from_phrase'); 808: $safehole->wrap(\&Math::Random::random_get_seed,$safeeval,'&random_get_seed'); 809: $safehole->wrap(\&Math::Random::random_set_seed,$safeeval,'&random_set_seed'); 810: $safehole->wrap(\&Apache::loncommon::languages,$safeeval,'&languages'); 811: $safehole->wrap(\&Apache::lonxml::error,$safeeval,'&LONCAPA_INTERNAL_ERROR'); 812: $safehole->wrap(\&Apache::lonxml::debug,$safeeval,'&LONCAPA_INTERNAL_DEBUG'); 813: $safehole->wrap(\&Apache::lonnet::logthis,$safeeval,'&LONCAPA_INTERNAL_LOGTHIS'); 814: $safehole->wrap(\&Apache::inputtags::finalizeawards,$safeeval,'&LONCAPA_INTERNAL_FINALIZEAWARDS'); 815: $safehole->wrap(\&Apache::caparesponse::get_sigrange,$safeeval,'&LONCAPA_INTERNAL_get_sigrange'); 816: $safehole->wrap(\&Apache::functionplotresponse::fpr_val,$safeeval,'&fpr_val'); 817: $safehole->wrap(\&Apache::functionplotresponse::fpr_f,$safeeval,'&fpr_f'); 818: $safehole->wrap(\&Apache::functionplotresponse::fpr_dfdx,$safeeval,'&fpr_dfdx'); 819: $safehole->wrap(\&Apache::functionplotresponse::fpr_d2fdx2,$safeeval,'&fpr_d2fdx2'); 820: $safehole->wrap(\&Apache::functionplotresponse::fpr_vectorcoords,$safeeval,'&fpr_vectorcoords'); 821: $safehole->wrap(\&Apache::functionplotresponse::fpr_objectcoords,$safeeval,'&fpr_objectcoords'); 822: $safehole->wrap(\&Apache::functionplotresponse::fpr_vectorlength,$safeeval,'&fpr_vectorlength'); 823: $safehole->wrap(\&Apache::functionplotresponse::fpr_vectorangle,$safeeval,'&fpr_vectorangle'); 824: $safehole->wrap(\&Math::Calculus::Expression::math_calculus_expression,$safeeval,'&math_calculus_expression'); 825: $safehole->wrap(\&Number::FormatEng::format_eng,$safeeval,'&number_format_eng'); 826: $safehole->wrap(\&Number::FormatEng::format_pref,$safeeval,'&number_format_pref'); 827: 828: # use Data::Dumper; 829: # $safehole->wrap(\&Data::Dumper::Dumper,$safeeval,'&LONCAPA_INTERNAL_Dumper'); 830: #need to inspect this class of ops 831: # $safeeval->deny(":base_orig"); 832: $safeeval->permit("require"); 833: $safeinit .= ';$external::target="'.$target.'";'; 834: &Apache::run::run($safeinit,$safeeval); 835: my $rawrndseed = &initialize_rndseed($safeeval); 836: if ($target eq 'grade') { 837: $Apache::lonhomework::rawrndseed = $rawrndseed; 838: } 839: } 840: 841: sub clean_safespace { 842: my ($safeeval) = @_; 843: delete_package_recurse($safeeval->{Root}); 844: } 845: 846: sub delete_package_recurse { 847: my ($package) = @_; 848: my @subp; 849: { 850: no strict 'refs'; 851: while (my ($key,$val) = each(%{*{"$package\::"}})) { 852: if (!defined($val)) { next; } 853: local (*ENTRY) = $val; 854: if (defined *ENTRY{HASH} && $key =~ /::$/ && 855: $key ne "main::" && $key ne "<none>::") 856: { 857: my ($p) = $package ne "main" ? "$package\::" : ""; 858: ($p .= $key) =~ s/::$//; 859: push(@subp,$p); 860: } 861: } 862: } 863: foreach my $p (@subp) { 864: delete_package_recurse($p); 865: } 866: Symbol::delete_package($package); 867: } 868: 869: sub initialize_rndseed { 870: my ($safeeval)=@_; 871: my $rndseed; 872: my ($symb,$courseid,$domain,$name) = &Apache::lonnet::whichuser(); 873: $rndseed=&Apache::lonnet::rndseed($symb,$courseid,$domain,$name); 874: my $safeinit = '$external::randomseed="'.$rndseed.'";'; 875: &Apache::lonxml::debug("Setting rndseed to $rndseed"); 876: &Apache::run::run($safeinit,$safeeval); 877: return $rndseed; 878: } 879: 880: sub default_homework_load { 881: my ($safeeval)=@_; 882: &Apache::lonxml::debug('Loading default_homework'); 883: my $default=&Apache::lonnet::getfile($Apache::lonnet::perlvar{'lonIncludes'}. 884: '/default_homework.lcpm'); 885: if ($default eq -1) { 886: &Apache::lonxml::error("<b>Unable to find <i>default_homework.lcpm</i></b>"); 887: } else { 888: &Apache::run::run($default,$safeeval); 889: $Apache::lonxml::default_homework_loaded=1; 890: } 891: } 892: 893: { 894: my $alarm_depth; 895: sub init_alarm { 896: alarm(0); 897: $alarm_depth=0; 898: } 899: 900: sub start_alarm { 901: if ($alarm_depth<1) { 902: my $old=alarm($Apache::lonnet::perlvar{'lonScriptTimeout'}); 903: if ($old) { 904: &Apache::lonxml::error("Cancelled an alarm of $old, this shouldn't occur."); 905: } 906: } 907: $alarm_depth++; 908: } 909: 910: sub end_alarm { 911: $alarm_depth--; 912: if ($alarm_depth<1) { alarm(0); } 913: } 914: } 915: my $metamode_was; 916: sub startredirection { 917: if (!$Apache::lonxml::redirection) { 918: $metamode_was=$Apache::lonxml::metamode; 919: } 920: $Apache::lonxml::metamode=0; 921: $Apache::lonxml::redirection++; 922: push (@Apache::lonxml::outputstack, ''); 923: } 924: 925: sub endredirection { 926: if (!$Apache::lonxml::redirection) { 927: &Apache::lonxml::error("Endredirection was called before a startredirection, perhaps you have unbalanced tags. Some debugging information:".join ":",caller); 928: return ''; 929: } 930: $Apache::lonxml::redirection--; 931: if (!$Apache::lonxml::redirection) { 932: $Apache::lonxml::metamode=$metamode_was; 933: } 934: pop @Apache::lonxml::outputstack; 935: } 936: sub in_redirection { 937: return ($Apache::lonxml::redirection > 0) 938: } 939: 940: sub end_tag { 941: my ($tagstack,$parstack,$token)=@_; 942: pop(@$tagstack); 943: pop(@$parstack); 944: &decreasedepth($token); 945: } 946: 947: sub initdepth { 948: @Apache::lonxml::depthcounter=(); 949: undef($Apache::lonxml::last_depth_count); 950: } 951: 952: 953: my @timers; 954: my $lasttime; 955: # @Apache::lonxml::depthcounter -> count of tags that exist so 956: # far at each level 957: # $Apache::lonxml::last_depth_count -> when ascending, need to 958: # remember the count for the level below the current level (for 959: # example going from 1_2 -> 1 -> 1_3 need to remember the 2 ) 960: 961: sub increasedepth { 962: my ($token) = @_; 963: push(@Apache::lonxml::depthcounter,$Apache::lonxml::last_depth_count+1); 964: undef($Apache::lonxml::last_depth_count); 965: my $time; 966: if ($Apache::lonxml::debug eq "1") { 967: push(@timers,[&gettimeofday()]); 968: $time=&tv_interval($lasttime); 969: $lasttime=[&gettimeofday()]; 970: } 971: my $spacing=' 'x($#Apache::lonxml::depthcounter); 972: $Apache::lonxml::curdepth=join('_',@Apache::lonxml::depthcounter); 973: # &Apache::lonxml::debug("s$spacing$Apache::lonxml::depth : $Apache::lonxml::olddepth : $Apache::lonxml::curdepth : $token->[1] : $time"); 974: #print "<br />s $Apache::lonxml::depth : $Apache::lonxml::olddepth : $curdepth : $token->[1]\n"; 975: } 976: 977: sub decreasedepth { 978: my ($token) = @_; 979: if ( $#Apache::lonxml::depthcounter == -1) { 980: &Apache::lonxml::warning(&mt("Missing tags, unable to properly run file.")); 981: } 982: $Apache::lonxml::last_depth_count = pop(@Apache::lonxml::depthcounter); 983: 984: my ($timer,$time); 985: if ($Apache::lonxml::debug eq "1") { 986: $timer=pop(@timers); 987: $time=&tv_interval($lasttime); 988: $lasttime=[&gettimeofday()]; 989: } 990: my $spacing=' 'x($#Apache::lonxml::depthcounter); 991: $Apache::lonxml::curdepth = join('_',@Apache::lonxml::depthcounter); 992: # &Apache::lonxml::debug("e$spacing$Apache::lonxml::depth : $Apache::lonxml::olddepth : $Apache::lonxml::curdepth : $token->[1] : $time : ".&tv_interval($timer)); 993: #print "<br />e $Apache::lonxml::depth : $Apache::lonxml::olddepth : $token->[1] : $curdepth\n"; 994: } 995: 996: sub get_id { 997: my ($parstack,$safeeval)=@_; 998: my $id= &Apache::lonxml::get_param('id',$parstack,$safeeval); 999: if ($env{'request.state'} eq 'construct' && $id =~ /([._]|[^\w\s\-])/) { 1000: &error(&mt('ID [_1] contains invalid characters. IDs are only allowed to contain letters, numbers, spaces and -','"<tt>'.$id.'</tt>"')); 1001: } 1002: if ($id =~ /^\s*$/) { $id = $Apache::lonxml::curdepth; } 1003: return $id; 1004: } 1005: 1006: sub get_all_text_unbalanced { 1007: #there is a copy of this in lonpublisher.pm 1008: my($tag,$pars)= @_; 1009: my $token; 1010: my $result=''; 1011: $tag='<'.$tag.'>'; 1012: while ($token = $$pars[-1]->get_token) { 1013: if (($token->[0] eq 'T')||($token->[0] eq 'C')||($token->[0] eq 'D')) { 1014: if ($token->[0] eq 'T' && $token->[2]) { 1015: $result.='<![CDATA['.$token->[1].']]>'; 1016: } else { 1017: $result.=$token->[1]; 1018: } 1019: } elsif ($token->[0] eq 'PI') { 1020: $result.=$token->[2]; 1021: } elsif ($token->[0] eq 'S') { 1022: $result.=$token->[4]; 1023: } elsif ($token->[0] eq 'E') { 1024: $result.=$token->[2]; 1025: } 1026: if ($result =~ /\Q$tag\E/is) { 1027: ($result,my $redo)=$result =~ /(.*)\Q$tag\E(.*)/is; 1028: #&Apache::lonxml::debug('Got a winner with leftovers ::'.$2); 1029: #&Apache::lonxml::debug('Result is :'.$1); 1030: $redo=$tag.$redo; 1031: &Apache::lonxml::newparser($pars,\$redo); 1032: last; 1033: } 1034: } 1035: return $result 1036: 1037: } 1038: 1039: ######################################################################### 1040: # # 1041: # bubble line counter management # 1042: # # 1043: ######################################################################### 1044: 1045: =pod 1046: 1047: For bubble grading mode and exam bubble printing mode, the tracking of 1048: the current 'bubble line number' is stored in the %env element 1049: 'form.counter', and is modifed and handled by the following routines. 1050: 1051: The value of it is stored in $Apache:lonxml::counter when live and 1052: stored back to env after done. 1053: 1054: =item &increment_counter($increment, $part_response); 1055: 1056: Increments the internal counter environment variable a specified amount 1057: 1058: Optional Arguments: 1059: $increment - amount to increment by (defaults to 1) 1060: Also 1 if the value is negative or zero. 1061: $part_response - A concatenation of the part and response id 1062: identifying exactly what is being 'answered'. 1063: 1064: 1065: =cut 1066: 1067: sub increment_counter { 1068: my ($increment, $part_response) = @_; 1069: if ($env{'form.grade_noincrement'}) { return; } 1070: if (!defined($increment) || $increment le 0) { 1071: $increment = 1; 1072: } 1073: $Apache::lonxml::counter += $increment; 1074: 1075: # If the caller supplied the response_id parameter, 1076: # Maintain its counter.. creating if necessary. 1077: 1078: if (defined($part_response)) { 1079: if (!defined($Apache::lonxml::counters_per_part{$part_response})) { 1080: $Apache::lonxml::counters_per_part{$part_response} = 0; 1081: } 1082: $Apache::lonxml::counters_per_part{$part_response} += $increment; 1083: my $new_value = $Apache::lonxml::counters_per_part{$part_response}; 1084: } 1085: 1086: $Apache::lonxml::counter_changed=1; 1087: } 1088: 1089: =pod 1090: 1091: =item &init_counter($increment); 1092: 1093: Initialize the internal counter environment variable 1094: 1095: =cut 1096: 1097: sub init_counter { 1098: if ($env{'request.state'} eq 'construct') { 1099: $Apache::lonxml::counter=1; 1100: $Apache::lonxml::counter_changed=1; 1101: } elsif (defined($env{'form.counter'})) { 1102: $Apache::lonxml::counter=$env{'form.counter'}; 1103: $Apache::lonxml::counter_changed=0; 1104: } else { 1105: $Apache::lonxml::counter=1; 1106: $Apache::lonxml::counter_changed=1; 1107: } 1108: } 1109: 1110: sub store_counter { 1111: &Apache::lonnet::appenv({'form.counter' => $Apache::lonxml::counter}); 1112: $Apache::lonxml::counter_changed=0; 1113: return ''; 1114: } 1115: 1116: { 1117: my $state; 1118: sub clear_problem_counter { 1119: undef($state); 1120: &Apache::lonnet::delenv('form.counter'); 1121: &Apache::lonxml::init_counter(); 1122: &Apache::lonxml::store_counter(); 1123: } 1124: 1125: sub remember_problem_counter { 1126: &Apache::lonnet::transfer_profile_to_env(undef,undef,1); 1127: $state = $env{'form.counter'}; 1128: } 1129: 1130: sub restore_problem_counter { 1131: if (defined($state)) { 1132: &Apache::lonnet::appenv({'form.counter' => $state}); 1133: } 1134: } 1135: sub get_problem_counter { 1136: if ($Apache::lonxml::counter_changed) { &store_counter() } 1137: &Apache::lonnet::transfer_profile_to_env(undef,undef,1); 1138: return $env{'form.counter'}; 1139: } 1140: } 1141: 1142: =pod 1143: 1144: =item bubble_lines_for_part(part_response) 1145: 1146: Returns the number of lines required to get a response for 1147: $part_response (this is just $Apache::lonxml::counters_per_part{$part_response} 1148: 1149: =cut 1150: 1151: sub bubble_lines_for_part { 1152: my ($part_response) = @_; 1153: 1154: if (!defined($Apache::lonxml::counters_per_part{$part_response})) { 1155: return 0; 1156: } else { 1157: return $Apache::lonxml::counters_per_part{$part_response}; 1158: } 1159: } 1160: 1161: =pod 1162: 1163: =item clear_bubble_lines_for_part 1164: 1165: Clears the hash of bubble lines per part. If a caller 1166: needs to analyze several resources this should be called between 1167: resources to reset the hash for each problem being analyzed. 1168: 1169: =cut 1170: 1171: sub clear_bubble_lines_for_part { 1172: undef(%Apache::lonxml::counters_per_part); 1173: } 1174: 1175: =pod 1176: 1177: =item set_bubble_lines(part_response, value) 1178: 1179: If there is a problem part, that for whatever reason 1180: requires bubble lines that are not 1181: the same as the counter increment, it can call this sub during 1182: analysis to set its hash value explicitly. 1183: 1184: =cut 1185: 1186: sub set_bubble_lines { 1187: my ($part_response, $value) = @_; 1188: 1189: $Apache::lonxml::counters_per_part{$part_response} = $value; 1190: } 1191: 1192: =pod 1193: 1194: =item get_bubble_line_hash 1195: 1196: Returns the current bubble line hash. This is assumed to 1197: be small so we return a copy 1198: 1199: 1200: =cut 1201: 1202: sub get_bubble_line_hash { 1203: return %Apache::lonxml::counters_per_part; 1204: } 1205: 1206: 1207: #-------------------------------------------------- 1208: 1209: sub get_all_text { 1210: my($tag,$pars,$style)= @_; 1211: my $gotfullstack=1; 1212: if (ref($pars) ne 'ARRAY') { 1213: $gotfullstack=0; 1214: $pars=[$pars]; 1215: } 1216: if (ref($style) ne 'HASH') { 1217: $style={}; 1218: } 1219: my $depth=0; 1220: my $token; 1221: my $result=''; 1222: if ( $tag =~ m:^/: ) { 1223: my $tag=substr($tag,1); 1224: #&Apache::lonxml::debug("have:$tag:"); 1225: my $top_empty=0; 1226: while (($depth >=0) && ($#$pars > -1) && (!$top_empty)) { 1227: while (($depth >=0) && ($token = $$pars[-1]->get_token)) { 1228: #&Apache::lonxml::debug("e token:$token->[0]:$depth:$token->[1]:".$#$pars.":".$#Apache::lonxml::pwd); 1229: if (($token->[0] eq 'T')||($token->[0] eq 'C')||($token->[0] eq 'D')) { 1230: if ($token->[2]) { 1231: $result.='<![CDATA['.$token->[1].']]>'; 1232: } else { 1233: $result.=$token->[1]; 1234: } 1235: } elsif ($token->[0] eq 'PI') { 1236: $result.=$token->[2]; 1237: } elsif ($token->[0] eq 'S') { 1238: if ($token->[1] =~ /^\Q$tag\E$/i) { $depth++; } 1239: if ($token->[1] =~ /^LONCAPA_INTERNAL_TURN_STYLE_ON$/) { $Apache::lonxml::usestyle=1; } 1240: if ($token->[1] =~ /^LONCAPA_INTERNAL_TURN_STYLE_OFF$/) { $Apache::lonxml::usestyle=0; } 1241: $result.=$token->[4]; 1242: } elsif ($token->[0] eq 'E') { 1243: if ( $token->[1] =~ /^\Q$tag\E$/i) { $depth--; } 1244: #skip sending back the last end tag 1245: if ($depth == 0 && exists($$style{'/'.$token->[1]}) && $Apache::lonxml::usestyle) { 1246: my $string= 1247: '<LONCAPA_INTERNAL_TURN_STYLE_OFF end="yes" />'. 1248: $$style{'/'.$token->[1]}. 1249: $token->[2]. 1250: '<LONCAPA_INTERNAL_TURN_STYLE_ON />'; 1251: &Apache::lonxml::newparser($pars,\$string); 1252: #&Apache::lonxml::debug("reParsing $string"); 1253: next; 1254: } 1255: if ($depth > -1) { 1256: $result.=$token->[2]; 1257: } else { 1258: $$pars[-1]->unget_token($token); 1259: } 1260: } 1261: } 1262: if (($depth >=0) && ($#$pars == 0) ) { $top_empty=1; } 1263: if (($depth >=0) && ($#$pars > 0) ) { 1264: pop(@$pars); 1265: pop(@Apache::lonxml::pwd); 1266: } 1267: } 1268: if ($top_empty && $depth >= 0) { 1269: #never found the end tag ran out of text, throw error send back blank 1270: &error('Never found end tag for <'.$tag. 1271: '> current string <pre>'. 1272: &HTML::Entities::encode($result,'<>&"'). 1273: '</pre>'); 1274: if ($gotfullstack) { 1275: my $newstring='</'.$tag.'>'.$result; 1276: &Apache::lonxml::newparser($pars,\$newstring); 1277: } 1278: $result=''; 1279: } 1280: } else { 1281: while ($#$pars > -1) { 1282: while ($token = $$pars[-1]->get_token) { 1283: #&Apache::lonxml::debug("s token:$token->[0]:$depth:$token->[1]"); 1284: if (($token->[0] eq 'T')||($token->[0] eq 'C')|| 1285: ($token->[0] eq 'D')) { 1286: if ($token->[2]) { 1287: $result.='<![CDATA['.$token->[1].']]>'; 1288: } else { 1289: $result.=$token->[1]; 1290: } 1291: } elsif ($token->[0] eq 'PI') { 1292: $result.=$token->[2]; 1293: } elsif ($token->[0] eq 'S') { 1294: if ( $token->[1] =~ /^\Q$tag\E$/i) { 1295: $$pars[-1]->unget_token($token); last; 1296: } else { 1297: $result.=$token->[4]; 1298: } 1299: if ($token->[1] =~ /^LONCAPA_INTERNAL_TURN_STYLE_ON$/) { $Apache::lonxml::usestyle=1; } 1300: if ($token->[1] =~ /^LONCAPA_INTERNAL_TURN_STYLE_OFF$/) { $Apache::lonxml::usestyle=0; } 1301: } elsif ($token->[0] eq 'E') { 1302: $result.=$token->[2]; 1303: } 1304: } 1305: if (($#$pars > 0) ) { 1306: pop(@$pars); 1307: pop(@Apache::lonxml::pwd); 1308: } else { last; } 1309: } 1310: } 1311: #&Apache::lonxml::debug("Exit:$result:"); 1312: return $result 1313: } 1314: 1315: sub newparser { 1316: my ($parser,$contentref,$dir) = @_; 1317: push (@$parser,HTML::LCParser->new($contentref)); 1318: $$parser[-1]->xml_mode(1); 1319: $$parser[-1]->marked_sections(1); 1320: if ( $dir eq '' ) { 1321: push (@Apache::lonxml::pwd, $Apache::lonxml::pwd[$#Apache::lonxml::pwd]); 1322: } else { 1323: push (@Apache::lonxml::pwd, $dir); 1324: } 1325: } 1326: 1327: sub parstring { 1328: my ($token) = @_; 1329: my (@vars,@values); 1330: foreach my $attr (@{$token->[3]}) { 1331: if ($attr!~/\W/) { 1332: my $val=$token->[2]->{$attr}; 1333: $val =~ s/([\%\@\\\"\'])/\\$1/g; 1334: $val =~ s/(\$[^\{a-zA-Z_])/\\$1/g; 1335: $val =~ s/(\$)$/\\$1/; 1336: #if ($val =~ m/^[\%\@]/) { $val="\\".$val; } 1337: push(@vars,"\$$attr"); 1338: push(@values,"\"$val\""); 1339: } 1340: } 1341: my $var_init = 1342: (@vars) ? 'my ('.join(',',@vars).') = ('.join(',',@values).');' 1343: : ''; 1344: return $var_init; 1345: } 1346: 1347: sub extlink { 1348: my ($res,$exact)=@_; 1349: if (!$exact) { 1350: $res=&Apache::lonnet::hreflocation($Apache::lonxml::pwd[-1],$res); 1351: } 1352: push(@Apache::lonxml::extlinks,$res); 1353: } 1354: 1355: sub writeallows { 1356: unless ($#extlinks>=0) { return; } 1357: my $thisurl = &Apache::lonnet::clutter(shift); 1358: if ($env{'httpref.'.$thisurl}) { 1359: $thisurl=$env{'httpref.'.$thisurl}; 1360: } 1361: my $thisdir=$thisurl; 1362: $thisdir=~s/\/[^\/]+$//; 1363: my %httpref=(); 1364: foreach (@extlinks) { 1365: $httpref{'httpref.'. 1366: &Apache::lonnet::hreflocation($thisdir,&unescape($_))}=$thisurl; 1367: } 1368: @extlinks=(); 1369: &Apache::lonnet::appenv(\%httpref); 1370: } 1371: 1372: sub register_ssi { 1373: my ($url,%form)=@_; 1374: push (@Apache::lonxml::ssi_info,{'url'=>$url,'form'=>\%form}); 1375: return ''; 1376: } 1377: 1378: sub do_registered_ssi { 1379: foreach my $info (@Apache::lonxml::ssi_info) { 1380: my %form=%{ $info->{'form'}}; 1381: my $url=$info->{'url'}; 1382: &Apache::lonnet::ssi($url,%form); 1383: } 1384: } 1385: 1386: sub add_script_result { 1387: my ($display) = @_; 1388: if ($display ne '') { 1389: push(@script_var_displays, $display); 1390: } 1391: } 1392: 1393: # 1394: # Afterburner handles anchors, highlights and links 1395: # 1396: sub afterburn { 1397: my $result=shift; 1398: &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'}, 1399: ['highlight','anchor','link']); 1400: if ($env{'form.highlight'}) { 1401: foreach (split(/\,/,$env{'form.highlight'})) { 1402: my $anchorname=$_; 1403: my $matchthis=$anchorname; 1404: $matchthis=~s/\_+/\\s\+/g; 1405: $result=~s/(\Q$matchthis\E)/\<font color=\"red\"\>$1\<\/font\>/gs; 1406: } 1407: } 1408: if ($env{'form.link'}) { 1409: foreach (split(/\,/,$env{'form.link'})) { 1410: my ($anchorname,$linkurl)=split(/\>/,$_); 1411: my $matchthis=$anchorname; 1412: $matchthis=~s/\_+/\\s\+/g; 1413: $result=~s/(\Q$matchthis\E)/\<a href=\"$linkurl\"\>$1\<\/a\>/gs; 1414: } 1415: } 1416: if ($env{'form.anchor'}) { 1417: my $anchorname=$env{'form.anchor'}; 1418: my $matchthis=$anchorname; 1419: $matchthis=~s/\_+/\\s\+/g; 1420: $result=~s/(\Q$matchthis\E)/\<a name=\"$anchorname\"\>$1\<\/a\>/s; 1421: $result.=(<<"ENDSCRIPT"); 1422: <script type="text/javascript"> 1423: document.location.hash='$anchorname'; 1424: </script> 1425: ENDSCRIPT 1426: } 1427: return $result; 1428: } 1429: 1430: sub storefile { 1431: my ($file,$contents)=@_; 1432: &Apache::lonnet::correct_line_ends(\$contents); 1433: if (my $fh=Apache::File->new('>'.$file)) { 1434: print $fh $contents; 1435: $fh->close(); 1436: return 1; 1437: } else { 1438: &warning(&mt('Unable to save file [_1]','<tt>'.$file.'</tt>')); 1439: return 0; 1440: } 1441: } 1442: 1443: sub createnewhtml { 1444: my $title=&mt('Title of document goes here'); 1445: my $body=&mt('Body of document goes here'); 1446: my $filecontents=(<<SIMPLECONTENT); 1447: <html> 1448: <head> 1449: <title>$title</title> 1450: </head> 1451: <body bgcolor="#FFFFFF"> 1452: $body 1453: </body> 1454: </html> 1455: SIMPLECONTENT 1456: return $filecontents; 1457: } 1458: 1459: sub createnewsty { 1460: my $filecontents=(<<SIMPLECONTENT); 1461: <definetag name=""> 1462: <render> 1463: <web></web> 1464: <tex></tex> 1465: </render> 1466: </definetag> 1467: SIMPLECONTENT 1468: return $filecontents; 1469: } 1470: 1471: sub createnewjs { 1472: my $filecontents=(<<SIMPLECONTENT); 1473: <script type="text/javascript" language="Javascript"> 1474: 1475: </script> 1476: SIMPLECONTENT 1477: return $filecontents; 1478: } 1479: 1480: sub verify_html { 1481: my ($filecontents)=@_; 1482: my ($is_html,$is_xml,$is_physnet); 1483: if ($filecontents =~/(?:\<|\&lt\;)\?xml[^\<]*\?(?:\>|\&gt\;)/is) { 1484: $is_xml = 1; 1485: } elsif ($filecontents =~/(?:\<|\&lt\;)html(?:\s+[^\<]+|\s*)(?:\>|\&gt\;)/is) { 1486: $is_html = 1; 1487: } elsif ($filecontents =~/(?:\<|\&lt\;)physnet[^\<]*(?:\>|\&gt\;)/is) { 1488: $is_physnet = 1; 1489: } 1490: unless ($is_xml || $is_html || $is_physnet) { 1491: return &mt('File does not have [_1] or [_2] starting tag','<html>','<?xml ?>'); 1492: } 1493: if ($is_html) { 1494: if ($filecontents!~/(?:\<|\&lt\;)\/html(?:\>|\&gt\;)/is) { 1495: return &mt('File does not have [_1] ending tag','<html>'); 1496: } 1497: if ($filecontents!~/(?:\<|\&lt\;)(?:body|frameset)[^\<]*(?:\>|\&gt\;)/is) { 1498: return &mt('File does not have [_1] or [_2] starting tag','<body>','<frameset>'); 1499: } 1500: if ($filecontents!~/(?:\<|\&lt\;)\/(?:body|frameset)[^\<]*(?:\>|\&gt\;)/is) { 1501: return &mt('File does not have [_1] or [_2] ending tag','<body>','<frameset>'); 1502: } 1503: } 1504: return ''; 1505: } 1506: 1507: sub renderingoptions { 1508: my %langchoices=('' => ''); 1509: foreach (&Apache::loncommon::languageids()) { 1510: if (&Apache::loncommon::supportedlanguagecode($_)) { 1511: $langchoices{&Apache::loncommon::supportedlanguagecode($_)} 1512: = &Apache::loncommon::plainlanguagedescription($_); 1513: } 1514: } 1515: my $output; 1516: unless ($env{'form.forceedit'}) { 1517: $output .= 1518: '<span class="LC_nobreak">'. 1519: &mt('Language:').' '. 1520: &Apache::loncommon::select_form( 1521: $env{'form.languages'}, 1522: 'languages', 1523: {&Apache::lonlocal::texthash(%langchoices)}). 1524: '</span>'; 1525: } 1526: $output .= 1527: ' <span class="LC_nobreak">'. 1528: &mt('Math Rendering:').' '. 1529: &Apache::loncommon::select_form( 1530: $env{'form.texengine'}, 1531: 'texengine', 1532: {&Apache::lonlocal::texthash 1533: ('' => '', 1534: 'tth' => 'tth (TeX to HTML)', 1535: 'MathJax' => 'MathJax', 1536: 'mimetex' => 'mimetex (Convert to Images)')}). 1537: '</span>'; 1538: return $output; 1539: } 1540: 1541: sub inserteditinfo { 1542: my ($filecontents,$filetype,$filename,$symb,$itemtitle,$folderpath,$uri,$action) = @_; 1543: $filecontents = &HTML::Entities::encode($filecontents,'<>&"'); 1544: my $xml_help = ''; 1545: my $initialize=''; 1546: my $textarea_id = 'filecont'; 1547: my ($dragmath_button,$deps_button,$context,$cnum,$cdom,$add_to_onload, 1548: $add_to_onresize,$init_dragmath); 1549: $initialize=&Apache::lonhtmlcommon::spellheader(); 1550: if ($filetype eq 'html') { 1551: if ($env{'request.course.id'}) { 1552: $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'}; 1553: $cnum = $env{'course.'.$env{'request.course.id'}.'.num'}; 1554: if ($uri =~ m{^\Q/uploaded/$cdom/$cnum/portfolio/syllabus/\E}) { 1555: $context = 'syllabus'; 1556: } 1557: } 1558: if (&Apache::lonhtmlcommon::htmlareabrowser()) { 1559: my $lang = &Apache::lonhtmlcommon::htmlarea_lang(); 1560: my %textarea_args = ( 1561: fullpage => 'true', 1562: dragmath => 'math', 1563: ); 1564: $initialize .= &Apache::lonhtmlcommon::htmlareaselectactive(\%textarea_args); 1565: if ($context eq 'syllabus') { 1566: $init_dragmath = "editmath_visibility('filecont','none')"; 1567: } 1568: } 1569: } 1570: $initialize .= (<<FULLPAGE); 1571: <script type="text/javascript"> 1572: // <![CDATA[ 1573: function initDocument() { 1574: resize_textarea('$textarea_id','LC_aftertextarea'); 1575: $init_dragmath 1576: } 1577: // ]]> 1578: </script> 1579: FULLPAGE 1580: my $textareaclass; 1581: if ($filetype eq 'html') { 1582: if ($context eq 'syllabus') { 1583: $deps_button = &Apache::lonhtmlcommon::dependencies_button()."\n"; 1584: $initialize .= 1585: &Apache::lonhtmlcommon::dependencycheck_js(undef,&mt('Syllabus'), 1586: $uri,undef, 1587: "/public/$cdom/$cnum/syllabus"). 1588: "\n"; 1589: if (&Apache::lonhtmlcommon::htmlareabrowser()) { 1590: $textareaclass = 'class="LC_richDefaultOn"'; 1591: } 1592: } elsif ($symb || $folderpath) { 1593: $deps_button = &Apache::lonhtmlcommon::dependencies_button()."\n"; 1594: $initialize .= 1595: &Apache::lonhtmlcommon::dependencycheck_js($symb,$itemtitle, 1596: undef,$folderpath,$uri)."\n"; 1597: } 1598: $dragmath_button = '<span id="math_filecont">'.&Apache::lonhtmlcommon::dragmath_button('filecont',1).'</span>'; 1599: $initialize .= "\n".&Apache::lonhtmlcommon::dragmath_js('EditMathPopup'); 1600: } 1601: $add_to_onload = 'initDocument();'; 1602: $add_to_onresize = "resize_textarea('$textarea_id','LC_aftertextarea');"; 1603: 1604: if ($filetype eq 'html') { 1605: my $not_author; 1606: if ($uri =~ m{^/uploaded/}) { 1607: $not_author = 1; 1608: } 1609: $xml_help=&Apache::loncommon::helpLatexCheatsheet(undef,undef,$not_author); 1610: } 1611: 1612: my $titledisplay=&display_title(); 1613: my %lt=&Apache::lonlocal::texthash('st' => 'Save and Edit', 1614: 'vi' => 'Save and View', 1615: 'dv' => 'Discard Edits and View', 1616: 'un' => 'Undo', 1617: 'ed' => 'Edit', 1618: 'ew' => 'Edit with Daxe'); 1619: my $spelllink = &Apache::lonhtmlcommon::spelllink('xmledit','filecont'); 1620: my $textarea_events = &Apache::edit::element_change_detection(); 1621: my $form_events = &Apache::edit::form_change_detection(); 1622: my $htmlerror; 1623: if ($filetype eq 'html') { 1624: $htmlerror=&verify_html($filecontents); 1625: if ($htmlerror) { 1626: $htmlerror=(' 'x3).' <span class="LC_error">'.$htmlerror.'</span>'; 1627: } 1628: if (&Apache::lonhtmlcommon::htmlareabrowser()) { 1629: unless ($textareaclass) { 1630: $textareaclass = 'class="LC_richDefaultOff"'; 1631: } 1632: } 1633: } 1634: my ($undo,$daxebutton,%onclick); 1635: foreach my $item ('discard','undo','daxe') { 1636: $onclick{$item} = 'onclick="still_ask=true;setmode(this.form,'."'$item'".')"'; 1637: } 1638: foreach my $item ('saveedit','saveview') { 1639: $onclick{$item} = 'onclick="is_submit=true;setmode(this.form,'."'$item'".')"'; 1640: } 1641: unless ($uri =~ m{^/uploaded/}) { 1642: $undo = '<input type="button" name="Undo" accesskey="u" value="'.$lt{'un'}.'" '. 1643: $onclick{'undo'}.' />'."\n"; 1644: } 1645: $initialize .= &setmode_javascript(); 1646: if ($filetype eq 'html') { 1647: my %editors = &Apache::loncommon::permitted_editors(); 1648: if ($editors{'daxe'}) { 1649: $daxebutton = '<input type="button" name="editwithdaxe" accesskey="w" value="'.$lt{'ew'}.'" '. 1650: $onclick{'daxe'}.' />'."\n"; 1651: } 1652: } 1653: my $editfooter=(<<ENDFOOTER); 1654: $initialize 1655: <a name="editsection" /> 1656: <form $form_events method="post" name="xmledit" action="$action"> 1657: <input type="hidden" name="problemmode" value="edit" /> 1658: <div class="LC_edit_problem_editxml_header"> 1659: <table class="LC_edit_problem_header_title"><tr><td> 1660: $filename 1661: </td><td align="right"> 1662: $xml_help 1663: </td></tr> 1664: </table> 1665: <div style="float:right"> 1666: <input type="button" name="savethisfile" accesskey="s" value="$lt{'st'}" $onclick{'saveedit'} /> 1667: <input type="button" name="viewmode" accesskey="v" value="$lt{'vi'}" $onclick{'saveview'} /> 1668: </div> 1669: <div> 1670: <input type="button" name="discardview" accesskey="d" value="$lt{'dv'}" $onclick{'discard'} /> 1671: $undo $deps_button $daxebutton $dragmath_button $htmlerror 1672: </div> 1673: </div> 1674: <textarea $textarea_events style="width:100%" cols="80" rows="44" name="filecont" id="filecont" $textareaclass>$filecontents</textarea><br />$spelllink 1675: <div id="LC_aftertextarea"> 1676: <br /> 1677: $titledisplay 1678: </div> 1679: </form> 1680: ENDFOOTER 1681: return ($editfooter,$add_to_onload,$add_to_onresize); 1682: } 1683: 1684: sub setmode_javascript { 1685: return <<"ENDSCRIPT"; 1686: <script type="text/javascript"> 1687: // <![CDATA[ 1688: function setmode(form,probmode) { 1689: if (probmode == 'daxe') { 1690: var url = new URL(document.location.href); 1691: window.location = url.protocol+'//'+url.hostname+'/daxepage'+url.pathname; 1692: } else { 1693: var initial = form.problemmode.value; 1694: form.problemmode.value = probmode; 1695: form.submit(); 1696: form.problemmode.value = initial; 1697: } 1698: } 1699: // ]]> 1700: </script> 1701: ENDSCRIPT 1702: } 1703: 1704: sub seteditor_javascript { 1705: return <<"ENDSCRIPT"; 1706: <script type="text/javascript"> 1707: // <![CDATA[ 1708: function seteditmode(form,editor) { 1709: if (editor == 'daxe') { 1710: var url = new URL(document.location.href); 1711: window.location = url.protocol+'//'+url.hostname+'/daxepage'+url.pathname; 1712: } else { 1713: if (editor == 'edit') { 1714: form.editmode.value = editor; 1715: } else { 1716: form.editmode.value = ''; 1717: } 1718: form.submit(); 1719: } 1720: } 1721: // ]]> 1722: </script> 1723: ENDSCRIPT 1724: } 1725: 1726: sub get_target { 1727: my $viewgrades=&Apache::lonnet::allowed('vgr',$env{'request.course.id'}); 1728: if ( $env{'request.state'} eq 'published') { 1729: if ( defined($env{'form.grade_target'}) 1730: && ($viewgrades == 'F' )) { 1731: return ($env{'form.grade_target'}); 1732: } elsif (defined($env{'form.grade_target'})) { 1733: if (($env{'form.grade_target'} eq 'web') || 1734: ($env{'form.grade_target'} eq 'tex') ) { 1735: return $env{'form.grade_target'} 1736: } else { 1737: return 'web'; 1738: } 1739: } else { 1740: return 'web'; 1741: } 1742: } elsif ($env{'request.state'} eq 'construct') { 1743: if ( defined($env{'form.grade_target'})) { 1744: return ($env{'form.grade_target'}); 1745: } else { 1746: return 'web'; 1747: } 1748: } else { 1749: return 'web'; 1750: } 1751: } 1752: 1753: sub handler { 1754: my $request=shift; 1755: 1756: my $target=&get_target(); 1757: $Apache::lonxml::debug=$env{'user.debug'}; 1758: 1759: &Apache::loncommon::content_type($request,'text/html'); 1760: &Apache::loncommon::no_cache($request); 1761: if ($env{'request.state'} eq 'published') { 1762: $request->set_last_modified(&Apache::lonnet::metadata($request->uri, 1763: 'lastrevisiondate')); 1764: } 1765: # Embedded Flash movies from Camtasia served from https will not display in IE 1766: # if XML config file has expired from cache. 1767: if ($ENV{'SERVER_PORT'} == 443) { 1768: if ($request->uri =~ /\.xml$/) { 1769: my ($httpbrowser,$clientbrowser) = 1770: &Apache::loncommon::decode_user_agent($request); 1771: if ($clientbrowser =~ /^explorer$/i) { 1772: delete $request->headers_out->{'Cache-control'}; 1773: delete $request->headers_out->{'Pragma'}; 1774: my $expiration = time + 60; 1775: my $date=strftime("%a, %d %b %Y %H:%M:%S GMT",gmtime($expiration)); 1776: $request->headers_out->set("Expires" => $date); 1777: } 1778: } 1779: } 1780: $request->send_http_header; 1781: 1782: return OK if $request->header_only; 1783: 1784: 1785: my $file=&Apache::lonnet::filelocation("",$request->uri); 1786: my ($filetype,$breadcrumbtext); 1787: if ($file =~ /\.(sty|css|js|txt|tex)$/) { 1788: $filetype=$1; 1789: } else { 1790: $filetype='html'; 1791: } 1792: unless ($env{'request.uri'}) { 1793: $env{'request.uri'}=$request->uri; 1794: &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'}, 1795: ['todocs']); 1796: } 1797: my ($cdom,$cnum); 1798: if ($env{'request.course.id'}) { 1799: $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'}; 1800: $cnum = $env{'course.'.$env{'request.course.id'}.'.num'}; 1801: if ($filetype eq 'html') { 1802: if ($request->uri =~ m{^\Q/uploaded/$cdom/$cnum/portfolio/syllabus/\E.+$}) { 1803: if (&Apache::lonnet::allowed('mdc',$env{'request.course.id'})) { 1804: &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'}, 1805: ['editmode']); 1806: } 1807: } 1808: } 1809: } 1810: if ($filetype eq 'sty') { 1811: $breadcrumbtext = 'Style File Editor'; 1812: } elsif ($filetype eq 'js') { 1813: $breadcrumbtext = 'Javascript Editor'; 1814: } elsif ($filetype eq 'css') { 1815: $breadcrumbtext = 'CSS Editor'; 1816: } elsif ($filetype eq 'txt') { 1817: $breadcrumbtext = 'Text Editor'; 1818: } elsif ($filetype eq 'tex') { 1819: $breadcrumbtext = 'TeX Editor'; 1820: } else { 1821: $breadcrumbtext = 'HTML Editor'; 1822: } 1823: 1824: # 1825: # Edit action? Save file. 1826: # 1827: if (!($env{'request.state'} eq 'published')) { 1828: if (($env{'form.problemmode'} eq 'saveedit') || 1829: ($env{'form.problemmode'} eq 'saveview') || 1830: ($env{'form.problemmode'} eq 'undo')) { 1831: my $html_file=&Apache::lonnet::getfile($file); 1832: my $error = &Apache::lonhomework::handle_save_or_undo($request, \$html_file, \$env{'form.filecont'}); 1833: if ($env{'form.problemmode'} eq 'saveedit') { 1834: $env{'form.editmode'}='edit'; #force edit mode 1835: } 1836: } 1837: } 1838: my $inhibit_menu; 1839: my %mystyle; 1840: my $result = ''; 1841: my $filecontents=&Apache::lonnet::getfile($file); 1842: if ($filecontents eq -1) { 1843: my $start_page=&Apache::loncommon::start_page('File Error'); 1844: my $end_page=&Apache::loncommon::end_page(); 1845: my $errormsg='<p class="LC_error">' 1846: .&mt('File not found: [_1]' 1847: ,'<span class="LC_filename">'.$file.'</span>') 1848: .'</p>'; 1849: $result=(<<ENDNOTFOUND); 1850: $start_page 1851: $errormsg 1852: $end_page 1853: ENDNOTFOUND 1854: $filecontents=''; 1855: if ($env{'request.state'} ne 'published') { 1856: if ($filetype eq 'sty') { 1857: $filecontents=&createnewsty(); 1858: } elsif ($filetype eq 'js') { 1859: $filecontents=&createnewjs(); 1860: } elsif ($filetype ne 'css' && $filetype ne 'txt' && $filetype ne 'tex') { 1861: $filecontents=&createnewhtml(); 1862: } 1863: $env{'form.editmode'}='edit'; #force edit mode 1864: } 1865: } else { 1866: unless ($env{'request.state'} eq 'published') { 1867: if ($filecontents=~/BEGIN LON-CAPA Internal/) { 1868: &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.')); 1869: } 1870: # 1871: # we are in construction space, see if edit mode forced 1872: &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'}, 1873: ['editmode']); 1874: } 1875: if ((!$env{'form.editmode'}) || 1876: ($env{'form.problemmode'} eq 'saveview') || 1877: ($env{'form.problemmode'} eq 'discard')) { 1878: if ($filetype eq 'html' || $filetype eq 'sty') { 1879: &Apache::structuretags::reset_problem_globals(); 1880: $result = &Apache::lonxml::xmlparse($request,$target, 1881: $filecontents,'',%mystyle); 1882: # .html files may contain <problem> or <Task> need to clean 1883: # up if it did 1884: &Apache::structuretags::reset_problem_globals(); 1885: &Apache::lonhomework::finished_parsing(); 1886: } elsif ($filetype eq 'tex') { 1887: $result = &Apache::lontexconvert::converted(\$filecontents, 1888: $env{'form.texengine'}); 1889: if ($env{'form.return_only_error_and_warning_counts'}) { 1890: $result = "$errorcount:$warningcount"; 1891: } 1892: } else { 1893: $result = $filecontents; 1894: } 1895: &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'}, 1896: ['rawmode']); 1897: if ($env{'form.rawmode'}) { $result = $filecontents; } 1898: if (($env{'request.state'} eq 'construct') && 1899: (($filetype eq 'css') || ($filetype eq 'js')) && ($ENV{'HTTP_REFERER'})) { 1900: if ($ENV{'HTTP_REFERER'} =~ m{^https?\://[^\/]+/priv/$LONCAPA::match_domain/$LONCAPA::match_username/[^\?]+\.(x?html?|swf)(|\?)[^\?]*$}) { 1901: $inhibit_menu = 1; 1902: } 1903: } 1904: if (($filetype ne 'html') && 1905: (!$env{'form.return_only_error_and_warning_counts'}) && 1906: (!$inhibit_menu)) { 1907: my $nochgview = 1; 1908: my $controls = ''; 1909: if ($env{'request.state'} eq 'construct') { 1910: $controls = &Apache::loncommon::head_subbox( 1911: &Apache::loncommon::CSTR_pageheader() 1912: .&Apache::londefdef::edit_controls($nochgview)); 1913: } 1914: if ($filetype ne 'sty' && $filetype ne 'tex') { 1915: $result =~ s/</</g; 1916: $result =~ s/>/>/g; 1917: $result = '<table class="LC_sty_begin">'. 1918: '<tr><td><b><pre>'.$result. 1919: '</pre></b></td></tr></table>'; 1920: } 1921: my $brcrum; 1922: if ($env{'request.state'} eq 'construct') { 1923: my $text = 'Authoring Space'; 1924: my $href = &Apache::loncommon::authorspace($request->uri); 1925: if ($env{'request.course.id'}) { 1926: my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'}; 1927: my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'}; 1928: if ($href eq "/priv/$cdom/$cnum/") { 1929: $text = 'Course Authoring Space'; 1930: } 1931: } 1932: $brcrum = [{'href' => $href, 1933: 'text' => $text,}, 1934: {'href' => '', 1935: 'text' => $breadcrumbtext}]; 1936: } else { 1937: $brcrum = ''; # FIXME: Where are we? 1938: } 1939: my %options = ('bread_crumbs' => $brcrum, 1940: 'bgcolor' => '#FFFFFF'); 1941: $result = 1942: &Apache::loncommon::start_page(undef,undef,\%options) 1943: .$controls 1944: .$result 1945: .&Apache::loncommon::end_page(); 1946: } 1947: } 1948: } 1949: 1950: # 1951: # Edit action? Insert editing commands 1952: # 1953: unless (($env{'request.state'} eq 'published') || ($inhibit_menu)) { 1954: if (($env{'form.editmode'}) && 1955: (!($env{'form.problemmode'} eq 'saveview')) && 1956: (!($env{'form.problemmode'} eq 'discard'))) { 1957: my ($displayfile,$url,$symb,$itemtitle,$action); 1958: $displayfile=$request->uri; 1959: if ($request->uri =~ m{^/uploaded/}) { 1960: if ($env{'request.course.id'}) { 1961: if ($request->uri =~ m{^\Q/uploaded/$cdom/$cnum/supplemental/\E}) { 1962: &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'}, 1963: ['folderpath','title']); 1964: } elsif ($request->uri =~ m{^\Q/uploaded/$cdom/$cnum/portfolio/syllabus/\E(.+)$}) { 1965: my $filename = $1; 1966: if ($1 eq 'loncapa.html') { 1967: $displayfile = &mt('Syllabus (minimal template)'); 1968: $action = $request->uri.'?forceedit=1'; 1969: } else { 1970: $displayfile = &mt('Syllabus file: [_1]',$1); 1971: } 1972: $itemtitle = &mt('Syllabus'); 1973: } 1974: } 1975: unless ($itemtitle) { 1976: ($symb,$itemtitle,$displayfile) = 1977: &get_courseupload_hierarchy($request->uri, 1978: $env{'form.folderpath'}, 1979: $env{'form.title'}); 1980: } 1981: } else { 1982: $displayfile=~s/^\/[^\/]*//; 1983: } 1984: 1985: my ($edit_info, $add_to_onload, $add_to_onresize)= 1986: &inserteditinfo($filecontents,$filetype,$displayfile,$symb, 1987: $itemtitle,$env{'form.folderpath'},$request->uri,$action); 1988: 1989: my %options = 1990: ('add_entries' => 1991: {'onresize' => $add_to_onresize, 1992: 'onload' => $add_to_onload, }); 1993: my $header; 1994: if ($env{'request.state'} eq 'construct') { 1995: my $text = 'Authoring Space'; 1996: my $href = &Apache::loncommon::authorspace($request->uri); 1997: if ($env{'request.course.id'}) { 1998: my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'}; 1999: my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'}; 2000: if ($href eq "/priv/$cdom/$cnum/") { 2001: $text = 'Course Authoring Space'; 2002: } 2003: } 2004: $options{'bread_crumbs'} = [{ 2005: 'href' => $href, 2006: 'text' => $text}, 2007: {'href' => '', 2008: 'text' => $breadcrumbtext}]; 2009: $header = &Apache::loncommon::head_subbox( 2010: &Apache::loncommon::CSTR_pageheader()); 2011: } 2012: my $js = 2013: &Apache::edit::js_change_detection(). 2014: &Apache::loncommon::resize_textarea_js(); 2015: my $start_page = &Apache::loncommon::start_page(undef,$js, 2016: \%options); 2017: $result = $start_page 2018: .$header 2019: .&Apache::lonxml::message_location() 2020: .$edit_info 2021: .&Apache::loncommon::end_page(); 2022: } 2023: } 2024: if ($filetype eq 'html') { &writeallows($request->uri); } 2025: 2026: &Apache::lonxml::add_messages(\$result); 2027: $request->print($result); 2028: 2029: return OK; 2030: } 2031: 2032: sub display_title { 2033: my $result; 2034: if ($env{'request.state'} eq 'construct') { 2035: my $title=&Apache::lonnet::gettitle(); 2036: if (!defined($title) || $title eq '') { 2037: $title = $env{'request.filename'}; 2038: $title = substr($title, rindex($title, '/') + 1); 2039: } 2040: $result = "<script type='text/javascript'>top.document.title = '$title - LON-CAPA " 2041: .&mt('Authoring Space')."';</script>"; 2042: } 2043: return $result; 2044: } 2045: 2046: sub get_courseupload_hierarchy { 2047: my ($url,$folderpath,$title) = @_; 2048: my ($symb,$itemtitle,$displaypath); 2049: if ($env{'request.course.id'}) { 2050: if ($folderpath =~ /^supplemental/) { 2051: my @folders = split(/\&/,$folderpath); 2052: my @pathitems; 2053: while (@folders) { 2054: my $folder=shift(@folders); 2055: my $foldername=shift(@folders); 2056: $foldername =~ s/\:(\d*)\:(\w*)\:(\w*):(\d*)\:?(\d*)$//; 2057: push(@pathitems,&unescape($foldername)); 2058: } 2059: if ($title) { 2060: push(@pathitems,&unescape($title)); 2061: } 2062: $displaypath = join(' » ',@pathitems); 2063: } else { 2064: $symb = &Apache::lonnet::symbread($url); 2065: my ($map,$id,$res)=&Apache::lonnet::decode_symb($symb); 2066: my $navmap=Apache::lonnavmaps::navmap->new; 2067: if (ref($navmap)) { 2068: my $res = $navmap->getBySymb($symb); 2069: if (ref($res)) { 2070: my @pathitems = 2071: &Apache::loncommon::get_folder_hierarchy($navmap,$map,1); 2072: $itemtitle = $res->compTitle(); 2073: push(@pathitems,$itemtitle); 2074: $displaypath = join(' » ',@pathitems); 2075: } 2076: } 2077: } 2078: } 2079: return ($symb,$itemtitle,$displaypath); 2080: } 2081: 2082: sub debug { 2083: if ($Apache::lonxml::debug eq "1") { 2084: $|=1; 2085: my $request=$Apache::lonxml::request; 2086: if (!$request) { 2087: eval { $request=Apache->request; }; 2088: } 2089: if (!$request) { 2090: eval { $request=Apache2::RequestUtil->request; }; 2091: } 2092: $request->print('<font size="-2"><pre>DEBUG:'.&HTML::Entities::encode($_[0],'<>&"')."</pre></font>\n"); 2093: #&Apache::lonnet::logthis($_[0]); 2094: } 2095: } 2096: 2097: sub show_error_warn_msg { 2098: if (($env{'request.filename'} eq 2099: $Apache::lonnet::perlvar{'lonDocRoot'}.'/res/lib/templates/simpleproblem.problem') && 2100: (&Apache::lonnet::allowed('mdc',$env{'request.course.id'}))) { 2101: return 1; 2102: } 2103: return (($Apache::lonxml::debug eq 1) || 2104: ($env{'request.state'} eq 'construct') || 2105: ($Apache::lonhomework::browse eq 'F' 2106: && 2107: $env{'form.show_errors'} eq 'on')); 2108: } 2109: 2110: sub error { 2111: my @errors = @_; 2112: 2113: $errorcount++; 2114: 2115: $Apache::lonxml::internal_error=1; 2116: 2117: if (defined($Apache::inputtags::part)) { 2118: if ( @Apache::inputtags::response ) { 2119: push(@errors, 2120: &mt("This error occurred while processing response [_1] in part [_2]", 2121: $Apache::inputtags::response[-1], 2122: $Apache::inputtags::part)); 2123: } else { 2124: push(@errors, 2125: &mt("This error occurred while processing part [_1]", 2126: $Apache::inputtags::part)); 2127: } 2128: } 2129: 2130: if ( &show_error_warn_msg() ) { 2131: # If printing in construction space, put the error inside <pre></pre> 2132: push(@Apache::lonxml::error_messages, 2133: $Apache::lonxml::warnings_error_header 2134: .'<div class="LC_error">' 2135: .'<b>'.&mt('ERROR:').' </b>'.join("<br />\n",@errors) 2136: ."</div>\n"); 2137: $Apache::lonxml::warnings_error_header=''; 2138: } else { 2139: my $errormsg; 2140: my ($symb)=&Apache::lonnet::symbread(); 2141: if ( !$symb ) { 2142: #public or browsers 2143: $errormsg=&mt("An error occurred while processing this resource. The author has been notified."); 2144: } 2145: my $host=$Apache::lonnet::perlvar{'lonHostID'}; 2146: push(@errors, 2147: &mt("The error occurred on host [_1]", 2148: "<tt>$host</tt>")); 2149: 2150: my $msg = join('<br />', @errors); 2151: 2152: #notify author 2153: &Apache::lonmsg::author_res_msg($env{'request.filename'},$msg); 2154: #notify course 2155: if ( $symb && $env{'request.course.id'} ) { 2156: my $cnum=$env{'course.'.$env{'request.course.id'}.'.num'}; 2157: my $cdom=$env{'course.'.$env{'request.course.id'}.'.domain'}; 2158: my (undef,%users)=&Apache::lonmsg::decide_receiver(undef,0,1,1,1); 2159: my $declutter=&Apache::lonnet::declutter($env{'request.filename'}); 2160: my $baseurl = &Apache::lonnet::clutter($declutter); 2161: my @userlist; 2162: foreach (keys(%users)) { 2163: my ($user,$domain) = split(/:/, $_); 2164: push(@userlist,"$user:$domain"); 2165: my $key=$declutter.'_'.$user.'_'.$domain; 2166: my %lastnotified=&Apache::lonnet::get('nohist_xmlerrornotifications', 2167: [$key], 2168: $cdom,$cnum); 2169: my $now=time; 2170: if ($now-$lastnotified{$key}>86400) { 2171: my $title = &Apache::lonnet::gettitle($symb); 2172: my $sentmessage; 2173: &Apache::lonmsg::user_normal_msg($user,$domain, 2174: "Error [$title]",$msg,'',$baseurl,'','', 2175: \$sentmessage,$symb,$title,1); 2176: &Apache::lonnet::put('nohist_xmlerrornotifications', 2177: {$key => $now}, 2178: $cdom,$cnum); 2179: } 2180: } 2181: if ($env{'request.role.adv'}) { 2182: $errormsg=&mt("An error occurred while processing this resource. The course personnel ([_1]) and the author have been notified.",join(', ',@userlist)); 2183: } else { 2184: $errormsg=&mt("An error occurred while processing this resource. The instructor has been notified."); 2185: } 2186: } 2187: push(@Apache::lonxml::error_messages,"<span class=\"LC_warning\">$errormsg</span><br />"); 2188: } 2189: } 2190: 2191: sub warning { 2192: $warningcount++; 2193: 2194: if ($env{'form.grade_target'} ne 'tex') { 2195: if ( &show_error_warn_msg() ) { 2196: push(@Apache::lonxml::warning_messages, 2197: $Apache::lonxml::warnings_error_header 2198: .'<div class="LC_warning">' 2199: .&mt('[_1]W[_2]ARNING','<b>','</b>')."<b>:</b> ".join('<br />',@_) 2200: ."</div>\n" 2201: ); 2202: $Apache::lonxml::warnings_error_header=''; 2203: } 2204: } 2205: } 2206: 2207: sub info { 2208: if ($env{'form.grade_target'} ne 'tex' 2209: && $env{'request.state'} eq 'construct') { 2210: push(@Apache::lonxml::info_messages,join('<br />',@_)."<br />\n"); 2211: } 2212: } 2213: 2214: sub message_location { 2215: return '__LONCAPA_INTERNAL_MESSAGE_LOCATION__'; 2216: } 2217: 2218: sub add_messages { 2219: my ($msg)=@_; 2220: my $result=join(' ', 2221: @Apache::lonxml::info_messages, 2222: @Apache::lonxml::error_messages, 2223: @Apache::lonxml::warning_messages); 2224: undef(@Apache::lonxml::info_messages); 2225: undef(@Apache::lonxml::error_messages); 2226: undef(@Apache::lonxml::warning_messages); 2227: $$msg=~s/__LONCAPA_INTERNAL_MESSAGE_LOCATION__/$result/; 2228: $$msg=~s/__LONCAPA_INTERNAL_MESSAGE_LOCATION__//g; 2229: } 2230: 2231: sub get_param { 2232: my ($param,$parstack,$safeeval,$context,$case_insensitive, $noelide) = @_; 2233: 2234: if ( ! $context ) { $context = -1; } 2235: my $args =''; 2236: if ( $#$parstack > (-2-$context) ) { $args=$$parstack[$context]; } 2237: if ( ! $Apache::lonxml::usestyle ) { 2238: $args=$Apache::lonxml::style_values.$args; 2239: } 2240: 2241: 2242: if ($noelide) { 2243: # $args =~ s/\\'/'/g; 2244: $args =~ s/'\$/'\\\$/g; 2245: } 2246: 2247: if ( ! $args ) { return undef; } 2248: if ( $case_insensitive ) { 2249: if ($args =~ s/(my (?:.*))(\$\Q$param\E[,\)])/$1.lc($2)/ei) { 2250: 2251: return &Apache::run::run("{$args;".'return $'.$param.'}', 2252: $safeeval); #' 2253: } else { 2254: return undef; 2255: } 2256: } else { 2257: if ( $args =~ /my .*\$\Q$param\E[,\)]/ ) { 2258: 2259: return &Apache::run::run("{$args;".'return $'.$param.'}', 2260: $safeeval); #' 2261: } else { 2262: return undef; 2263: } 2264: } 2265: } 2266: 2267: sub get_param_var { 2268: my ($param,$parstack,$safeeval,$context,$case_insensitive) = @_; 2269: if ( ! $context ) { $context = -1; } 2270: my $args =''; 2271: if ( $#$parstack > (-2-$context) ) { $args=$$parstack[$context]; } 2272: if ( ! $Apache::lonxml::usestyle ) { 2273: $args=$Apache::lonxml::style_values.$args; 2274: } 2275: &Apache::lonxml::debug("Args are $args param is $param"); 2276: if ($case_insensitive) { 2277: if (! ($args=~s/(my (?:.*))(\$\Q$param\E[,\)])/$1.lc($2)/ei)) { 2278: return undef; 2279: } 2280: } elsif ( $args !~ /my .*\$\Q$param\E[,\)]/ ) { return undef; } 2281: my $value=&Apache::run::run("{$args;".'return $'.$param.'}',$safeeval); #' 2282: &Apache::lonxml::debug("first run is $value"); 2283: if ($value =~ /^[\$\@\%][a-zA-Z_]\w*$/) { 2284: &Apache::lonxml::debug("doing second"); 2285: my @result=&Apache::run::run("return $value",$safeeval,1); 2286: if (!defined($result[0])) { 2287: return $value 2288: } else { 2289: if (wantarray) { return @result; } else { return $result[0]; } 2290: } 2291: } else { 2292: return $value; 2293: } 2294: } 2295: 2296: sub register_insert_xml { 2297: my $parser = HTML::LCParser->new($Apache::lonnet::perlvar{'lonTabDir'} 2298: .'/insertlist.xml'); 2299: my ($tagnum,$in_help)=(0,0); 2300: my @alltags; 2301: my $tag; 2302: while (my $token = $parser->get_token()) { 2303: if ($token->[0] eq 'S') { 2304: my $key; 2305: if ($token->[1] eq 'tag') { 2306: $tag = $token->[2]{'name'}; 2307: if (defined($tag)) { 2308: $insertlist{$tagnum.'.tag'} = $tag; 2309: $insertlist{$tag.'.num'} = $tagnum; 2310: push(@alltags,$tag); 2311: } 2312: } elsif ($in_help && $token->[1] eq 'file') { 2313: $key = $tag.'.helpfile'; 2314: } elsif ($in_help && $token->[1] eq 'description') { 2315: $key = $tag.'.helpdesc'; 2316: } elsif ($token->[1] eq 'description' || 2317: $token->[1] eq 'color' || 2318: $token->[1] eq 'show' ) { 2319: $key = $tag.'.'.$token->[1]; 2320: } elsif ($token->[1] eq 'insert_sub') { 2321: $key = $tag.'.function'; 2322: } elsif ($token->[1] eq 'help') { 2323: $in_help=1; 2324: } elsif ($token->[1] eq 'allow') { 2325: $key = $tag.'.allow'; 2326: } 2327: if (defined($key)) { 2328: $insertlist{$key} = $parser->get_text(); 2329: $insertlist{$key} =~ s/(^\s*|\s*$ )//gx; 2330: } 2331: } elsif ($token->[0] eq 'E') { 2332: if ($token->[1] eq 'tag') { 2333: undef($tag); 2334: $tagnum++; 2335: } elsif ($token->[1] eq 'help') { 2336: undef($in_help); 2337: } 2338: } 2339: } 2340: 2341: # parse the allows and ignore tags set to <show>no</show> 2342: foreach my $tag (@alltags) { 2343: next if (!exists($insertlist{$tag.'.allow'})); 2344: my $allow = $insertlist{$tag.'.allow'}; 2345: foreach my $element (split(',',$allow)) { 2346: $element =~ s/(^\s*|\s*$ )//gx; 2347: if (!exists($insertlist{$element.'.show'}) 2348: || $insertlist{$element.'.show'} ne 'no') { 2349: push(@{ $insertlist{$tag.'.which'} },$element); 2350: } 2351: } 2352: } 2353: } 2354: 2355: sub register_insert { 2356: return &register_insert_xml(@_); 2357: # &dump_insertlist('2'); 2358: } 2359: 2360: sub dump_insertlist { 2361: my ($ext) = @_; 2362: open(XML,">","/tmp/insertlist.xml.$ext"); 2363: print XML ("<insertlist>"); 2364: my $i=0; 2365: 2366: while (exists($insertlist{"$i.tag"})) { 2367: my $tag = $insertlist{"$i.tag"}; 2368: print XML (" 2369: \t<tag name=\"$tag\">"); 2370: if (defined($insertlist{"$tag.description"})) { 2371: print XML (" 2372: \t\t<description>".$insertlist{"$tag.description"}."</description>"); 2373: } 2374: if (defined($insertlist{"$tag.color"})) { 2375: print XML (" 2376: \t\t<color>".$insertlist{"$tag.color"}."</color>"); 2377: } 2378: if (defined($insertlist{"$tag.function"})) { 2379: print XML (" 2380: \t\t<insert_sub>".$insertlist{"$tag.function"}."</insert_sub>"); 2381: } 2382: if (defined($insertlist{"$tag.show"}) 2383: && $insertlist{"$tag.show"} ne 'yes') { 2384: print XML (" 2385: \t\t<show>".$insertlist{"$tag.show"}."</show>"); 2386: } 2387: if (defined($insertlist{"$tag.helpfile"})) { 2388: print XML (" 2389: \t\t<help> 2390: \t\t\t<file>".$insertlist{"$tag.helpfile"}."</file>"); 2391: if ($insertlist{"$tag.helpdesc"} ne '') { 2392: print XML (" 2393: \t\t\t<description>".$insertlist{"$tag.helpdesc"}."</description>"); 2394: } 2395: print XML (" 2396: \t\t</help>"); 2397: } 2398: if (defined($insertlist{"$tag.which"})) { 2399: print XML (" 2400: \t\t<allow>".join(',',sort(@{ $insertlist{"$tag.which"} }))."</allow>"); 2401: } 2402: print XML (" 2403: \t</tag>"); 2404: $i++; 2405: } 2406: print XML ("\n</insertlist>\n"); 2407: close(XML); 2408: } 2409: 2410: sub description { 2411: my ($token)=@_; 2412: my $tag = &get_tag($token); 2413: return $insertlist{$tag.'.description'}; 2414: } 2415: 2416: # Returns a list containing the help file, and the description 2417: sub helpinfo { 2418: my ($token)=@_; 2419: my $tag = &get_tag($token); 2420: return ($insertlist{$tag.'.helpfile'}, &mt($insertlist{$tag.'.helpdesc'})); 2421: } 2422: 2423: sub get_tag { 2424: my ($token)=@_; 2425: my $tagnum; 2426: my $tag=$token->[1]; 2427: foreach my $namespace (reverse(@Apache::lonxml::namespace)) { 2428: my $testtag = $namespace.'::'.$tag; 2429: $tagnum = $insertlist{"$testtag.num"}; 2430: last if (defined($tagnum)); 2431: } 2432: if (!defined($tagnum)) { 2433: $tagnum = $Apache::lonxml::insertlist{"$tag.num"}; 2434: } 2435: return $insertlist{"$tagnum.tag"}; 2436: } 2437: 2438: ############################################################ 2439: # PDF-FORM-METHODS 2440: 2441: =pod 2442: 2443: =item &print_pdf_radiobutton(fieldname, value) 2444: 2445: Returns a latexline to generate a PDF-Form-Radiobutton. 2446: Note: Radiobuttons with equal names are automaticly grouped 2447: in a selection-group. 2448: 2449: $fieldname: PDF internalname of the radiobutton(group) 2450: $value: Value of radiobutton 2451: 2452: =cut 2453: sub print_pdf_radiobutton { 2454: my ($fieldname, $value) = @_; 2455: return '\radioButton[\symbolchoice{circle}]{' 2456: .$fieldname.'}{10bp}{10bp}{'.$value.'}'; 2457: } 2458: 2459: 2460: =pod 2461: 2462: =item &print_pdf_start_combobox(fieldname) 2463: 2464: Starts a latexline to generate a PDF-Form-Combobox with text. 2465: 2466: $fieldname: PDF internal name of the Combobox 2467: 2468: =cut 2469: sub print_pdf_start_combobox { 2470: my $result; 2471: my ($fieldName) = @_; 2472: $result .= '\begin{tabularx}{\textwidth}{p{2.5cm}X}'."\n"; 2473: $result .= '\comboBox[]{'.$fieldName.'}{2.3cm}{14bp}{'; # 2474: 2475: return $result; 2476: } 2477: 2478: 2479: =pod 2480: 2481: =item &print_pdf_add_combobox_option(options) 2482: 2483: Generates a latexline to add Options to a PDF-Form-ComboBox. 2484: 2485: $option: PDF internal name of the Combobox-Option 2486: 2487: =cut 2488: sub print_pdf_add_combobox_option { 2489: 2490: my $result; 2491: my ($option) = @_; 2492: 2493: $result .= '('.$option.')'; 2494: 2495: return $result; 2496: } 2497: 2498: 2499: =pod 2500: 2501: =item &print_pdf_end_combobox(text) { 2502: 2503: Returns latexcode to end a PDF-Form-Combobox with text. 2504: 2505: =cut 2506: sub print_pdf_end_combobox { 2507: my $result; 2508: my ($text) = @_; 2509: 2510: $result .= '}&'.$text."\\\\\n"; 2511: $result .= '\end{tabularx}' . "\n"; 2512: $result .= '\hspace{2mm}' . "\n"; 2513: return $result; 2514: } 2515: 2516: 2517: =pod 2518: 2519: =item &print_pdf_hiddenField(fieldname, user, domain) 2520: 2521: Returns a latexline to generate a PDF-Form-hiddenField with userdata. 2522: 2523: $fieldname label for hiddentextfield 2524: $user: name of user 2525: $domain: domain of user 2526: 2527: =cut 2528: sub print_pdf_hiddenfield { 2529: my $result; 2530: my ($fieldname, $user, $domain) = @_; 2531: 2532: $result .= '\textField [\F{\FHidden}\F{-\FPrint}\V{'.$domain.'&'.$user.'}]{'.$fieldname.'}{0in}{0in}'."\n"; 2533: 2534: return $result; 2535: } 2536: 2537: 1; 2538: __END__ 2539: