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

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

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