Annotation of loncom/xml/lonxml.pm, revision 1.71
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.2 sakharuk 9:
1.4 albertel 10: package Apache::lonxml;
1.33 www 11: use vars
1.60 albertel 12: qw(@pwd @outputstack $redirection $import @extlinks $metamode);
1.1 sakharuk 13: use strict;
14: use HTML::TokeParser;
1.3 sakharuk 15: use Safe;
1.40 albertel 16: use Safe::Hole;
1.13 albertel 17: use Opcode;
1.46 www 18: use Apache::Constants qw(:common);
1.71 ! www 19: use Apache::lontexconvert;
1.7 albertel 20:
1.68 www 21:
22: sub xmlbegin {
23: my $output='';
24: if ($ENV{'browser.mathml'}) {
25: $output='<?xml version="1.0"?>'
26: .'<?xml-stylesheet type="text/css" href="/adm/MathML/mathml.css"?>'
27: .'<!DOCTYPE html SYSTEM "/adm/MathML/mathml.dtd" '
28: .'[<!ENTITY mathns "http://www.w3.org/1998/Math/MathML">]>'
29: .'<html xmlns:math="http://www.w3.org/1998/Math/MathML" '
30: .'xmlns="http://www.w3.org/TR/REC-html40">';
31: } else {
32: $output='<html>';
33: }
34: return $output;
35: }
36:
37: sub xmlend {
38: return '</html>';
39: }
40:
1.70 www 41: sub fontsettings() {
42: my $headerstring='';
43: if (($ENV{'browser.os'} eq 'mac') && (!$ENV{'browser.mathml'})) {
44: $headerstring.=
45: '<meta Content-Type="text/html; charset=x-mac-roman">';
46: }
47: return $headerstring;
48: }
49:
1.68 www 50: sub registerurl {
51: return (<<ENDSCRIPT);
52: <script language="JavaScript">
1.71 ! www 53: // BEGIN LON-CAPA Internal
1.69 www 54: function LONCAPAreg() {
55: if (window.location.pathname!="/res/adm/pages/menu.html") {
56: menu=window.open("","LONCAPAmenu");
57: menu.currentURL=window.location.pathname;
58: menu.currentStale=0;
59: }
60: }
61:
62: function LONCAPAstale() {
63: if (window.location.pathname!="/res/adm/pages/menu.html") {
64: menu=window.open("","LONCAPAmenu");
65: menu.currentStale=1;
66: }
1.68 www 67: }
1.71 ! www 68: // END LON-CAPA Internal
1.68 www 69: </script>
70: ENDSCRIPT
1.69 www 71: }
72:
73: sub loadevents() {
74: return 'LONCAPAreg();';
75: }
76:
77: sub unloadevents() {
78: return 'LONCAPAstale();';
1.68 www 79: }
80:
1.7 albertel 81: sub register {
82: my $space;
83: my @taglist;
84: my $temptag;
85: ($space,@taglist) = @_;
86: foreach $temptag (@taglist) {
87: $Apache::lonxml::alltags{$temptag}=$space;
88: }
89: }
1.48 albertel 90:
91: sub printalltags {
92: my $temp;
93: foreach $temp (sort keys %Apache::lonxml::alltags) {
1.64 albertel 94: &Apache::lonxml::debug("$temp -- $Apache::lonxml::alltags{$temp}");
1.48 albertel 95: }
96: }
1.4 albertel 97: use Apache::style;
1.7 albertel 98: use Apache::run;
1.4 albertel 99: use Apache::londefdef;
1.7 albertel 100: use Apache::scripttag;
1.59 albertel 101: use Apache::edit;
1.3 sakharuk 102: #================================================== Main subroutine: xmlparse
1.33 www 103: @pwd=();
1.55 albertel 104: @outputstack = ();
105: $redirection = 0;
106: $import = 1;
1.33 www 107: @extlinks=();
1.59 albertel 108: $metamode = 0;
1.31 sakharuk 109:
1.3 sakharuk 110: sub xmlparse {
111:
1.18 albertel 112: my ($target,$content_file_string,$safeinit,%style_for_target) = @_;
1.41 albertel 113: if ($target eq 'meta') {
1.59 albertel 114: # meta mode is a bit weird only some output is to be turned off
1.60 albertel 115: #<output> tag turns metamode off (defined in londefdef.pm)
1.59 albertel 116: $Apache::lonxml::redirection = 0;
117: $Apache::lonxml::metamode = 1;
1.55 albertel 118: $Apache::lonxml::import = 0;
1.47 albertel 119: } elsif ($target eq 'grade') {
1.55 albertel 120: &startredirection;
1.59 albertel 121: $Apache::lonxml::metamode = 0;
1.55 albertel 122: $Apache::lonxml::import = 1;
1.44 albertel 123: } else {
1.59 albertel 124: $Apache::lonxml::metamode = 0;
1.55 albertel 125: $Apache::lonxml::redirection = 0;
126: $Apache::lonxml::import = 1;
1.32 sakharuk 127: }
1.48 albertel 128: #&printalltags();
1.16 albertel 129: my @pars = ();
1.23 albertel 130: @Apache::lonxml::pwd=();
131: my $pwd=$ENV{'request.filename'};
132: $pwd =~ s:/[^/]*$::;
133: &newparser(\@pars,\$content_file_string,$pwd);
1.3 sakharuk 134: my $currentstring = '';
135: my $finaloutput = '';
136: my $newarg = '';
1.16 albertel 137: my $result;
1.24 sakharuk 138:
1.3 sakharuk 139: my $safeeval = new Safe;
1.40 albertel 140: my $safehole = new Safe::Hole;
1.6 albertel 141: $safeeval->permit("entereval");
1.13 albertel 142: $safeeval->permit(":base_math");
1.19 albertel 143: $safeeval->deny(":base_io");
1.40 albertel 144: $safehole->wrap(\&Apache::lonnet::EXT,$safeeval,'&EXT');
1.19 albertel 145: #need to inspect this class of ops
146: # $safeeval->deny(":base_orig");
1.21 albertel 147: $safeinit .= ';$external::target='.$target.';';
1.26 albertel 148: $safeinit .= ';$external::randomseed='.&Apache::lonnet::rndseed().';';
1.21 albertel 149: &Apache::run::run($safeinit,$safeeval);
1.3 sakharuk 150: #-------------------- Redefinition of the target in the case of compound target
151:
152: ($target, my @tenta) = split('&&',$target);
153:
154: my @stack = ();
155: my @parstack = ();
1.17 albertel 156: &initdepth;
1.3 sakharuk 157: my $token;
1.16 albertel 158: while ( $#pars > -1 ) {
159: while ($token = $pars[$#pars]->get_token) {
1.57 albertel 160: if (($token->[0] eq 'T') || ($token->[0] eq 'C') || ($token->[0] eq 'D') ) {
1.61 albertel 161: if ($metamode<1) { $result=$token->[1]; }
1.57 albertel 162: } elsif ($token->[0] eq 'PI') {
1.61 albertel 163: if ($metamode<1) { $result=$token->[2]; }
1.16 albertel 164: } elsif ($token->[0] eq 'S') {
165: # add tag to stack
166: push (@stack,$token->[1]);
167: # add parameters list to another stack
168: push (@parstack,&parstring($token));
1.19 albertel 169: &increasedepth($token);
1.16 albertel 170: if (exists $style_for_target{$token->[1]}) {
1.61 albertel 171: if ($Apache::lonxml::redirection) {
1.55 albertel 172: $Apache::lonxml::outputstack['-1'] .=
173: &recurse($style_for_target{$token->[1]},$target,$safeeval,
174: \%style_for_target,@parstack);
1.41 albertel 175: } else {
1.55 albertel 176: $finaloutput .= &recurse($style_for_target{$token->[1]},$target,
177: $safeeval,\%style_for_target,@parstack);
1.41 albertel 178: }
1.16 albertel 179: } else {
1.17 albertel 180: $result = &callsub("start_$token->[1]", $target, $token,\@parstack,
1.41 albertel 181: \@pars, $safeeval, \%style_for_target);
1.16 albertel 182: }
183: } elsif ($token->[0] eq 'E') {
184: #clear out any tags that didn't end
1.55 albertel 185: while ($token->[1] ne $stack[$#stack] && ($#stack > -1)) {
186: &Apache::lonxml::warning("Unbalanced tags in resource $stack['-1']");
1.43 albertel 187: pop @stack;pop @parstack;&decreasedepth($token);
188: }
1.16 albertel 189:
190: if (exists $style_for_target{'/'."$token->[1]"}) {
1.61 albertel 191: if ($Apache::lonxml::redirection) {
1.55 albertel 192: $Apache::lonxml::outputstack['-1'] .=
193: &recurse($style_for_target{'/'."$token->[1]"},
194: $target,$safeeval,\%style_for_target,@parstack);
195: } else {
196: $finaloutput .= &recurse($style_for_target{'/'."$token->[1]"},
197: $target,$safeeval,\%style_for_target,
198: @parstack);
199: }
1.59 albertel 200:
1.16 albertel 201: } else {
1.17 albertel 202: $result = &callsub("end_$token->[1]", $target, $token, \@parstack,
1.55 albertel 203: \@pars,$safeeval, \%style_for_target);
1.13 albertel 204: }
1.57 albertel 205: } else {
206: &Apache::lonxml::error("Unknown token event :$token->[0]:$token->[1]:");
1.16 albertel 207: }
1.55 albertel 208: #evaluate variable refs in result
1.25 sakharuk 209: if ($result ne "") {
1.24 sakharuk 210: if ( $#parstack > -1 ) {
1.55 albertel 211: if ($Apache::lonxml::redirection) {
212: $Apache::lonxml::outputstack['-1'] .=
213: &Apache::run::evaluate($result,$safeeval,$parstack[$#parstack]);
214: } else {
215: $finaloutput .= &Apache::run::evaluate($result,$safeeval,
216: $parstack[$#parstack]);
217: }
1.16 albertel 218: } else {
219: $finaloutput .= &Apache::run::evaluate($result,$safeeval,'');
1.13 albertel 220: }
1.16 albertel 221: $result = '';
1.55 albertel 222: }
223: if ($token->[0] eq 'E') {
224: pop @stack;pop @parstack;&decreasedepth($token);
1.2 sakharuk 225: }
1.5 albertel 226: }
1.16 albertel 227: pop @pars;
1.23 albertel 228: pop @Apache::lonxml::pwd;
1.3 sakharuk 229: }
1.24 sakharuk 230:
1.59 albertel 231: # if ($target eq 'meta') {
232: # $finaloutput.=&endredirection;
233: # }
1.67 www 234:
235: if (($ENV{'QUERY_STRING'}) && ($target eq 'web')) {
236: $finaloutput=&afterburn($finaloutput);
237: }
238:
1.3 sakharuk 239: return $finaloutput;
1.15 albertel 240: }
241:
1.67 www 242:
1.15 albertel 243: sub recurse {
244:
245: my @innerstack = ();
246: my @innerparstack = ();
247: my ($newarg,$target,$safeeval,$style_for_target,@parstack) = @_;
1.16 albertel 248: my @pat = ();
1.23 albertel 249: &newparser(\@pat,\$newarg);
1.15 albertel 250: my $tokenpat;
251: my $partstring = '';
252: my $output='';
1.16 albertel 253: my $decls='';
254: while ( $#pat > -1 ) {
255: while ($tokenpat = $pat[$#pat]->get_token) {
1.57 albertel 256: if (($tokenpat->[0] eq 'T') || ($tokenpat->[0] eq 'C') || ($tokenpat->[0] eq 'D') ) {
1.61 albertel 257: if ($metamode<1) { $partstring=$tokenpat->[1]; }
1.57 albertel 258: } elsif ($tokenpat->[0] eq 'PI') {
1.61 albertel 259: if ($metamode<1) { $partstring=$tokenpat->[2]; }
1.16 albertel 260: } elsif ($tokenpat->[0] eq 'S') {
261: push (@innerstack,$tokenpat->[1]);
262: push (@innerparstack,&parstring($tokenpat));
1.19 albertel 263: &increasedepth($tokenpat);
1.16 albertel 264: $partstring = &callsub("start_$tokenpat->[1]",
265: $target, $tokenpat, \@innerparstack,
266: \@pat, $safeeval, $style_for_target);
267: } elsif ($tokenpat->[0] eq 'E') {
268: #clear out any tags that didn't end
269: while ($tokenpat->[1] ne $innerstack[$#innerstack]
1.43 albertel 270: && ($#innerstack > -1)) {
1.49 albertel 271: &Apache::lonxml::warning("Unbalanced tags in resource $innerstack['-1']");
1.43 albertel 272: pop @innerstack;pop @innerparstack;&decreasedepth($tokenpat);
273: }
1.16 albertel 274: $partstring = &callsub("end_$tokenpat->[1]",
275: $target, $tokenpat, \@innerparstack,
276: \@pat, $safeeval, $style_for_target);
1.57 albertel 277: } else {
278: &Apache::lonxml::error("Unknown token event :$tokenpat->[0]:$tokenpat->[1]:");
1.16 albertel 279: }
280: #pass both the variable to the style tag, and the tag we
281: #are processing inside the <definedtag>
282: if ( $partstring ne "" ) {
283: if ( $#parstack > -1 ) {
284: if ( $#innerparstack > -1 ) {
285: $decls= $parstack[$#parstack].$innerparstack[$#innerparstack];
286: } else {
287: $decls= $parstack[$#parstack];
288: }
289: } else {
290: if ( $#innerparstack > -1 ) {
291: $decls=$innerparstack[$#innerparstack];
292: } else {
293: $decls='';
294: }
295: }
296: $output .= &Apache::run::evaluate($partstring,$safeeval,$decls);
297: $partstring = '';
298: }
1.17 albertel 299: if ($tokenpat->[0] eq 'E') { pop @innerstack;pop @innerparstack;
1.19 albertel 300: &decreasedepth($tokenpat);}
1.15 albertel 301: }
1.16 albertel 302: pop @pat;
1.23 albertel 303: pop @Apache::lonxml::pwd;
1.15 albertel 304: }
305: return $output;
1.7 albertel 306: }
307:
308: sub callsub {
1.14 albertel 309: my ($sub,$target,$token,$parstack,$parser,$safeeval,$style)=@_;
1.7 albertel 310: my $currentstring='';
311: {
1.59 albertel 312: my $sub1;
1.7 albertel 313: no strict 'refs';
1.59 albertel 314: if ($target eq 'edit' && $token->[0] eq 'S') {
315: $currentstring = &Apache::edit::tag_start($target,$token,$parstack,$parser,
316: $safeeval,$style);
317: }
1.68 www 318: my $tag=$token->[1];
319: my $space=$Apache::lonxml::alltags{$tag};
320: if (!$space) {
321: $tag=~tr/A-Z/a-z/;
322: $sub=~tr/A-Z/a-z/;
323: $space=$Apache::lonxml::alltags{$tag}
324: }
325: if ($space) {
326: &Apache::lonxml::debug("Calling sub $sub in $space $metamode<br />\n");
1.24 sakharuk 327: $sub1="$space\:\:$sub";
1.17 albertel 328: $Apache::lonxml::curdepth=join('_',@Apache::lonxml::depthcounter);
1.59 albertel 329: $currentstring .= &$sub1($target,$token,$parstack,$parser,
1.16 albertel 330: $safeeval,$style);
1.7 albertel 331: } else {
1.68 www 332: &Apache::lonxml::debug("NOT Calling sub $sub in $space $metamode<br />\n");
1.62 sakharuk 333: if ($metamode <1) {
334: if (defined($token->[4]) && ($metamode < 1)) {
335: $currentstring .= $token->[4];
336: } else {
337: $currentstring .= $token->[2];
338: }
1.7 albertel 339: }
1.59 albertel 340: }
341: if ($target eq 'edit' && $token->[0] eq 'E') {
1.61 albertel 342: $currentstring .= &Apache::edit::tag_end($target,$token,$parstack,$parser,
1.59 albertel 343: $safeeval,$style);
1.7 albertel 344: }
345: use strict 'refs';
346: }
347: return $currentstring;
1.17 albertel 348: }
349:
1.55 albertel 350: sub startredirection {
351: $Apache::lonxml::redirection++;
352: push (@Apache::lonxml::outputstack, '');
353: }
354:
355: sub endredirection {
356: if (!$Apache::lonxml::redirection) {
357: &Apache::lonxml::error("Endredirection was called, before a startredirection, perhaps you have unbalanced tags. Some debuggin information:".join ":",caller);
358: return '';
359: }
360: $Apache::lonxml::redirection--;
361: pop @Apache::lonxml::outputstack;
362: }
363:
1.17 albertel 364: sub initdepth {
365: @Apache::lonxml::depthcounter=();
366: $Apache::lonxml::depth=-1;
367: $Apache::lonxml::olddepth=-1;
368: }
369:
370: sub increasedepth {
1.19 albertel 371: my ($token) = @_;
1.17 albertel 372: $Apache::lonxml::depth++;
373: $Apache::lonxml::depthcounter[$Apache::lonxml::depth]++;
374: if ($Apache::lonxml::depthcounter[$Apache::lonxml::depth]==1) {
375: $Apache::lonxml::olddepth=$Apache::lonxml::depth;
376: }
1.42 albertel 377: my $curdepth=join('_',@Apache::lonxml::depthcounter);
1.64 albertel 378: &Apache::lonxml::debug("s $Apache::lonxml::depth : $Apache::lonxml::olddepth : $curdepth : $token->[1]\n");
1.54 albertel 379: #print "<br />s $Apache::lonxml::depth : $Apache::lonxml::olddepth : $curdepth : $token->[1]\n";
1.17 albertel 380: }
381:
382: sub decreasedepth {
1.19 albertel 383: my ($token) = @_;
1.17 albertel 384: $Apache::lonxml::depth--;
1.36 albertel 385: if ($Apache::lonxml::depth<$Apache::lonxml::olddepth-1) {
386: $#Apache::lonxml::depthcounter--;
387: $Apache::lonxml::olddepth=$Apache::lonxml::depth+1;
388: }
1.43 albertel 389: if ( $Apache::lonxml::depth < -1) {
1.49 albertel 390: &Apache::lonxml::warning("Unbalanced tags in resource");
1.43 albertel 391: $Apache::lonxml::depth='-1';
392: }
1.42 albertel 393: my $curdepth=join('_',@Apache::lonxml::depthcounter);
1.64 albertel 394: &Apache::lonxml::debug("e $Apache::lonxml::depth : $Apache::lonxml::olddepth : $token->[1] : $curdepth\n");
1.54 albertel 395: #print "<br />e $Apache::lonxml::depth : $Apache::lonxml::olddepth : $token->[1] : $curdepth\n";
1.1 sakharuk 396: }
1.19 albertel 397:
398: sub get_all_text {
399:
400: my($tag,$pars)= @_;
401: my $depth=0;
402: my $token;
403: my $result='';
1.57 albertel 404: if ( $tag =~ m:^/: ) {
405: my $tag=substr($tag,1);
406: # &Apache::lonxml::debug("have:$tag:");
407: while (($depth >=0) && ($token = $pars->get_token)) {
408: # &Apache::lonxml::debug("e token:$token->[0]:$depth:$token->[1]");
409: if (($token->[0] eq 'T')||($token->[0] eq 'C')||($token->[0] eq 'D')) {
410: $result.=$token->[1];
411: } elsif ($token->[0] eq 'PI') {
412: $result.=$token->[2];
413: } elsif ($token->[0] eq 'S') {
414: if ($token->[1] eq $tag) { $depth++; }
415: $result.=$token->[4];
416: } elsif ($token->[0] eq 'E') {
417: if ( $token->[1] eq $tag) { $depth--; }
418: #skip sending back the last end tag
419: if ($depth > -1) { $result.=$token->[2]; } else {
420: $pars->unget_token($token);
421: }
422: }
423: }
424: } else {
425: while ($token = $pars->get_token) {
426: # &Apache::lonxml::debug("s token:$token->[0]:$depth:$token->[1]");
427: if (($token->[0] eq 'T')||($token->[0] eq 'C')||($token->[0] eq 'D')) {
428: $result.=$token->[1];
429: } elsif ($token->[0] eq 'PI') {
430: $result.=$token->[2];
431: } elsif ($token->[0] eq 'S') {
432: if ( $token->[1] eq $tag) {
433: $pars->unget_token($token); last;
434: } else {
435: $result.=$token->[4];
436: }
437: } elsif ($token->[0] eq 'E') {
438: $result.=$token->[2];
1.36 albertel 439: }
1.19 albertel 440: }
441: }
1.49 albertel 442: # &Apache::lonxml::debug("Exit:$result:");
1.19 albertel 443: return $result
444: }
445:
1.23 albertel 446: sub newparser {
447: my ($parser,$contentref,$dir) = @_;
448: push (@$parser,HTML::TokeParser->new($contentref));
1.56 albertel 449: $$parser['-1']->xml_mode('1');
1.23 albertel 450: if ( $dir eq '' ) {
451: push (@Apache::lonxml::pwd, $Apache::lonxml::pwd[$#Apache::lonxml::pwd]);
452: } else {
453: push (@Apache::lonxml::pwd, $dir);
454: }
455: # &Apache::lonxml::debug("pwd:$#Apache::lonxml::pwd");
456: # &Apache::lonxml::debug("pwd:$Apache::lonxml::pwd[$#Apache::lonxml::pwd]");
457: }
1.1 sakharuk 458:
1.8 albertel 459: sub parstring {
460: my ($token) = @_;
461: my $temp='';
1.20 albertel 462: map {
1.35 www 463: unless ($_=~/\W/) {
1.42 albertel 464: my $val=$token->[2]->{$_};
1.53 albertel 465: $val =~ s/([\%\@\\])/\\$1/g;
1.51 albertel 466: #if ($val =~ m/^[\%\@]/) { $val="\\".$val; }
1.42 albertel 467: $temp .= "my \$$_=\"$val\";"
1.20 albertel 468: }
469: } @{$token->[3]};
1.8 albertel 470: return $temp;
471: }
1.22 albertel 472:
1.34 www 473: sub writeallows {
474: my $thisurl='/res/'.&Apache::lonnet::declutter(shift);
475: my $thisdir=$thisurl;
476: $thisdir=~s/\/[^\/]+$//;
477: my %httpref=();
478: map {
479: $httpref{'httpref.'.
480: &Apache::lonnet::hreflocation($thisdir,$_)}=$thisurl; } @extlinks;
481: &Apache::lonnet::appenv(%httpref);
482: }
483:
1.66 www 484: #
485: # Afterburner handles anchors, highlights and links
486: #
487:
488: sub afterburn {
489: my $result=shift;
490: map {
491: my ($name, $value) = split(/=/,$_);
492: $value =~ tr/+/ /;
493: $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
494: if (($name eq 'highlight')||($name eq 'anchor')||($name eq 'link')) {
495: unless ($ENV{'form.'.$name}) {
496: $ENV{'form.'.$name}=$value;
497: }
498: }
499: } (split(/&/,$ENV{'QUERY_STRING'}));
500: if ($ENV{'form.highlight'}) {
501: map {
502: my $anchorname=$_;
503: my $matchthis=$anchorname;
504: $matchthis=~s/\_+/\\s\+/g;
505: $result=~s/($matchthis)/\<font color=\"red\"\>$1\<\/font\>/gs;
506: } split(/\,/,$ENV{'form.highlight'});
507: }
508: if ($ENV{'form.link'}) {
509: map {
510: my ($anchorname,$linkurl)=split(/\>/,$_);
511: my $matchthis=$anchorname;
512: $matchthis=~s/\_+/\\s\+/g;
513: $result=~s/($matchthis)/\<a href=\"$linkurl\"\>$1\<\/a\>/gs;
514: } split(/\,/,$ENV{'form.link'});
515: }
516: if ($ENV{'form.anchor'}) {
517: my $anchorname=$ENV{'form.anchor'};
518: my $matchthis=$anchorname;
519: $matchthis=~s/\_+/\\s\+/g;
520: $result=~s/($matchthis)/\<a name=\"$anchorname\"\>$1\<\/a\>/s;
521: $result.=(<<"ENDSCRIPT");
522: <script>
523: document.location.hash='$anchorname';
524: </script>
525: ENDSCRIPT
526: }
527: return $result;
528: }
529:
1.24 sakharuk 530: sub handler {
531: my $request=shift;
1.68 www 532:
1.64 albertel 533: my $target='web';
1.68 www 534:
1.65 albertel 535: $Apache::lonxml::debug=0;
1.68 www 536:
1.25 sakharuk 537: if ($ENV{'browser.mathml'}) {
1.27 albertel 538: $request->content_type('text/xml');
539: } else {
540: $request->content_type('text/html');
1.25 sakharuk 541: }
1.64 albertel 542:
1.29 sakharuk 543: # $request->print(<<ENDHEADER);
544: #<html>
545: #<head>
546: #<title>Just test</title>
547: #</head>
548: #<body bgcolor="#FFFFFF">
549: #ENDHEADER
550: # &Apache::lonhomework::send_header($request);
1.27 albertel 551: $request->send_http_header;
1.64 albertel 552:
1.45 www 553: return OK if $request->header_only;
1.27 albertel 554:
555:
1.50 albertel 556: my $file=&Apache::lonnet::filelocation("",$request->uri);
1.24 sakharuk 557: my %mystyle;
1.50 albertel 558: my $result = '';
559: my $filecontents=&Apache::lonnet::getfile($file);
560: if ($filecontents == -1) {
561: &Apache::lonxml::error("<b> Unable to find <i>$file</i></b>");
562: $filecontents='';
563: } else {
564: $result = &Apache::lonxml::xmlparse($target,$filecontents,'',%mystyle);
1.66 www 565: }
1.50 albertel 566:
1.67 www 567: $request->print($result);
1.64 albertel 568:
1.34 www 569: writeallows($request->uri);
1.45 www 570: return OK;
1.24 sakharuk 571: }
572:
1.22 albertel 573: sub debug {
574: if ($Apache::lonxml::debug eq 1) {
1.54 albertel 575: print "DEBUG:".$_[0]."<br />\n";
1.22 albertel 576: }
577: }
1.49 albertel 578:
1.22 albertel 579: sub error {
1.52 albertel 580: if ($Apache::lonxml::debug eq 1) {
1.55 albertel 581: print "<b>ERROR:</b>".$_[0]."<br />\n";
1.52 albertel 582: } else {
583: print "<b>An Error occured while processing this resource. The instructor has been notified.</b> <br />";
584: #notify author
585: &Apache::lonmsg::author_res_msg($ENV{'request.filename'},$_[0]);
586: #notify course
587: if ( $ENV{'request.course.id'} ) {
588: my $users=$ENV{'course.'.$ENV{'request.course.id'}.'.comment.email'};
589: foreach my $user (split /\,/, $users) {
590: ($user,my $domain) = split /:/, $user;
1.54 albertel 591: &Apache::lonmsg::user_normal_msg($user,$domain,"Error in $ENV{'request.filename'}",$_[0]);
1.52 albertel 592: }
593: }
594:
595: #FIXME probably shouldn't have me get everything forever.
1.54 albertel 596: &Apache::lonmsg::user_normal_msg('albertel','msu',"Error in $ENV{'request.filename'}",$_[0]);
597: #&Apache::lonmsg::user_normal_msg('albertel','103',"Error in $ENV{'request.filename'}",$_[0]);
1.52 albertel 598: }
1.22 albertel 599: }
1.49 albertel 600:
1.22 albertel 601: sub warning {
602: if ($Apache::lonxml::debug eq 1) {
1.55 albertel 603: print "<b>W</b>ARNING<b>:</b>".$_[0]."<br />\n";
1.22 albertel 604: }
605: }
606:
1.1 sakharuk 607: 1;
608: __END__
1.68 www 609:
610:
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