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