Annotation of loncom/xml/lonxml.pm, revision 1.78
1.2 sakharuk 1: # The LearningOnline Network with CAPA
1.3 sakharuk 2: # XML Parser Module
1.2 sakharuk 3: #
1.3 sakharuk 4: # last modified 06/26/00 by Alexander Sakharuk
1.33 www 5: # 11/6 Gerd Kortemeyer
1.45 www 6: # 6/1/1 Gerd Kortemeyer
1.56 albertel 7: # 2/21,3/13 Guy
1.68 www 8: # 3/29,5/4 Gerd Kortemeyer
1.73 harris41 9: # 5/10 Scott Harrison
1.78 ! www 10: # 5/26 Gerd Kortemeyer
1.2 sakharuk 11:
1.4 albertel 12: package Apache::lonxml;
1.33 www 13: use vars
1.76 albertel 14: qw(@pwd @outputstack $redirection $import @extlinks $metamode $evaluate %insertlist @namespace);
1.1 sakharuk 15: use strict;
16: use HTML::TokeParser;
1.3 sakharuk 17: use Safe;
1.40 albertel 18: use Safe::Hole;
1.13 albertel 19: use Opcode;
1.72 albertel 20:
21: sub register {
22: my $space;
23: my @taglist;
24: my $temptag;
25: ($space,@taglist) = @_;
26: foreach $temptag (@taglist) {
27: $Apache::lonxml::alltags{$temptag}=$space;
28: }
29: }
30:
1.46 www 31: use Apache::Constants qw(:common);
1.71 www 32: use Apache::lontexconvert;
1.72 albertel 33: use Apache::style;
34: use Apache::run;
35: use Apache::londefdef;
36: use Apache::scripttag;
37: use Apache::edit;
38: #================================================== Main subroutine: xmlparse
39: #debugging control, to turn on debugging modify the correct handler
40: $Apache::lonxml::debug=0;
41:
42: #path to the directory containing the file currently being processed
43: @pwd=();
44:
45: #these two are used for capturing a subset of the output for later processing,
46: #don't touch them directly use &startredirection and &endredirection
47: @outputstack = ();
48: $redirection = 0;
49:
50: #controls wheter the <import> tag actually does
51: $import = 1;
52: @extlinks=();
53:
54: # meta mode is a bit weird only some output is to be turned off
55: #<output> tag turns metamode off (defined in londefdef.pm)
56: $metamode = 0;
57:
58: # turns on and of run::evaluate actually derefencing var refs
59: $evaluate = 1;
1.7 albertel 60:
1.74 albertel 61: # data structure for eidt mode, determines what tags can go into what other tags
62: %insertlist=();
1.68 www 63:
1.76 albertel 64: #stores the list of active tag namespaces
65: @namespace=();
66:
1.68 www 67: sub xmlbegin {
68: my $output='';
69: if ($ENV{'browser.mathml'}) {
70: $output='<?xml version="1.0"?>'
71: .'<?xml-stylesheet type="text/css" href="/adm/MathML/mathml.css"?>'
72: .'<!DOCTYPE html SYSTEM "/adm/MathML/mathml.dtd" '
73: .'[<!ENTITY mathns "http://www.w3.org/1998/Math/MathML">]>'
74: .'<html xmlns:math="http://www.w3.org/1998/Math/MathML" '
75: .'xmlns="http://www.w3.org/TR/REC-html40">';
76: } else {
77: $output='<html>';
78: }
79: return $output;
80: }
81:
82: sub xmlend {
83: return '</html>';
84: }
85:
1.70 www 86: sub fontsettings() {
87: my $headerstring='';
88: if (($ENV{'browser.os'} eq 'mac') && (!$ENV{'browser.mathml'})) {
89: $headerstring.=
90: '<meta Content-Type="text/html; charset=x-mac-roman">';
91: }
92: return $headerstring;
93: }
94:
1.68 www 95: sub registerurl {
96: return (<<ENDSCRIPT);
97: <script language="JavaScript">
1.71 www 98: // BEGIN LON-CAPA Internal
1.69 www 99: function LONCAPAreg() {
100: if (window.location.pathname!="/res/adm/pages/menu.html") {
101: menu=window.open("","LONCAPAmenu");
102: menu.currentURL=window.location.pathname;
103: menu.currentStale=0;
104: }
105: }
106:
107: function LONCAPAstale() {
108: if (window.location.pathname!="/res/adm/pages/menu.html") {
109: menu=window.open("","LONCAPAmenu");
110: menu.currentStale=1;
111: }
1.68 www 112: }
1.71 www 113: // END LON-CAPA Internal
1.68 www 114: </script>
115: ENDSCRIPT
1.69 www 116: }
117:
118: sub loadevents() {
119: return 'LONCAPAreg();';
120: }
121:
122: sub unloadevents() {
123: return 'LONCAPAstale();';
1.68 www 124: }
125:
1.48 albertel 126: sub printalltags {
127: my $temp;
128: foreach $temp (sort keys %Apache::lonxml::alltags) {
1.64 albertel 129: &Apache::lonxml::debug("$temp -- $Apache::lonxml::alltags{$temp}");
1.48 albertel 130: }
131: }
1.31 sakharuk 132:
1.3 sakharuk 133: sub xmlparse {
134:
1.18 albertel 135: my ($target,$content_file_string,$safeinit,%style_for_target) = @_;
1.41 albertel 136: if ($target eq 'meta') {
1.59 albertel 137: $Apache::lonxml::redirection = 0;
138: $Apache::lonxml::metamode = 1;
1.72 albertel 139: $Apache::lonxml::evaluate = 1;
1.55 albertel 140: $Apache::lonxml::import = 0;
1.47 albertel 141: } elsif ($target eq 'grade') {
1.55 albertel 142: &startredirection;
1.59 albertel 143: $Apache::lonxml::metamode = 0;
1.72 albertel 144: $Apache::lonxml::evaluate = 1;
1.55 albertel 145: $Apache::lonxml::import = 1;
1.72 albertel 146: } elsif ($target eq 'modified') {
147: $Apache::lonxml::redirection = 0;
148: $Apache::lonxml::metamode = 0;
149: $Apache::lonxml::evaluate = 0;
150: $Apache::lonxml::import = 0;
1.44 albertel 151: } else {
1.72 albertel 152: $Apache::lonxml::redirection = 0;
1.59 albertel 153: $Apache::lonxml::metamode = 0;
1.72 albertel 154: $Apache::lonxml::evaluate = 1;
1.55 albertel 155: $Apache::lonxml::import = 1;
1.32 sakharuk 156: }
1.48 albertel 157: #&printalltags();
1.16 albertel 158: my @pars = ();
1.23 albertel 159: @Apache::lonxml::pwd=();
160: my $pwd=$ENV{'request.filename'};
161: $pwd =~ s:/[^/]*$::;
162: &newparser(\@pars,\$content_file_string,$pwd);
1.3 sakharuk 163: my $currentstring = '';
164: my $finaloutput = '';
165: my $newarg = '';
1.16 albertel 166: my $result;
1.24 sakharuk 167:
1.3 sakharuk 168: my $safeeval = new Safe;
1.40 albertel 169: my $safehole = new Safe::Hole;
1.6 albertel 170: $safeeval->permit("entereval");
1.13 albertel 171: $safeeval->permit(":base_math");
1.77 www 172: $safeeval->permit("sort");
1.19 albertel 173: $safeeval->deny(":base_io");
1.40 albertel 174: $safehole->wrap(\&Apache::lonnet::EXT,$safeeval,'&EXT');
1.19 albertel 175: #need to inspect this class of ops
176: # $safeeval->deny(":base_orig");
1.21 albertel 177: $safeinit .= ';$external::target='.$target.';';
1.26 albertel 178: $safeinit .= ';$external::randomseed='.&Apache::lonnet::rndseed().';';
1.21 albertel 179: &Apache::run::run($safeinit,$safeeval);
1.3 sakharuk 180: #-------------------- Redefinition of the target in the case of compound target
181:
182: ($target, my @tenta) = split('&&',$target);
183:
184: my @stack = ();
185: my @parstack = ();
1.17 albertel 186: &initdepth;
1.3 sakharuk 187: my $token;
1.16 albertel 188: while ( $#pars > -1 ) {
189: while ($token = $pars[$#pars]->get_token) {
1.57 albertel 190: if (($token->[0] eq 'T') || ($token->[0] eq 'C') || ($token->[0] eq 'D') ) {
1.61 albertel 191: if ($metamode<1) { $result=$token->[1]; }
1.57 albertel 192: } elsif ($token->[0] eq 'PI') {
1.61 albertel 193: if ($metamode<1) { $result=$token->[2]; }
1.16 albertel 194: } elsif ($token->[0] eq 'S') {
195: # add tag to stack
196: push (@stack,$token->[1]);
197: # add parameters list to another stack
198: push (@parstack,&parstring($token));
1.19 albertel 199: &increasedepth($token);
1.16 albertel 200: if (exists $style_for_target{$token->[1]}) {
1.61 albertel 201: if ($Apache::lonxml::redirection) {
1.55 albertel 202: $Apache::lonxml::outputstack['-1'] .=
203: &recurse($style_for_target{$token->[1]},$target,$safeeval,
204: \%style_for_target,@parstack);
1.41 albertel 205: } else {
1.55 albertel 206: $finaloutput .= &recurse($style_for_target{$token->[1]},$target,
207: $safeeval,\%style_for_target,@parstack);
1.41 albertel 208: }
1.16 albertel 209: } else {
1.17 albertel 210: $result = &callsub("start_$token->[1]", $target, $token,\@parstack,
1.41 albertel 211: \@pars, $safeeval, \%style_for_target);
1.16 albertel 212: }
213: } elsif ($token->[0] eq 'E') {
214: #clear out any tags that didn't end
1.55 albertel 215: while ($token->[1] ne $stack[$#stack] && ($#stack > -1)) {
216: &Apache::lonxml::warning("Unbalanced tags in resource $stack['-1']");
1.43 albertel 217: pop @stack;pop @parstack;&decreasedepth($token);
218: }
1.16 albertel 219:
220: if (exists $style_for_target{'/'."$token->[1]"}) {
1.61 albertel 221: if ($Apache::lonxml::redirection) {
1.55 albertel 222: $Apache::lonxml::outputstack['-1'] .=
223: &recurse($style_for_target{'/'."$token->[1]"},
224: $target,$safeeval,\%style_for_target,@parstack);
225: } else {
226: $finaloutput .= &recurse($style_for_target{'/'."$token->[1]"},
227: $target,$safeeval,\%style_for_target,
228: @parstack);
229: }
1.59 albertel 230:
1.16 albertel 231: } else {
1.17 albertel 232: $result = &callsub("end_$token->[1]", $target, $token, \@parstack,
1.55 albertel 233: \@pars,$safeeval, \%style_for_target);
1.13 albertel 234: }
1.57 albertel 235: } else {
236: &Apache::lonxml::error("Unknown token event :$token->[0]:$token->[1]:");
1.16 albertel 237: }
1.55 albertel 238: #evaluate variable refs in result
1.25 sakharuk 239: if ($result ne "") {
1.24 sakharuk 240: if ( $#parstack > -1 ) {
1.55 albertel 241: if ($Apache::lonxml::redirection) {
242: $Apache::lonxml::outputstack['-1'] .=
243: &Apache::run::evaluate($result,$safeeval,$parstack[$#parstack]);
244: } else {
245: $finaloutput .= &Apache::run::evaluate($result,$safeeval,
246: $parstack[$#parstack]);
247: }
1.16 albertel 248: } else {
249: $finaloutput .= &Apache::run::evaluate($result,$safeeval,'');
1.13 albertel 250: }
1.16 albertel 251: $result = '';
1.55 albertel 252: }
253: if ($token->[0] eq 'E') {
254: pop @stack;pop @parstack;&decreasedepth($token);
1.2 sakharuk 255: }
1.5 albertel 256: }
1.16 albertel 257: pop @pars;
1.23 albertel 258: pop @Apache::lonxml::pwd;
1.3 sakharuk 259: }
1.24 sakharuk 260:
1.59 albertel 261: # if ($target eq 'meta') {
262: # $finaloutput.=&endredirection;
263: # }
1.67 www 264:
265: if (($ENV{'QUERY_STRING'}) && ($target eq 'web')) {
266: $finaloutput=&afterburn($finaloutput);
267: }
268:
1.3 sakharuk 269: return $finaloutput;
1.15 albertel 270: }
271:
1.67 www 272:
1.15 albertel 273: sub recurse {
274:
275: my @innerstack = ();
276: my @innerparstack = ();
277: my ($newarg,$target,$safeeval,$style_for_target,@parstack) = @_;
1.16 albertel 278: my @pat = ();
1.23 albertel 279: &newparser(\@pat,\$newarg);
1.15 albertel 280: my $tokenpat;
281: my $partstring = '';
282: my $output='';
1.16 albertel 283: my $decls='';
284: while ( $#pat > -1 ) {
285: while ($tokenpat = $pat[$#pat]->get_token) {
1.57 albertel 286: if (($tokenpat->[0] eq 'T') || ($tokenpat->[0] eq 'C') || ($tokenpat->[0] eq 'D') ) {
1.61 albertel 287: if ($metamode<1) { $partstring=$tokenpat->[1]; }
1.57 albertel 288: } elsif ($tokenpat->[0] eq 'PI') {
1.61 albertel 289: if ($metamode<1) { $partstring=$tokenpat->[2]; }
1.16 albertel 290: } elsif ($tokenpat->[0] eq 'S') {
291: push (@innerstack,$tokenpat->[1]);
292: push (@innerparstack,&parstring($tokenpat));
1.19 albertel 293: &increasedepth($tokenpat);
1.16 albertel 294: $partstring = &callsub("start_$tokenpat->[1]",
295: $target, $tokenpat, \@innerparstack,
296: \@pat, $safeeval, $style_for_target);
297: } elsif ($tokenpat->[0] eq 'E') {
298: #clear out any tags that didn't end
299: while ($tokenpat->[1] ne $innerstack[$#innerstack]
1.43 albertel 300: && ($#innerstack > -1)) {
1.49 albertel 301: &Apache::lonxml::warning("Unbalanced tags in resource $innerstack['-1']");
1.43 albertel 302: pop @innerstack;pop @innerparstack;&decreasedepth($tokenpat);
303: }
1.16 albertel 304: $partstring = &callsub("end_$tokenpat->[1]",
305: $target, $tokenpat, \@innerparstack,
306: \@pat, $safeeval, $style_for_target);
1.57 albertel 307: } else {
308: &Apache::lonxml::error("Unknown token event :$tokenpat->[0]:$tokenpat->[1]:");
1.16 albertel 309: }
310: #pass both the variable to the style tag, and the tag we
311: #are processing inside the <definedtag>
312: if ( $partstring ne "" ) {
313: if ( $#parstack > -1 ) {
314: if ( $#innerparstack > -1 ) {
315: $decls= $parstack[$#parstack].$innerparstack[$#innerparstack];
316: } else {
317: $decls= $parstack[$#parstack];
318: }
319: } else {
320: if ( $#innerparstack > -1 ) {
321: $decls=$innerparstack[$#innerparstack];
322: } else {
323: $decls='';
324: }
325: }
326: $output .= &Apache::run::evaluate($partstring,$safeeval,$decls);
327: $partstring = '';
328: }
1.17 albertel 329: if ($tokenpat->[0] eq 'E') { pop @innerstack;pop @innerparstack;
1.19 albertel 330: &decreasedepth($tokenpat);}
1.15 albertel 331: }
1.16 albertel 332: pop @pat;
1.23 albertel 333: pop @Apache::lonxml::pwd;
1.15 albertel 334: }
335: return $output;
1.7 albertel 336: }
337:
338: sub callsub {
1.14 albertel 339: my ($sub,$target,$token,$parstack,$parser,$safeeval,$style)=@_;
1.7 albertel 340: my $currentstring='';
1.72 albertel 341: my $nodefault;
1.7 albertel 342: {
1.59 albertel 343: my $sub1;
1.7 albertel 344: no strict 'refs';
1.59 albertel 345: if ($target eq 'edit' && $token->[0] eq 'S') {
346: $currentstring = &Apache::edit::tag_start($target,$token,$parstack,$parser,
347: $safeeval,$style);
348: }
1.68 www 349: my $tag=$token->[1];
350: my $space=$Apache::lonxml::alltags{$tag};
351: if (!$space) {
352: $tag=~tr/A-Z/a-z/;
353: $sub=~tr/A-Z/a-z/;
354: $space=$Apache::lonxml::alltags{$tag}
355: }
356: if ($space) {
1.72 albertel 357: #&Apache::lonxml::debug("Calling sub $sub in $space $metamode<br />\n");
1.24 sakharuk 358: $sub1="$space\:\:$sub";
1.17 albertel 359: $Apache::lonxml::curdepth=join('_',@Apache::lonxml::depthcounter);
1.72 albertel 360: ($currentstring,$nodefault) = &$sub1($target,$token,$parstack,$parser,
361: $safeeval,$style);
1.7 albertel 362: } else {
1.72 albertel 363: #&Apache::lonxml::debug("NOT Calling sub $sub in $space $metamode<br />\n");
1.62 sakharuk 364: if ($metamode <1) {
365: if (defined($token->[4]) && ($metamode < 1)) {
1.72 albertel 366: $currentstring = $token->[4];
1.62 sakharuk 367: } else {
1.72 albertel 368: $currentstring = $token->[2];
1.62 sakharuk 369: }
1.7 albertel 370: }
1.59 albertel 371: }
1.72 albertel 372: &Apache::lonxml::debug("nodefalt:$nodefault:");
373: if ($currentstring eq '' && $nodefault eq '') {
374: if ($target eq 'edit') {
1.74 albertel 375: &Apache::lonxml::debug("doing default edit for $token->[1]");
1.72 albertel 376: if ($token->[0] eq 'S') {
1.74 albertel 377: $currentstring = &Apache::edit::tag_start($target,$token);
1.72 albertel 378: } elsif ($token->[0] eq 'E') {
1.74 albertel 379: $currentstring = &Apache::edit::tag_end($target,$token);
1.72 albertel 380: }
381: } elsif ($target eq 'modified') {
382: if ($token->[0] eq 'S') {
383: $currentstring = $token->[4];
1.76 albertel 384: $currentstring.=&Apache::edit::handle_insert();
1.72 albertel 385: } else {
386: $currentstring = $token->[2];
387: }
388: }
1.7 albertel 389: }
390: use strict 'refs';
391: }
392: return $currentstring;
1.17 albertel 393: }
394:
1.55 albertel 395: sub startredirection {
396: $Apache::lonxml::redirection++;
397: push (@Apache::lonxml::outputstack, '');
398: }
399:
400: sub endredirection {
401: if (!$Apache::lonxml::redirection) {
1.72 albertel 402: &Apache::lonxml::error("Endredirection was called, before a startredirection, perhaps you have unbalanced tags. Some debuging information:".join ":",caller);
1.55 albertel 403: return '';
404: }
405: $Apache::lonxml::redirection--;
406: pop @Apache::lonxml::outputstack;
407: }
408:
1.17 albertel 409: sub initdepth {
410: @Apache::lonxml::depthcounter=();
411: $Apache::lonxml::depth=-1;
412: $Apache::lonxml::olddepth=-1;
413: }
414:
415: sub increasedepth {
1.19 albertel 416: my ($token) = @_;
1.17 albertel 417: $Apache::lonxml::depth++;
418: $Apache::lonxml::depthcounter[$Apache::lonxml::depth]++;
419: if ($Apache::lonxml::depthcounter[$Apache::lonxml::depth]==1) {
420: $Apache::lonxml::olddepth=$Apache::lonxml::depth;
421: }
1.42 albertel 422: my $curdepth=join('_',@Apache::lonxml::depthcounter);
1.64 albertel 423: &Apache::lonxml::debug("s $Apache::lonxml::depth : $Apache::lonxml::olddepth : $curdepth : $token->[1]\n");
1.54 albertel 424: #print "<br />s $Apache::lonxml::depth : $Apache::lonxml::olddepth : $curdepth : $token->[1]\n";
1.17 albertel 425: }
426:
427: sub decreasedepth {
1.19 albertel 428: my ($token) = @_;
1.17 albertel 429: $Apache::lonxml::depth--;
1.36 albertel 430: if ($Apache::lonxml::depth<$Apache::lonxml::olddepth-1) {
431: $#Apache::lonxml::depthcounter--;
432: $Apache::lonxml::olddepth=$Apache::lonxml::depth+1;
433: }
1.43 albertel 434: if ( $Apache::lonxml::depth < -1) {
1.49 albertel 435: &Apache::lonxml::warning("Unbalanced tags in resource");
1.43 albertel 436: $Apache::lonxml::depth='-1';
437: }
1.42 albertel 438: my $curdepth=join('_',@Apache::lonxml::depthcounter);
1.64 albertel 439: &Apache::lonxml::debug("e $Apache::lonxml::depth : $Apache::lonxml::olddepth : $token->[1] : $curdepth\n");
1.54 albertel 440: #print "<br />e $Apache::lonxml::depth : $Apache::lonxml::olddepth : $token->[1] : $curdepth\n";
1.1 sakharuk 441: }
1.19 albertel 442:
443: sub get_all_text {
444:
445: my($tag,$pars)= @_;
446: my $depth=0;
447: my $token;
448: my $result='';
1.57 albertel 449: if ( $tag =~ m:^/: ) {
450: my $tag=substr($tag,1);
451: # &Apache::lonxml::debug("have:$tag:");
452: while (($depth >=0) && ($token = $pars->get_token)) {
453: # &Apache::lonxml::debug("e token:$token->[0]:$depth:$token->[1]");
454: if (($token->[0] eq 'T')||($token->[0] eq 'C')||($token->[0] eq 'D')) {
455: $result.=$token->[1];
456: } elsif ($token->[0] eq 'PI') {
457: $result.=$token->[2];
458: } elsif ($token->[0] eq 'S') {
459: if ($token->[1] eq $tag) { $depth++; }
460: $result.=$token->[4];
461: } elsif ($token->[0] eq 'E') {
462: if ( $token->[1] eq $tag) { $depth--; }
463: #skip sending back the last end tag
464: if ($depth > -1) { $result.=$token->[2]; } else {
465: $pars->unget_token($token);
466: }
467: }
468: }
469: } else {
470: while ($token = $pars->get_token) {
471: # &Apache::lonxml::debug("s token:$token->[0]:$depth:$token->[1]");
472: if (($token->[0] eq 'T')||($token->[0] eq 'C')||($token->[0] eq 'D')) {
473: $result.=$token->[1];
474: } elsif ($token->[0] eq 'PI') {
475: $result.=$token->[2];
476: } elsif ($token->[0] eq 'S') {
477: if ( $token->[1] eq $tag) {
478: $pars->unget_token($token); last;
479: } else {
480: $result.=$token->[4];
481: }
482: } elsif ($token->[0] eq 'E') {
483: $result.=$token->[2];
1.36 albertel 484: }
1.19 albertel 485: }
486: }
1.49 albertel 487: # &Apache::lonxml::debug("Exit:$result:");
1.19 albertel 488: return $result
489: }
490:
1.23 albertel 491: sub newparser {
492: my ($parser,$contentref,$dir) = @_;
493: push (@$parser,HTML::TokeParser->new($contentref));
1.56 albertel 494: $$parser['-1']->xml_mode('1');
1.23 albertel 495: if ( $dir eq '' ) {
496: push (@Apache::lonxml::pwd, $Apache::lonxml::pwd[$#Apache::lonxml::pwd]);
497: } else {
498: push (@Apache::lonxml::pwd, $dir);
499: }
500: # &Apache::lonxml::debug("pwd:$#Apache::lonxml::pwd");
501: # &Apache::lonxml::debug("pwd:$Apache::lonxml::pwd[$#Apache::lonxml::pwd]");
502: }
1.1 sakharuk 503:
1.8 albertel 504: sub parstring {
505: my ($token) = @_;
506: my $temp='';
1.20 albertel 507: map {
1.35 www 508: unless ($_=~/\W/) {
1.42 albertel 509: my $val=$token->[2]->{$_};
1.53 albertel 510: $val =~ s/([\%\@\\])/\\$1/g;
1.51 albertel 511: #if ($val =~ m/^[\%\@]/) { $val="\\".$val; }
1.42 albertel 512: $temp .= "my \$$_=\"$val\";"
1.20 albertel 513: }
514: } @{$token->[3]};
1.8 albertel 515: return $temp;
516: }
1.22 albertel 517:
1.34 www 518: sub writeallows {
519: my $thisurl='/res/'.&Apache::lonnet::declutter(shift);
520: my $thisdir=$thisurl;
521: $thisdir=~s/\/[^\/]+$//;
522: my %httpref=();
523: map {
524: $httpref{'httpref.'.
525: &Apache::lonnet::hreflocation($thisdir,$_)}=$thisurl; } @extlinks;
526: &Apache::lonnet::appenv(%httpref);
527: }
528:
1.66 www 529: #
530: # Afterburner handles anchors, highlights and links
531: #
532: sub afterburn {
533: my $result=shift;
534: map {
535: my ($name, $value) = split(/=/,$_);
536: $value =~ tr/+/ /;
537: $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
538: if (($name eq 'highlight')||($name eq 'anchor')||($name eq 'link')) {
539: unless ($ENV{'form.'.$name}) {
540: $ENV{'form.'.$name}=$value;
541: }
542: }
543: } (split(/&/,$ENV{'QUERY_STRING'}));
544: if ($ENV{'form.highlight'}) {
545: map {
546: my $anchorname=$_;
547: my $matchthis=$anchorname;
548: $matchthis=~s/\_+/\\s\+/g;
549: $result=~s/($matchthis)/\<font color=\"red\"\>$1\<\/font\>/gs;
550: } split(/\,/,$ENV{'form.highlight'});
551: }
552: if ($ENV{'form.link'}) {
553: map {
554: my ($anchorname,$linkurl)=split(/\>/,$_);
555: my $matchthis=$anchorname;
556: $matchthis=~s/\_+/\\s\+/g;
557: $result=~s/($matchthis)/\<a href=\"$linkurl\"\>$1\<\/a\>/gs;
558: } split(/\,/,$ENV{'form.link'});
559: }
560: if ($ENV{'form.anchor'}) {
561: my $anchorname=$ENV{'form.anchor'};
562: my $matchthis=$anchorname;
563: $matchthis=~s/\_+/\\s\+/g;
564: $result=~s/($matchthis)/\<a name=\"$anchorname\"\>$1\<\/a\>/s;
565: $result.=(<<"ENDSCRIPT");
566: <script>
567: document.location.hash='$anchorname';
568: </script>
569: ENDSCRIPT
570: }
571: return $result;
572: }
573:
1.78 ! www 574: sub inserteditinfo {
! 575: my ($result,$filecontents)=@_;
! 576: unless ($filecontents) {
! 577: $filecontents=(<<SIMPLECONTENT);
! 578: <html>
! 579: <head>
! 580: <title>
! 581: Title of Document Goes Here
! 582: </title>
! 583: </head>
! 584: <body bgcolor="#FFFFFF">
! 585:
! 586: Body of Document Goes Here
! 587:
! 588: </body>
! 589: </html>
! 590: SIMPLECONTENT
! 591: }
! 592: my $editheader='<a href="#editsection">Edit below</a><hr />';
! 593: my $editfooter=(<<ENDFOOTER);
! 594: <hr />
! 595: <a name="editsection" />
! 596: <form method="post">
! 597: <textarea cols="80" rows="40" name="filecont">$filecontents</textarea>
! 598: <br />
! 599: <input type="submit" name="savethisfile" value="Save this file" />
! 600: </form>
! 601: ENDFOOTER
! 602: $result=~s/(\<body[^\>]*\>)/$1$editheader/is;
! 603: $result=~s/(\<\/body\>)/$editfooter/is;
! 604: return $result;
! 605: }
! 606:
1.24 sakharuk 607: sub handler {
608: my $request=shift;
1.68 www 609:
1.64 albertel 610: my $target='web';
1.68 www 611:
1.65 albertel 612: $Apache::lonxml::debug=0;
1.68 www 613:
1.25 sakharuk 614: if ($ENV{'browser.mathml'}) {
1.27 albertel 615: $request->content_type('text/xml');
616: } else {
617: $request->content_type('text/html');
1.25 sakharuk 618: }
1.64 albertel 619:
1.27 albertel 620: $request->send_http_header;
1.64 albertel 621:
1.45 www 622: return OK if $request->header_only;
1.27 albertel 623:
1.78 ! www 624: #
! 625: # Edit action? Save file.
! 626: #
! 627: unless ($ENV{'request.state'} eq 'published') {
! 628: if ($ENV{'form.savethisfile'}) {
! 629:
! 630: }
! 631: }
1.27 albertel 632:
1.50 albertel 633: my $file=&Apache::lonnet::filelocation("",$request->uri);
1.24 sakharuk 634: my %mystyle;
1.50 albertel 635: my $result = '';
636: my $filecontents=&Apache::lonnet::getfile($file);
637: if ($filecontents == -1) {
1.78 ! www 638: $result=(<<ENDNOTFOUND);
! 639: <html>
! 640: <head>
! 641: <title>File not found</title>
! 642: </head>
! 643: <body bgcolor="#FFFFFF">
! 644: <b>File not found: $file</b>
! 645: </body>
! 646: </html>
! 647: ENDNOTFOUND
1.50 albertel 648: $filecontents='';
649: } else {
650: $result = &Apache::lonxml::xmlparse($target,$filecontents,'',%mystyle);
1.78 ! www 651: }
! 652:
! 653: #
! 654: # Edit action? Insert editing commands
! 655: #
! 656: unless ($ENV{'request.state'} eq 'published') {
! 657: $result=&inserteditinfo($result,$filecontents);
1.66 www 658: }
1.50 albertel 659:
1.67 www 660: $request->print($result);
1.64 albertel 661:
1.34 www 662: writeallows($request->uri);
1.45 www 663: return OK;
1.24 sakharuk 664: }
665:
1.22 albertel 666: sub debug {
667: if ($Apache::lonxml::debug eq 1) {
1.54 albertel 668: print "DEBUG:".$_[0]."<br />\n";
1.22 albertel 669: }
670: }
1.49 albertel 671:
1.22 albertel 672: sub error {
1.74 albertel 673: if (($Apache::lonxml::debug eq 1) || ($ENV{'request.state'} eq 'construct') ) {
1.55 albertel 674: print "<b>ERROR:</b>".$_[0]."<br />\n";
1.52 albertel 675: } else {
676: print "<b>An Error occured while processing this resource. The instructor has been notified.</b> <br />";
677: #notify author
678: &Apache::lonmsg::author_res_msg($ENV{'request.filename'},$_[0]);
679: #notify course
680: if ( $ENV{'request.course.id'} ) {
681: my $users=$ENV{'course.'.$ENV{'request.course.id'}.'.comment.email'};
682: foreach my $user (split /\,/, $users) {
683: ($user,my $domain) = split /:/, $user;
1.54 albertel 684: &Apache::lonmsg::user_normal_msg($user,$domain,"Error in $ENV{'request.filename'}",$_[0]);
1.52 albertel 685: }
686: }
1.74 albertel 687:
1.52 albertel 688: #FIXME probably shouldn't have me get everything forever.
1.54 albertel 689: &Apache::lonmsg::user_normal_msg('albertel','msu',"Error in $ENV{'request.filename'}",$_[0]);
1.74 albertel 690: #&Apache::lonmsg::user_normal_msg('albertel','103',"Error in $ENV{'request.filename'}",$_[0]);
1.52 albertel 691: }
1.22 albertel 692: }
1.49 albertel 693:
1.22 albertel 694: sub warning {
1.73 harris41 695: if ($ENV{'request.state'} eq 'construct') {
1.55 albertel 696: print "<b>W</b>ARNING<b>:</b>".$_[0]."<br />\n";
1.73 harris41 697: }
1.22 albertel 698: }
699:
1.74 albertel 700: sub register_insert {
1.75 albertel 701: my @data = split /\n/, &Apache::lonnet::getfile('/home/httpd/lonTabs/insertlist.tab');
1.74 albertel 702: my $i;
1.76 albertel 703: my $tagnum=0;
1.74 albertel 704: my @order;
705: for ($i=0;$i < $#data; $i++) {
706: my $line = $data[$i];
707: if ( $line =~ /^\#/ || $line =~ /^\s*\n/) { next; }
708: if ( $line =~ /TABLE/ ) { last; }
709: my ($tag,$descrip,$function,$show) = split(/,/, $line);
1.76 albertel 710: $insertlist{"$tagnum.tag"} = $tag;
711: $insertlist{"$tagnum.description"} = $descrip;
712: $insertlist{"$tagnum.function"} = $function;
713: $insertlist{"$tagnum.show"}= $show;
714: $tagnum++;
1.74 albertel 715: }
1.76 albertel 716: $i++; #skipping TABLE line
717: $tagnum = 0;
1.74 albertel 718: for (;$i < $#data;$i++) {
719: my $line = $data[$i];
1.76 albertel 720: my ($mnemonic,@which) = split(/ +/,$line);
721: my $tag = $insertlist{"$tagnum.tag"};
1.74 albertel 722: for (my $j=0;$j <$#which;$j++) {
723: if ( $which[$j] eq 'Y' ) {
1.76 albertel 724: if ($insertlist{"$j.show"} ne 'no') {
725: push(@{ $insertlist{"$tag.which"} },$j);
726: }
1.74 albertel 727: }
728: }
1.76 albertel 729: $tagnum++;
1.74 albertel 730: }
731: }
1.1 sakharuk 732: 1;
733: __END__
1.68 www 734:
735:
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/back.gif){kind=icon}
Return to lonxml.pm CVS log ![[TXT]](/icons/text.gif){kind=icon}
![[DIR]](/icons/dir.gif){kind=icon}
Up to [LON-CAPA] / loncom / xml