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

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.3       sakharuk  174:  return $finaloutput;
1.15      albertel  175: }
                    176: 
                    177: sub recurse {
                    178:   
                    179:   my @innerstack = (); 
                    180:   my @innerparstack = ();
                    181:   my ($newarg,$target,$safeeval,$style_for_target,@parstack) = @_;
1.16      albertel  182:   my @pat = ();
1.23      albertel  183:   &newparser(\@pat,\$newarg);
1.15      albertel  184:   my $tokenpat;
                    185:   my $partstring = '';
                    186:   my $output='';
1.16      albertel  187:   my $decls='';
                    188:   while ( $#pat > -1 ) {
                    189:     while  ($tokenpat = $pat[$#pat]->get_token) {
1.57      albertel  190:       if (($tokenpat->[0] eq 'T') || ($tokenpat->[0] eq 'C') || ($tokenpat->[0] eq 'D') ) {
1.61      albertel  191: 	if ($metamode<1) { $partstring=$tokenpat->[1]; }
1.57      albertel  192:       } elsif ($tokenpat->[0] eq 'PI') {
1.61      albertel  193: 	if ($metamode<1) { $partstring=$tokenpat->[2]; }
1.16      albertel  194:       } elsif ($tokenpat->[0] eq 'S') {
                    195: 	push (@innerstack,$tokenpat->[1]);
                    196: 	push (@innerparstack,&parstring($tokenpat));
1.19      albertel  197: 	&increasedepth($tokenpat);
1.16      albertel  198: 	$partstring = &callsub("start_$tokenpat->[1]", 
                    199: 			       $target, $tokenpat, \@innerparstack,
                    200: 			       \@pat, $safeeval, $style_for_target);
                    201:       } elsif ($tokenpat->[0] eq 'E') {
                    202: 	#clear out any tags that didn't end
                    203: 	while ($tokenpat->[1] ne $innerstack[$#innerstack] 
1.43      albertel  204: 	       && ($#innerstack > -1)) {
1.49      albertel  205: 	  &Apache::lonxml::warning("Unbalanced tags in resource $innerstack['-1']");
1.43      albertel  206: 	  pop @innerstack;pop @innerparstack;&decreasedepth($tokenpat);
                    207: 	}
1.16      albertel  208: 	$partstring = &callsub("end_$tokenpat->[1]",
                    209: 			       $target, $tokenpat, \@innerparstack,
                    210: 			       \@pat, $safeeval, $style_for_target);
1.57      albertel  211:       } else {
                    212: 	&Apache::lonxml::error("Unknown token event :$tokenpat->[0]:$tokenpat->[1]:");
1.16      albertel  213:       }
                    214:       #pass both the variable to the style tag, and the tag we 
                    215:       #are processing inside the <definedtag>
                    216:       if ( $partstring ne "" ) {
                    217: 	if ( $#parstack > -1 ) { 
                    218: 	  if ( $#innerparstack > -1 ) { 
                    219: 	    $decls= $parstack[$#parstack].$innerparstack[$#innerparstack];
                    220: 	  } else {
                    221: 	    $decls= $parstack[$#parstack];
                    222: 	  }
                    223: 	} else {
                    224: 	  if ( $#innerparstack > -1 ) { 
                    225: 	    $decls=$innerparstack[$#innerparstack];
                    226: 	  } else {
                    227: 	    $decls='';
                    228: 	  }
                    229: 	}
                    230: 	$output .= &Apache::run::evaluate($partstring,$safeeval,$decls);
                    231: 	$partstring = '';
                    232:       }
1.17      albertel  233:       if ($tokenpat->[0] eq 'E') { pop @innerstack;pop @innerparstack;
1.19      albertel  234: 				 &decreasedepth($tokenpat);}
1.15      albertel  235:     }
1.16      albertel  236:     pop @pat;
1.23      albertel  237:     pop @Apache::lonxml::pwd;
1.15      albertel  238:   }
                    239:   return $output;
1.7       albertel  240: }
                    241: 
                    242: sub callsub {
1.14      albertel  243:   my ($sub,$target,$token,$parstack,$parser,$safeeval,$style)=@_;
1.7       albertel  244:   my $currentstring='';
                    245:   {
1.59      albertel  246:     my $sub1;
1.7       albertel  247:     no strict 'refs';
1.59      albertel  248:     if ($target eq 'edit' && $token->[0] eq 'S') {
                    249:       $currentstring = &Apache::edit::tag_start($target,$token,$parstack,$parser,
                    250: 						$safeeval,$style);
                    251:     }
1.7       albertel  252:     if (my $space=$Apache::lonxml::alltags{$token->[1]}) {
1.63      sakharuk  253: #      &Apache::lonxml::debug("Calling sub $sub in $space $metamode<br />\n");
1.24      sakharuk  254:       $sub1="$space\:\:$sub";
1.17      albertel  255:       $Apache::lonxml::curdepth=join('_',@Apache::lonxml::depthcounter);
1.59      albertel  256:       $currentstring .= &$sub1($target,$token,$parstack,$parser,
1.16      albertel  257: 			     $safeeval,$style);
1.7       albertel  258:     } else {
1.63      sakharuk  259: #      &Apache::lonxml::debug("NOT Calling sub $sub in $space $metamode<br />\n");
1.62      sakharuk  260:       if ($metamode <1) {
                    261: 	if (defined($token->[4]) && ($metamode < 1)) {
                    262: 	  $currentstring .= $token->[4];
                    263: 	} else {
                    264: 	  $currentstring .= $token->[2];
                    265: 	}
1.7       albertel  266:       }
1.59      albertel  267:     }
                    268:     if ($target eq 'edit' && $token->[0] eq 'E') {
1.61      albertel  269:       $currentstring .= &Apache::edit::tag_end($target,$token,$parstack,$parser,
1.59      albertel  270: 						$safeeval,$style);
1.7       albertel  271:     }
                    272:     use strict 'refs';
                    273:   }
                    274:   return $currentstring;
1.17      albertel  275: }
                    276: 
1.55      albertel  277: sub startredirection {
                    278:   $Apache::lonxml::redirection++;
                    279:   push (@Apache::lonxml::outputstack, '');
                    280: }
                    281: 
                    282: sub endredirection {
                    283:   if (!$Apache::lonxml::redirection) {
                    284:     &Apache::lonxml::error("Endredirection was called, before a startredirection, perhaps you have unbalanced tags. Some debuggin information:".join ":",caller);
                    285:     return '';
                    286:   }
                    287:   $Apache::lonxml::redirection--;
                    288:   pop @Apache::lonxml::outputstack;
                    289: }
                    290: 
1.17      albertel  291: sub initdepth {
                    292:   @Apache::lonxml::depthcounter=();
                    293:   $Apache::lonxml::depth=-1;
                    294:   $Apache::lonxml::olddepth=-1;
                    295: }
                    296: 
                    297: sub increasedepth {
1.19      albertel  298:   my ($token) = @_;
1.17      albertel  299:   $Apache::lonxml::depth++;
                    300:   $Apache::lonxml::depthcounter[$Apache::lonxml::depth]++;
                    301:   if ($Apache::lonxml::depthcounter[$Apache::lonxml::depth]==1) {
                    302:     $Apache::lonxml::olddepth=$Apache::lonxml::depth;
                    303:   }
1.42      albertel  304:   my $curdepth=join('_',@Apache::lonxml::depthcounter);
1.64      albertel  305:   &Apache::lonxml::debug("s $Apache::lonxml::depth : $Apache::lonxml::olddepth : $curdepth : $token->[1]\n");
1.54      albertel  306: #print "<br />s $Apache::lonxml::depth : $Apache::lonxml::olddepth : $curdepth : $token->[1]\n";
1.17      albertel  307: }
                    308: 
                    309: sub decreasedepth {
1.19      albertel  310:   my ($token) = @_;
1.17      albertel  311:   $Apache::lonxml::depth--;
1.36      albertel  312:   if ($Apache::lonxml::depth<$Apache::lonxml::olddepth-1) {
                    313:     $#Apache::lonxml::depthcounter--;
                    314:     $Apache::lonxml::olddepth=$Apache::lonxml::depth+1;
                    315:   }
1.43      albertel  316:   if (  $Apache::lonxml::depth < -1) {
1.49      albertel  317:     &Apache::lonxml::warning("Unbalanced tags in resource");   
1.43      albertel  318:     $Apache::lonxml::depth='-1';
                    319:   }
1.42      albertel  320:   my $curdepth=join('_',@Apache::lonxml::depthcounter);
1.64      albertel  321:   &Apache::lonxml::debug("e $Apache::lonxml::depth : $Apache::lonxml::olddepth : $token->[1] : $curdepth\n");
1.54      albertel  322: #print "<br />e $Apache::lonxml::depth : $Apache::lonxml::olddepth : $token->[1] : $curdepth\n";
1.1       sakharuk  323: }
1.19      albertel  324: 
                    325: sub get_all_text {
                    326: 
                    327:  my($tag,$pars)= @_;
                    328:  my $depth=0;
                    329:  my $token;
                    330:  my $result='';
1.57      albertel  331:  if ( $tag =~ m:^/: ) { 
                    332:    my $tag=substr($tag,1); 
                    333: #   &Apache::lonxml::debug("have:$tag:");
                    334:    while (($depth >=0) && ($token = $pars->get_token)) {
                    335: #     &Apache::lonxml::debug("e token:$token->[0]:$depth:$token->[1]");
                    336:      if (($token->[0] eq 'T')||($token->[0] eq 'C')||($token->[0] eq 'D')) {
                    337:        $result.=$token->[1];
                    338:      } elsif ($token->[0] eq 'PI') {
                    339:        $result.=$token->[2];
                    340:      } elsif ($token->[0] eq 'S') {
                    341:        if ($token->[1] eq $tag) { $depth++; }
                    342:        $result.=$token->[4];
                    343:      } elsif ($token->[0] eq 'E')  {
                    344:        if ( $token->[1] eq $tag) { $depth--; }
                    345:        #skip sending back the last end tag
                    346:        if ($depth > -1) { $result.=$token->[2]; } else {
                    347: 	 $pars->unget_token($token);
                    348:        }
                    349:      }
                    350:    }
                    351:  } else {
                    352:    while ($token = $pars->get_token) {
                    353: #     &Apache::lonxml::debug("s token:$token->[0]:$depth:$token->[1]");
                    354:      if (($token->[0] eq 'T')||($token->[0] eq 'C')||($token->[0] eq 'D')) {
                    355:        $result.=$token->[1];
                    356:      } elsif ($token->[0] eq 'PI') {
                    357:        $result.=$token->[2];
                    358:      } elsif ($token->[0] eq 'S') {
                    359:        if ( $token->[1] eq $tag) { 
                    360: 	 $pars->unget_token($token); last;
                    361:        } else {
                    362: 	 $result.=$token->[4];
                    363:        }
                    364:      } elsif ($token->[0] eq 'E')  {
                    365:        $result.=$token->[2];
1.36      albertel  366:      }
1.19      albertel  367:    }
                    368:  }
1.49      albertel  369: # &Apache::lonxml::debug("Exit:$result:");
1.19      albertel  370:  return $result
                    371: }
                    372: 
1.23      albertel  373: sub newparser {
                    374:   my ($parser,$contentref,$dir) = @_;
                    375:   push (@$parser,HTML::TokeParser->new($contentref));
1.56      albertel  376:   $$parser['-1']->xml_mode('1');
1.23      albertel  377:   if ( $dir eq '' ) {
                    378:     push (@Apache::lonxml::pwd, $Apache::lonxml::pwd[$#Apache::lonxml::pwd]);
                    379:   } else {
                    380:     push (@Apache::lonxml::pwd, $dir);
                    381:   } 
                    382: #  &Apache::lonxml::debug("pwd:$#Apache::lonxml::pwd");
                    383: #  &Apache::lonxml::debug("pwd:$Apache::lonxml::pwd[$#Apache::lonxml::pwd]");
                    384: }
1.1       sakharuk  385: 
1.8       albertel  386: sub parstring {
                    387:   my ($token) = @_;
                    388:   my $temp='';
1.20      albertel  389:   map {
1.35      www       390:     unless ($_=~/\W/) {
1.42      albertel  391:       my $val=$token->[2]->{$_};
1.53      albertel  392:       $val =~ s/([\%\@\\])/\\$1/g;
1.51      albertel  393:       #if ($val =~ m/^[\%\@]/) { $val="\\".$val; }
1.42      albertel  394:       $temp .= "my \$$_=\"$val\";"
1.20      albertel  395:     }
                    396:   } @{$token->[3]};
1.8       albertel  397:   return $temp;
                    398: }
1.22      albertel  399: 
1.34      www       400: sub writeallows {
                    401:     my $thisurl='/res/'.&Apache::lonnet::declutter(shift);
                    402:     my $thisdir=$thisurl;
                    403:     $thisdir=~s/\/[^\/]+$//;
                    404:     my %httpref=();
                    405:     map {
                    406:        $httpref{'httpref.'.
                    407:  	        &Apache::lonnet::hreflocation($thisdir,$_)}=$thisurl;              } @extlinks;
                    408:     &Apache::lonnet::appenv(%httpref);
                    409: }
                    410: 
1.66    ! www       411: #
        !           412: # Afterburner handles anchors, highlights and links
        !           413: #
        !           414: 
        !           415: sub afterburn {
        !           416:     my $result=shift;
        !           417:     map {
        !           418:        my ($name, $value) = split(/=/,$_);
        !           419:        $value =~ tr/+/ /;
        !           420:        $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
        !           421:        if (($name eq 'highlight')||($name eq 'anchor')||($name eq 'link')) {
        !           422:            unless ($ENV{'form.'.$name}) {
        !           423:               $ENV{'form.'.$name}=$value;
        !           424: 	   }
        !           425:        }
        !           426:     } (split(/&/,$ENV{'QUERY_STRING'}));
        !           427:     if ($ENV{'form.highlight'}) {
        !           428:         map {
        !           429:            my $anchorname=$_;
        !           430: 	   my $matchthis=$anchorname;
        !           431:            $matchthis=~s/\_+/\\s\+/g;
        !           432:            $result=~s/($matchthis)/\<font color=\"red\"\>$1\<\/font\>/gs;
        !           433:        } split(/\,/,$ENV{'form.highlight'});
        !           434:     }
        !           435:     if ($ENV{'form.link'}) {
        !           436:         map {
        !           437:            my ($anchorname,$linkurl)=split(/\>/,$_);
        !           438: 	   my $matchthis=$anchorname;
        !           439:            $matchthis=~s/\_+/\\s\+/g;
        !           440:            $result=~s/($matchthis)/\<a href=\"$linkurl\"\>$1\<\/a\>/gs;
        !           441:        } split(/\,/,$ENV{'form.link'});
        !           442:     }
        !           443:     if ($ENV{'form.anchor'}) {
        !           444:         my $anchorname=$ENV{'form.anchor'};
        !           445: 	my $matchthis=$anchorname;
        !           446:         $matchthis=~s/\_+/\\s\+/g;
        !           447:         $result=~s/($matchthis)/\<a name=\"$anchorname\"\>$1\<\/a\>/s;
        !           448:         $result.=(<<"ENDSCRIPT");
        !           449: <script>
        !           450:     document.location.hash='$anchorname';
        !           451: </script>
        !           452: ENDSCRIPT
        !           453:     }
        !           454:     return $result;
        !           455: }
        !           456: 
1.24      sakharuk  457: sub handler {
                    458:   my $request=shift;
1.44      albertel  459:   
1.64      albertel  460:   my $target='web';
1.65      albertel  461:   $Apache::lonxml::debug=0;
1.25      sakharuk  462:   if ($ENV{'browser.mathml'}) {
1.27      albertel  463:     $request->content_type('text/xml');
                    464:   } else {
                    465:     $request->content_type('text/html');
1.25      sakharuk  466:   }
1.64      albertel  467:   
1.29      sakharuk  468: #  $request->print(<<ENDHEADER);
                    469: #<html>
                    470: #<head>
                    471: #<title>Just test</title>
                    472: #</head>
                    473: #<body bgcolor="#FFFFFF">
                    474: #ENDHEADER
                    475: #  &Apache::lonhomework::send_header($request);
1.27      albertel  476:   $request->send_http_header;
1.64      albertel  477:   
1.45      www       478:   return OK if $request->header_only;
1.27      albertel  479: 
1.64      albertel  480:   if ($target eq 'web') {
                    481:     $request->print(&Apache::lontexconvert::header());
                    482:     $request->print('<body bgcolor="#FFFFFF">'."\n");
1.63      sakharuk  483:   }
1.27      albertel  484: 
1.50      albertel  485:   my $file=&Apache::lonnet::filelocation("",$request->uri);
1.24      sakharuk  486:   my %mystyle;
1.50      albertel  487:   my $result = ''; 
                    488:   my $filecontents=&Apache::lonnet::getfile($file);
                    489:   if ($filecontents == -1) {
                    490:     &Apache::lonxml::error("<b> Unable to find <i>$file</i></b>");
                    491:     $filecontents='';
                    492:   } else {
                    493:     $result = &Apache::lonxml::xmlparse($target,$filecontents,'',%mystyle);
1.66    ! www       494:   }
        !           495: #
        !           496: # Afterburner
        !           497: #
        !           498:   if ($ENV{'QUERY_STRING'}) {
        !           499:       $result=&afterburn($result);
1.50      albertel  500:   }
1.24      sakharuk  501:   $request->print($result);
1.29      sakharuk  502: 
1.50      albertel  503: 
1.63      sakharuk  504:   if ($target eq 'tex') {
                    505: #    $request->print('\end{document}'."\n");
1.64      albertel  506:   } elsif ($target eq 'web') {
1.63      sakharuk  507:     $request->print('</body>');
                    508:     $request->print(&Apache::lontexconvert::footer());
                    509:   }
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>