Annotation of loncom/xml/lonxml.pm, revision 1.65

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

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>