Return to lonxml.pm CVS log

Up to [LON-CAPA] / loncom / xml

In londefdef.pm a few tags for tex target were changed: <m>,<p>,...
In lonxml.pm a new global variable textredirection was introduced. It is used for dwitch on and off the metadata output. A few lines of code were added.

    1: # The LearningOnline Network with CAPA
    2: # XML Parser Module 
    3: #
    4: # last modified 06/26/00 by Alexander Sakharuk
    5: 
    6: package Apache::lonxml; 
    7: 
    8: use strict;
    9: use HTML::TokeParser;
   10: use Safe;
   11: use Opcode;
   12: 
   13: sub register {
   14:   my $space;
   15:   my @taglist;
   16:   my $temptag;
   17:   ($space,@taglist) = @_;
   18:   foreach $temptag (@taglist) {
   19:     $Apache::lonxml::alltags{$temptag}=$space;
   20:   }
   21: }
   22:                                      
   23: use Apache::style;
   24: use Apache::lontexconvert;
   25: use Apache::run;
   26: use Apache::londefdef;
   27: use Apache::scripttag;
   28: #==================================================   Main subroutine: xmlparse  
   29: @Apache::lonxml::pwd=();
   30: $Apache::lonxml::outputstack = '';
   31: $Apache::lonxml::redirection = 1;
   32: $Apache::lonxml::textredirection = 1;
   33: 
   34: sub xmlparse {
   35: 
   36:  my ($target,$content_file_string,$safeinit,%style_for_target) = @_;
   37:  if ($target eq 'meta') {$Apache::lonxml::textredirection = 0;}
   38:  my @pars = ();
   39:  @Apache::lonxml::pwd=();
   40:  my $pwd=$ENV{'request.filename'};
   41:  $pwd =~ s:/[^/]*$::;
   42:  &newparser(\@pars,\$content_file_string,$pwd);
   43:  my $currentstring = '';
   44:  my $finaloutput = ''; 
   45:  my $newarg = '';
   46:  my $result;
   47: 
   48:  my $safeeval = new Safe;
   49:  $safeeval->permit("entereval");
   50:  $safeeval->permit(":base_math");
   51:  $safeeval->deny(":base_io");
   52: #need to inspect this class of ops
   53: # $safeeval->deny(":base_orig");
   54:  $safeinit .= ';$external::target='.$target.';';
   55:  $safeinit .= ';$external::randomseed='.&Apache::lonnet::rndseed().';';
   56:  &Apache::run::run($safeinit,$safeeval);
   57: #-------------------- Redefinition of the target in the case of compound target
   58: 
   59:  ($target, my @tenta) = split('&&',$target);
   60: 
   61:  my @stack = (); 
   62:  my @parstack = ();
   63:  &initdepth;
   64:  my $token;
   65:  while ( $#pars > -1 ) {
   66:    while ($token = $pars[$#pars]->get_token) {
   67:      if ($token->[0] eq 'T') {
   68: 	 if ($Apache::lonxml::textredirection == 1) {$result=$token->[1];}
   69: #       $finaloutput .= &Apache::run::evaluate($token->[1],$safeeval,'');
   70:      } elsif ($token->[0] eq 'S') {
   71:             if ($target eq 'meta' and $token->[2]->{metaout} eq 'ON') {$Apache::lonxml::textredirection = 1;}
   72:        # add tag to stack 	    
   73:        push (@stack,$token->[1]);
   74:        # add parameters list to another stack
   75:        push (@parstack,&parstring($token));
   76:        &increasedepth($token);       
   77:        if (exists $style_for_target{$token->[1]}) {
   78: 
   79: 	if ($Apache::lonxml::redirection == 1) {
   80: 	  $finaloutput .= &recurse($style_for_target{$token->[1]},
   81: 		  		  $target,$safeeval,\%style_for_target,
   82: 	 		 	  @parstack);
   83:         } else {
   84:           $Apache::lonxml::outputstack .=  &recurse($style_for_target{$token->[1]},
   85: 		  		  $target,$safeeval,\%style_for_target,
   86: 	 		 	  @parstack);
   87:         }
   88: 
   89:        } else {
   90: 	 $result = &callsub("start_$token->[1]", $target, $token,\@parstack,
   91: 			       \@pars, $safeeval, \%style_for_target);
   92:        }              
   93:      } elsif ($token->[0] eq 'E')  {
   94: 	 if ($target eq 'meta') {$Apache::lonxml::textredirection = 0;}
   95:        #clear out any tags that didn't end
   96:        while ($token->[1] ne $stack[$#stack] 
   97: 	      && ($#stack > -1)) {pop @stack;pop @parstack;&decreasedepth($token);}
   98:        
   99:        if (exists $style_for_target{'/'."$token->[1]"}) {
  100: 
  101: 	if ($Apache::lonxml::redirection == 1) {
  102: 	 $finaloutput .= &recurse($style_for_target{'/'."$token->[1]"},
  103: 				  $target,$safeeval,\%style_for_target,
  104: 				  @parstack);
  105:         } else {
  106:          $Apache::lonxml::outputstack .=  &recurse($style_for_target{'/'."$token->[1]"},
  107: 				  $target,$safeeval,\%style_for_target,
  108: 				  @parstack);
  109:         }
  110: 
  111:        } else {
  112: 	 $result = &callsub("end_$token->[1]", $target, $token, \@parstack,
  113: 			       \@pars,$safeeval, \%style_for_target);
  114:        }
  115:      }
  116:      if ($result ne "") {
  117:        if ( $#parstack > -1 ) {
  118:  
  119: 	if ($Apache::lonxml::redirection == 1) {
  120: 	 $finaloutput .= &Apache::run::evaluate($result,$safeeval,
  121: 						$parstack[$#parstack]);
  122:         } else {
  123:          $Apache::lonxml::outputstack .= &Apache::run::evaluate($result,$safeeval,
  124: 						$parstack[$#parstack]);
  125:         }
  126: 
  127:        } else {
  128: 	 $finaloutput .= &Apache::run::evaluate($result,$safeeval,'');
  129:        }
  130:        $result = '';
  131:      } else {
  132:          $finaloutput .= $result;
  133:      }
  134:      if ($token->[0] eq 'E') { pop @stack;pop @parstack;&decreasedepth($token);}
  135:    }
  136:    pop @pars;
  137:    pop @Apache::lonxml::pwd;
  138:  }
  139: 
  140:  return $finaloutput;
  141: }
  142: 
  143: sub recurse {
  144:   
  145:   my @innerstack = (); 
  146:   my @innerparstack = ();
  147:   my ($newarg,$target,$safeeval,$style_for_target,@parstack) = @_;
  148:   my @pat = ();
  149:   &newparser(\@pat,\$newarg);
  150:   my $tokenpat;
  151:   my $partstring = '';
  152:   my $output='';
  153:   my $decls='';
  154:   while ( $#pat > -1 ) {
  155:     while  ($tokenpat = $pat[$#pat]->get_token) {
  156:       if ($tokenpat->[0] eq 'T') {
  157: 	  if ($Apache::lonxml::textredirection == 1) {$partstring = $tokenpat->[1];}
  158:       } elsif ($tokenpat->[0] eq 'S') {
  159: 	push (@innerstack,$tokenpat->[1]);
  160: 	push (@innerparstack,&parstring($tokenpat));
  161: 	&increasedepth($tokenpat);
  162: 	$partstring = &callsub("start_$tokenpat->[1]", 
  163: 			       $target, $tokenpat, \@innerparstack,
  164: 			       \@pat, $safeeval, $style_for_target);
  165:       } elsif ($tokenpat->[0] eq 'E') {
  166: 	#clear out any tags that didn't end
  167: 	while ($tokenpat->[1] ne $innerstack[$#innerstack] 
  168: 	       && ($#innerstack > -1)) {pop @innerstack;pop @innerparstack;
  169: 					&decreasedepth($tokenpat);}
  170: 	$partstring = &callsub("end_$tokenpat->[1]",
  171: 			       $target, $tokenpat, \@innerparstack,
  172: 			       \@pat, $safeeval, $style_for_target);
  173:       }
  174:       #pass both the variable to the style tag, and the tag we 
  175:       #are processing inside the <definedtag>
  176:       if ( $partstring ne "" ) {
  177: 	if ( $#parstack > -1 ) { 
  178: 	  if ( $#innerparstack > -1 ) { 
  179: 	    $decls= $parstack[$#parstack].$innerparstack[$#innerparstack];
  180: 	  } else {
  181: 	    $decls= $parstack[$#parstack];
  182: 	  }
  183: 	} else {
  184: 	  if ( $#innerparstack > -1 ) { 
  185: 	    $decls=$innerparstack[$#innerparstack];
  186: 	  } else {
  187: 	    $decls='';
  188: 	  }
  189: 	}
  190: 	$output .= &Apache::run::evaluate($partstring,$safeeval,$decls);
  191: 	$partstring = '';
  192:       }
  193:       if ($tokenpat->[0] eq 'E') { pop @innerstack;pop @innerparstack;
  194: 				 &decreasedepth($tokenpat);}
  195:     }
  196:     pop @pat;
  197:     pop @Apache::lonxml::pwd;
  198:   }
  199:   return $output;
  200: }
  201: 
  202: sub callsub {
  203:   my ($sub,$target,$token,$parstack,$parser,$safeeval,$style)=@_;
  204:   my $currentstring='';
  205:   {
  206:       my $sub1;
  207:     no strict 'refs';
  208:     if (my $space=$Apache::lonxml::alltags{$token->[1]}) {
  209:       #&Apache::lonxml::debug("Calling sub $sub in $space<br>\n");
  210:       $sub1="$space\:\:$sub";
  211:       $Apache::lonxml::curdepth=join('_',@Apache::lonxml::depthcounter);
  212:       $currentstring = &$sub1($target,$token,$parstack,$parser,
  213: 			     $safeeval,$style);
  214:     } else {
  215:       #&Apache::lonxml::debug("NOT Calling sub $sub in $space<br>\n");
  216:       if (defined($token->[4])) {
  217: 	$currentstring = $token->[4];
  218:       } else {
  219: 	$currentstring = $token->[2];
  220:       }
  221:     }
  222:     use strict 'refs';
  223:   }
  224:   return $currentstring;
  225: }
  226: 
  227: sub initdepth {
  228:   @Apache::lonxml::depthcounter=();
  229:   $Apache::lonxml::depth=-1;
  230:   $Apache::lonxml::olddepth=-1;
  231: }
  232: 
  233: sub increasedepth {
  234:   my ($token) = @_;
  235:   if ($Apache::lonxml::depth<$Apache::lonxml::olddepth-1) {
  236:     $#Apache::lonxml::depthcounter--;
  237:     $Apache::lonxml::olddepth=$Apache::lonxml::depth;
  238:   }
  239:   $Apache::lonxml::depth++;
  240: #  print "<br>s $Apache::lonxml::depth : $Apache::lonxml::olddepth : $token->[1]<br>\n";
  241:   $Apache::lonxml::depthcounter[$Apache::lonxml::depth]++;
  242:   if ($Apache::lonxml::depthcounter[$Apache::lonxml::depth]==1) {
  243:     $Apache::lonxml::olddepth=$Apache::lonxml::depth;
  244:   }
  245: }
  246: 
  247: sub decreasedepth {
  248:   my ($token) = @_;
  249:   $Apache::lonxml::depth--;
  250: #  print "<br>e $Apache::lonxml::depth : $Apache::lonxml::olddepth : $token->[1]<br>\n";
  251: }
  252: 
  253: sub get_all_text {
  254: 
  255:  my($tag,$pars)= @_;
  256:  my $depth=0;
  257:  my $token;
  258:  my $result='';
  259:  my $tag=substr($tag,1); #strip the / off the tag
  260: # &Apache::lonxml::debug("have:$tag:");
  261:  while (($depth >=0) && ($token = $pars->get_token)) {
  262:    if ($token->[0] eq 'T') {
  263:      $result.=$token->[1];
  264:    } elsif ($token->[0] eq 'S') {
  265:      if ($token->[1] eq $tag) { $depth++; }
  266:      $result.=$token->[4];
  267:    } elsif ($token->[0] eq 'E')  {
  268:      if ( $token->[1] eq $tag) { $depth--; }
  269:      #skip sending back the last end tag
  270:      if ($depth > -1) { $result.=$token->[2]; }
  271:    }
  272:  }
  273:  return $result
  274: }
  275: 
  276: sub newparser {
  277:   my ($parser,$contentref,$dir) = @_;
  278:   push (@$parser,HTML::TokeParser->new($contentref));
  279:   if ( $dir eq '' ) {
  280:     push (@Apache::lonxml::pwd, $Apache::lonxml::pwd[$#Apache::lonxml::pwd]);
  281:   } else {
  282:     push (@Apache::lonxml::pwd, $dir);
  283:   } 
  284: #  &Apache::lonxml::debug("pwd:$#Apache::lonxml::pwd");
  285: #  &Apache::lonxml::debug("pwd:$Apache::lonxml::pwd[$#Apache::lonxml::pwd]");
  286: }
  287: 
  288: sub parstring {
  289:   my ($token) = @_;
  290:   my $temp='';
  291:   map {
  292:     if ($_=~/\w+/) {
  293:       $temp .= "my \$$_=\"$token->[2]->{$_}\";"
  294:     }
  295:   } @{$token->[3]};
  296:   return $temp;
  297: }
  298: 
  299: sub handler {
  300:   my $request=shift;
  301: 
  302:   my $target='meta';
  303:   $Apache::lonxml::debug=1;
  304:   if ($ENV{'browser.mathml'}) {
  305:     $request->content_type('text/xml');
  306:   } else {
  307:     $request->content_type('text/html');
  308:   }
  309: 
  310: #  $request->print(<<ENDHEADER);
  311: #<html>
  312: #<head>
  313: #<title>Just test</title>
  314: #</head>
  315: #<body bgcolor="#FFFFFF">
  316: #ENDHEADER
  317: #  &Apache::lonhomework::send_header($request);
  318:   $request->send_http_header;
  319: 
  320:   return 'OK' if $request->header_only;
  321: 
  322:   $request->print(&Apache::lontexconvert::header());
  323: 
  324:   $request->print('<body bgcolor="#FFFFFF">'."\n");
  325: 
  326:   my $file = "/home/httpd/html".$request->uri;
  327:   my %mystyle;
  328:   my $result = '';
  329:   $result = Apache::lonxml::xmlparse($target, &Apache::lonnet::getfile($file),'',%mystyle);
  330:   $request->print($result);
  331: 
  332:   $request->print('</body>');
  333:   $request->print(&Apache::lontexconvert::footer());
  334:   return 'OK';
  335: }
  336:  
  337: $Apache::lonxml::debug=0;
  338: sub debug {
  339:   if ($Apache::lonxml::debug eq 1) {
  340:     print "DEBUG:".$_[0]."<br>\n";
  341:   }
  342: }
  343: sub error {
  344:   print "ERROR:".$_[0]."<br>\n";
  345: }
  346: sub warning {
  347:   if ($Apache::lonxml::debug eq 1) {
  348:     print "WARNING:".$_[0]."<br>\n";
  349:   }
  350: }
  351: 
  352: 1;
  353: __END__
  354: 
  355: 
  356: 
  357: 
  358: 
  359: 
  360: 
  361: 
  362: 
  363: 
  364: 
  365: 
  366: 
  367: 
  368: 
  369: 
  370: 
  371: