File:  [LON-CAPA] / loncom / xml / lonxml.pm
Revision 1.73: download - view: text, annotated - select for diffs
Thu May 10 19:10:25 2001 UTC (23 years, 1 month ago) by harris41
Branches: MAIN
CVS tags: HEAD
making sure that warnings only happen for construction space

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

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