1: # The LearningOnline Network with CAPA
2: # XML Parser Module
3: #
4: # last modified 06/26/00 by Alexander Sakharuk
5: # 11/6 Gerd Kortemeyer
6: # 6/1/1 Gerd Kortemeyer
7: # 2/21,3/13 Guy
8: # 3/29,5/4 Gerd Kortemeyer
9: # 5/10 Scott Harrison
10: # 5/26 Gerd Kortemeyer
11:
12: package Apache::lonxml;
13: use vars
14: qw(@pwd @outputstack $redirection $import @extlinks $metamode $evaluate %insertlist @namespace);
15: use strict;
16: use HTML::TokeParser;
17: use Safe;
18: use Safe::Hole;
19: use Opcode;
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:
31: use Apache::Constants qw(:common);
32: use Apache::lontexconvert;
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;
60:
61: # data structure for eidt mode, determines what tags can go into what other tags
62: %insertlist=();
63:
64: #stores the list of active tag namespaces
65: @namespace=();
66:
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:
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:
95: sub registerurl {
96: return (<<ENDSCRIPT);
97: <script language="JavaScript">
98: // BEGIN LON-CAPA Internal
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: }
112: }
113: // END LON-CAPA Internal
114: </script>
115: ENDSCRIPT
116: }
117:
118: sub loadevents() {
119: return 'LONCAPAreg();';
120: }
121:
122: sub unloadevents() {
123: return 'LONCAPAstale();';
124: }
125:
126: sub printalltags {
127: my $temp;
128: foreach $temp (sort keys %Apache::lonxml::alltags) {
129: &Apache::lonxml::debug("$temp -- $Apache::lonxml::alltags{$temp}");
130: }
131: }
132:
133: sub xmlparse {
134:
135: my ($target,$content_file_string,$safeinit,%style_for_target) = @_;
136: if ($target eq 'meta') {
137: $Apache::lonxml::redirection = 0;
138: $Apache::lonxml::metamode = 1;
139: $Apache::lonxml::evaluate = 1;
140: $Apache::lonxml::import = 0;
141: } elsif ($target eq 'grade') {
142: &startredirection;
143: $Apache::lonxml::metamode = 0;
144: $Apache::lonxml::evaluate = 1;
145: $Apache::lonxml::import = 1;
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;
151: } else {
152: $Apache::lonxml::redirection = 0;
153: $Apache::lonxml::metamode = 0;
154: $Apache::lonxml::evaluate = 1;
155: $Apache::lonxml::import = 1;
156: }
157: #&printalltags();
158: my @pars = ();
159: @Apache::lonxml::pwd=();
160: my $pwd=$ENV{'request.filename'};
161: $pwd =~ s:/[^/]*$::;
162: &newparser(\@pars,\$content_file_string,$pwd);
163: my $currentstring = '';
164: my $finaloutput = '';
165: my $newarg = '';
166: my $result;
167:
168: my $safeeval = new Safe;
169: my $safehole = new Safe::Hole;
170: $safeeval->permit("entereval");
171: $safeeval->permit(":base_math");
172: $safeeval->permit("sort");
173: $safeeval->deny(":base_io");
174: $safehole->wrap(\&Apache::lonnet::EXT,$safeeval,'&EXT');
175: #need to inspect this class of ops
176: # $safeeval->deny(":base_orig");
177: $safeinit .= ';$external::target='.$target.';';
178: $safeinit .= ';$external::randomseed='.&Apache::lonnet::rndseed().';';
179: &Apache::run::run($safeinit,$safeeval);
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 = ();
186: &initdepth;
187: my $token;
188: while ( $#pars > -1 ) {
189: while ($token = $pars[$#pars]->get_token) {
190: if (($token->[0] eq 'T') || ($token->[0] eq 'C') || ($token->[0] eq 'D') ) {
191: if ($metamode<1) { $result=$token->[1]; }
192: } elsif ($token->[0] eq 'PI') {
193: if ($metamode<1) { $result=$token->[2]; }
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));
199: &increasedepth($token);
200: if (exists $style_for_target{$token->[1]}) {
201: if ($Apache::lonxml::redirection) {
202: $Apache::lonxml::outputstack['-1'] .=
203: &recurse($style_for_target{$token->[1]},$target,$safeeval,
204: \%style_for_target,@parstack);
205: } else {
206: $finaloutput .= &recurse($style_for_target{$token->[1]},$target,
207: $safeeval,\%style_for_target,@parstack);
208: }
209: } else {
210: $result = &callsub("start_$token->[1]", $target, $token,\@parstack,
211: \@pars, $safeeval, \%style_for_target);
212: }
213: } elsif ($token->[0] eq 'E') {
214: #clear out any tags that didn't end
215: while ($token->[1] ne $stack[$#stack] && ($#stack > -1)) {
216: &Apache::lonxml::warning("Unbalanced tags in resource $stack['-1']");
217: pop @stack;pop @parstack;&decreasedepth($token);
218: }
219:
220: if (exists $style_for_target{'/'."$token->[1]"}) {
221: if ($Apache::lonxml::redirection) {
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: }
230:
231: } else {
232: $result = &callsub("end_$token->[1]", $target, $token, \@parstack,
233: \@pars,$safeeval, \%style_for_target);
234: }
235: } else {
236: &Apache::lonxml::error("Unknown token event :$token->[0]:$token->[1]:");
237: }
238: #evaluate variable refs in result
239: if ($result ne "") {
240: if ( $#parstack > -1 ) {
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: }
248: } else {
249: $finaloutput .= &Apache::run::evaluate($result,$safeeval,'');
250: }
251: $result = '';
252: }
253: if ($token->[0] eq 'E') {
254: pop @stack;pop @parstack;&decreasedepth($token);
255: }
256: }
257: pop @pars;
258: pop @Apache::lonxml::pwd;
259: }
260:
261: # if ($target eq 'meta') {
262: # $finaloutput.=&endredirection;
263: # }
264:
265: if (($ENV{'QUERY_STRING'}) && ($target eq 'web')) {
266: $finaloutput=&afterburn($finaloutput);
267: }
268:
269: return $finaloutput;
270: }
271:
272:
273: sub recurse {
274:
275: my @innerstack = ();
276: my @innerparstack = ();
277: my ($newarg,$target,$safeeval,$style_for_target,@parstack) = @_;
278: my @pat = ();
279: &newparser(\@pat,\$newarg);
280: my $tokenpat;
281: my $partstring = '';
282: my $output='';
283: my $decls='';
284: while ( $#pat > -1 ) {
285: while ($tokenpat = $pat[$#pat]->get_token) {
286: if (($tokenpat->[0] eq 'T') || ($tokenpat->[0] eq 'C') || ($tokenpat->[0] eq 'D') ) {
287: if ($metamode<1) { $partstring=$tokenpat->[1]; }
288: } elsif ($tokenpat->[0] eq 'PI') {
289: if ($metamode<1) { $partstring=$tokenpat->[2]; }
290: } elsif ($tokenpat->[0] eq 'S') {
291: push (@innerstack,$tokenpat->[1]);
292: push (@innerparstack,&parstring($tokenpat));
293: &increasedepth($tokenpat);
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]
300: && ($#innerstack > -1)) {
301: &Apache::lonxml::warning("Unbalanced tags in resource $innerstack['-1']");
302: pop @innerstack;pop @innerparstack;&decreasedepth($tokenpat);
303: }
304: $partstring = &callsub("end_$tokenpat->[1]",
305: $target, $tokenpat, \@innerparstack,
306: \@pat, $safeeval, $style_for_target);
307: } else {
308: &Apache::lonxml::error("Unknown token event :$tokenpat->[0]:$tokenpat->[1]:");
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: }
329: if ($tokenpat->[0] eq 'E') { pop @innerstack;pop @innerparstack;
330: &decreasedepth($tokenpat);}
331: }
332: pop @pat;
333: pop @Apache::lonxml::pwd;
334: }
335: return $output;
336: }
337:
338: sub callsub {
339: my ($sub,$target,$token,$parstack,$parser,$safeeval,$style)=@_;
340: my $currentstring='';
341: my $nodefault;
342: {
343: my $sub1;
344: no strict 'refs';
345: if ($target eq 'edit' && $token->[0] eq 'S') {
346: $currentstring = &Apache::edit::tag_start($target,$token,$parstack,$parser,
347: $safeeval,$style);
348: }
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) {
357: #&Apache::lonxml::debug("Calling sub $sub in $space $metamode<br />\n");
358: $sub1="$space\:\:$sub";
359: $Apache::lonxml::curdepth=join('_',@Apache::lonxml::depthcounter);
360: ($currentstring,$nodefault) = &$sub1($target,$token,$parstack,$parser,
361: $safeeval,$style);
362: } else {
363: #&Apache::lonxml::debug("NOT Calling sub $sub in $space $metamode<br />\n");
364: if ($metamode <1) {
365: if (defined($token->[4]) && ($metamode < 1)) {
366: $currentstring = $token->[4];
367: } else {
368: $currentstring = $token->[2];
369: }
370: }
371: }
372: &Apache::lonxml::debug("nodefalt:$nodefault:");
373: if ($currentstring eq '' && $nodefault eq '') {
374: if ($target eq 'edit') {
375: &Apache::lonxml::debug("doing default edit for $token->[1]");
376: if ($token->[0] eq 'S') {
377: $currentstring = &Apache::edit::tag_start($target,$token);
378: } elsif ($token->[0] eq 'E') {
379: $currentstring = &Apache::edit::tag_end($target,$token);
380: }
381: } elsif ($target eq 'modified') {
382: if ($token->[0] eq 'S') {
383: $currentstring = $token->[4];
384: $currentstring.=&Apache::edit::handle_insert();
385: } else {
386: $currentstring = $token->[2];
387: }
388: }
389: }
390: use strict 'refs';
391: }
392: return $currentstring;
393: }
394:
395: sub startredirection {
396: $Apache::lonxml::redirection++;
397: push (@Apache::lonxml::outputstack, '');
398: }
399:
400: sub endredirection {
401: if (!$Apache::lonxml::redirection) {
402: &Apache::lonxml::error("Endredirection was called, before a startredirection, perhaps you have unbalanced tags. Some debuging information:".join ":",caller);
403: return '';
404: }
405: $Apache::lonxml::redirection--;
406: pop @Apache::lonxml::outputstack;
407: }
408:
409: sub initdepth {
410: @Apache::lonxml::depthcounter=();
411: $Apache::lonxml::depth=-1;
412: $Apache::lonxml::olddepth=-1;
413: }
414:
415: sub increasedepth {
416: my ($token) = @_;
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: }
422: my $curdepth=join('_',@Apache::lonxml::depthcounter);
423: &Apache::lonxml::debug("s $Apache::lonxml::depth : $Apache::lonxml::olddepth : $curdepth : $token->[1]\n");
424: #print "<br />s $Apache::lonxml::depth : $Apache::lonxml::olddepth : $curdepth : $token->[1]\n";
425: }
426:
427: sub decreasedepth {
428: my ($token) = @_;
429: $Apache::lonxml::depth--;
430: if ($Apache::lonxml::depth<$Apache::lonxml::olddepth-1) {
431: $#Apache::lonxml::depthcounter--;
432: $Apache::lonxml::olddepth=$Apache::lonxml::depth+1;
433: }
434: if ( $Apache::lonxml::depth < -1) {
435: &Apache::lonxml::warning("Unbalanced tags in resource");
436: $Apache::lonxml::depth='-1';
437: }
438: my $curdepth=join('_',@Apache::lonxml::depthcounter);
439: &Apache::lonxml::debug("e $Apache::lonxml::depth : $Apache::lonxml::olddepth : $token->[1] : $curdepth\n");
440: #print "<br />e $Apache::lonxml::depth : $Apache::lonxml::olddepth : $token->[1] : $curdepth\n";
441: }
442:
443: sub get_all_text {
444:
445: my($tag,$pars)= @_;
446: my $depth=0;
447: my $token;
448: my $result='';
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];
484: }
485: }
486: }
487: # &Apache::lonxml::debug("Exit:$result:");
488: return $result
489: }
490:
491: sub newparser {
492: my ($parser,$contentref,$dir) = @_;
493: push (@$parser,HTML::TokeParser->new($contentref));
494: $$parser['-1']->xml_mode('1');
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: }
503:
504: sub parstring {
505: my ($token) = @_;
506: my $temp='';
507: map {
508: unless ($_=~/\W/) {
509: my $val=$token->[2]->{$_};
510: $val =~ s/([\%\@\\])/\\$1/g;
511: #if ($val =~ m/^[\%\@]/) { $val="\\".$val; }
512: $temp .= "my \$$_=\"$val\";"
513: }
514: } @{$token->[3]};
515: return $temp;
516: }
517:
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:
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:
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:
607: sub handler {
608: my $request=shift;
609:
610: my $target='web';
611:
612: $Apache::lonxml::debug=0;
613:
614: if ($ENV{'browser.mathml'}) {
615: $request->content_type('text/xml');
616: } else {
617: $request->content_type('text/html');
618: }
619:
620: $request->send_http_header;
621:
622: return OK if $request->header_only;
623:
624: #
625: # Edit action? Save file.
626: #
627: unless ($ENV{'request.state'} eq 'published') {
628: if ($ENV{'form.savethisfile'}) {
629:
630: }
631: }
632:
633: my $file=&Apache::lonnet::filelocation("",$request->uri);
634: my %mystyle;
635: my $result = '';
636: my $filecontents=&Apache::lonnet::getfile($file);
637: if ($filecontents == -1) {
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
648: $filecontents='';
649: } else {
650: $result = &Apache::lonxml::xmlparse($target,$filecontents,'',%mystyle);
651: }
652:
653: #
654: # Edit action? Insert editing commands
655: #
656: unless ($ENV{'request.state'} eq 'published') {
657: $result=&inserteditinfo($result,$filecontents);
658: }
659:
660: $request->print($result);
661:
662: writeallows($request->uri);
663: return OK;
664: }
665:
666: sub debug {
667: if ($Apache::lonxml::debug eq 1) {
668: print "DEBUG:".$_[0]."<br />\n";
669: }
670: }
671:
672: sub error {
673: if (($Apache::lonxml::debug eq 1) || ($ENV{'request.state'} eq 'construct') ) {
674: print "<b>ERROR:</b>".$_[0]."<br />\n";
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;
684: &Apache::lonmsg::user_normal_msg($user,$domain,"Error in $ENV{'request.filename'}",$_[0]);
685: }
686: }
687:
688: #FIXME probably shouldn't have me get everything forever.
689: &Apache::lonmsg::user_normal_msg('albertel','msu',"Error in $ENV{'request.filename'}",$_[0]);
690: #&Apache::lonmsg::user_normal_msg('albertel','103',"Error in $ENV{'request.filename'}",$_[0]);
691: }
692: }
693:
694: sub warning {
695: if ($ENV{'request.state'} eq 'construct') {
696: print "<b>W</b>ARNING<b>:</b>".$_[0]."<br />\n";
697: }
698: }
699:
700: sub register_insert {
701: my @data = split /\n/, &Apache::lonnet::getfile('/home/httpd/lonTabs/insertlist.tab');
702: my $i;
703: my $tagnum=0;
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);
710: $insertlist{"$tagnum.tag"} = $tag;
711: $insertlist{"$tagnum.description"} = $descrip;
712: $insertlist{"$tagnum.function"} = $function;
713: $insertlist{"$tagnum.show"}= $show;
714: $tagnum++;
715: }
716: $i++; #skipping TABLE line
717: $tagnum = 0;
718: for (;$i < $#data;$i++) {
719: my $line = $data[$i];
720: my ($mnemonic,@which) = split(/ +/,$line);
721: my $tag = $insertlist{"$tagnum.tag"};
722: for (my $j=0;$j <$#which;$j++) {
723: if ( $which[$j] eq 'Y' ) {
724: if ($insertlist{"$j.show"} ne 'no') {
725: push(@{ $insertlist{"$tag.which"} },$j);
726: }
727: }
728: }
729: $tagnum++;
730: }
731: }
732: 1;
733: __END__
734:
735:
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>