loncom/xml/lonxml.pm - view

File: [LON-CAPA] / loncom / xml / lonxml.pm
Revision 1.554: download - view: text, annotated - select for diffs
Fri Apr 17 12:34:12 2015 UTC (9 years, 1 month ago) by droeschl
Branches: MAIN
CVS tags: HEAD

Changes related to editors in authoring space.
- moved several menu related subroutines from structuretags to lonhomework
- typos, wording and German translation
- menu structure (xml editor): merged graphical and advanced sections into miscellaneous
- replaced the template menu by separate menus for each submenu
- adjusted styles and structure of the actionbar

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