loncom/xml/lonxml.pm - view

File: [LON-CAPA] / loncom / xml / lonxml.pm
Revision 1.502: download - view: text, annotated - select for diffs
Mon Nov 30 21:29:41 2009 UTC (14 years, 5 months ago) by raeburn
Branches: MAIN
CVS tags: HEAD

- Breadcrumbs displayed in standard location when displaying or editing
  .txt, .js, .css or .tex files in Construction Space.
- Use different anem for editor in breadcrumb trail depending on type of file.
- Bug 4936
  - Can edit .tex files in Construction Space.

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