[BACK]Return to lonxml.pm CVS log [TXT] [DIR] Up to [LON-CAPA] / loncom / xml

Diff for /loncom/xml/lonxml.pm between versions 1.96 and 1.102

version 1.96, 2001/06/16 18:34:31 version 1.102, 2001/07/12 15:53:44
Line 70  $evaluate = 1; Line 70  $evaluate = 1;
 # data structure for eidt mode, determines what tags can go into what other tags  # data structure for eidt mode, determines what tags can go into what other tags
 %insertlist=();  %insertlist=();
   
 #stores the list of active tag namespaces  # stores the list of active tag namespaces
 @namespace=();  @namespace=();
   
   # has the dynamic menu been updated to know about this resource
   $Apache::lonxml::registered=0;
   
 sub xmlbegin {  sub xmlbegin {
   my $output='';    my $output='';
   if ($ENV{'browser.mathml'}) {    if ($ENV{'browser.mathml'}) {
Line 102  sub fontsettings() { Line 105  sub fontsettings() {
 }  }
   
 sub registerurl {  sub registerurl {
     if ($ENV{'REQUEST_URI'}!~/^\/(res\/)*adm\//) {      my $forcereg=shift;
       if ($Apache::lonxml::registered) { return ''; }
       if (($ENV{'REQUEST_URI'}!~/^\/(res\/)*adm\//) || ($forcereg)) {
         my $hwkadd='';          my $hwkadd='';
         if ($ENV{'REQUEST_URI'}=~/\.(problem|exam|quiz|assess|survey|form)$/) {          if ($ENV{'REQUEST_URI'}=~/\.(problem|exam|quiz|assess|survey|form)$/) {
     if (&Apache::lonnet::allowed('vgr',$ENV{'request.course.id'})) {      if (&Apache::lonnet::allowed('vgr',$ENV{'request.course.id'})) {
Line 229  sub xmlparse { Line 234  sub xmlparse {
  &setup_globals($target);   &setup_globals($target);
  #&printalltags();   #&printalltags();
  my @pars = ();   my @pars = ();
  @Apache::lonxml::pwd=();  
  my $pwd=$ENV{'request.filename'};   my $pwd=$ENV{'request.filename'};
  $pwd =~ s:/[^/]*$::;   $pwd =~ s:/[^/]*$::;
  &newparser(\@pars,\$content_file_string,$pwd);   &newparser(\@pars,\$content_file_string,$pwd);
  my $currentstring = '';  
  my $finaloutput = '';   
  my $newarg = '';  
  my $result;  
   
  my $safeeval = new Safe;   my $safeeval = new Safe;
  my $safehole = new Safe::Hole;   my $safehole = new Safe::Hole;
Line 248  sub xmlparse { Line 248  sub xmlparse {
  my @stack = ();    my @stack = (); 
  my @parstack = ();   my @parstack = ();
  &initdepth;   &initdepth;
  my $token;  
  while ( $#pars > -1 ) {  
    while ($token = $pars[$#pars]->get_token) {  
      if (($token->[0] eq 'T') || ($token->[0] eq 'C') || ($token->[0] eq 'D') ) {  
        if ($metamode<1) { $result=$token->[1]; }  
      } elsif ($token->[0] eq 'PI') {  
        if ($metamode<1) { $result=$token->[2]; }  
      } elsif ($token->[0] eq 'S') {  
        # add tag to stack      
        push (@stack,$token->[1]);  
        # add parameters list to another stack  
        push (@parstack,&parstring($token));  
        &increasedepth($token);         
        if (exists $style_for_target{$token->[1]}) {  
  if ($Apache::lonxml::redirection) {  
    $Apache::lonxml::outputstack['-1'] .=    
      &recurse($style_for_target{$token->[1]},$target,$safeeval,  
       \%style_for_target,@parstack);  
  } else {  
    $finaloutput .= &recurse($style_for_target{$token->[1]},$target,  
     $safeeval,\%style_for_target,@parstack);  
  }  
        } else {  
  $result = &callsub("start_$token->[1]", $target, $token, \@stack,  
     \@parstack, \@pars, $safeeval, \%style_for_target);  
        }                
      } elsif ($token->[0] eq 'E')  {  
        #clear out any tags that didn't end  
        while ($token->[1] ne $stack[$#stack] && ($#stack > -1)) {  
  &Apache::lonxml::warning("Unbalanced tags in resource $stack['-1']");  
  pop @stack;pop @parstack;&decreasedepth($token);  
        }  
          
        if (exists $style_for_target{'/'."$token->[1]"}) {  
  if ($Apache::lonxml::redirection) {  
    $Apache::lonxml::outputstack['-1'] .=    
      &recurse($style_for_target{'/'."$token->[1]"},  
       $target,$safeeval,\%style_for_target,@parstack);  
  } else {  
    $finaloutput .= &recurse($style_for_target{'/'."$token->[1]"},  
     $target,$safeeval,\%style_for_target,  
     @parstack);  
  }  
   
        } else {   my $finaloutput = &inner_xmlparse($target,\@stack,\@parstack,\@pars,
  $result = &callsub("end_$token->[1]", $target, $token, \@stack,      $safeeval,\%style_for_target);
     \@parstack, \@pars,$safeeval, \%style_for_target);  
        }  
      } else {  
        &Apache::lonxml::error("Unknown token event :$token->[0]:$token->[1]:");  
      }  
      #evaluate variable refs in result  
      if ($result ne "") {  
        if ( $#parstack > -1 ) {  
  if ($Apache::lonxml::redirection) {  
    $Apache::lonxml::outputstack['-1'] .=   
      &Apache::run::evaluate($result,$safeeval,$parstack[$#parstack]);  
  } else {  
    $finaloutput .= &Apache::run::evaluate($result,$safeeval,  
   $parstack[$#parstack]);  
  }  
        } else {  
  $finaloutput .= &Apache::run::evaluate($result,$safeeval,'');  
        }  
        $result = '';  
      }   
      if ($token->[0] eq 'E') {   
        pop @stack;pop @parstack;&decreasedepth($token);  
      }  
    }  
    pop @pars;  
    pop @Apache::lonxml::pwd;  
  }  
   
 # if ($target eq 'meta') {   return $finaloutput;
 #   $finaloutput.=&endredirection;  }
 # }  
   
   if (($ENV{'QUERY_STRING'}) && ($target eq 'web')) {  sub inner_xmlparse {
       $finaloutput=&afterburn($finaloutput);    my ($target,$stack,$parstack,$pars,$safeeval,$style_for_target)=@_;
     &Apache::lonxml::debug('Reentrant parser starting, again?');
     my $finaloutput = '';
     my $result;
     my $token;
     while ( $#$pars > -1 ) {
       while ($token = $$pars['-1']->get_token) {
         if (($token->[0] eq 'T') || ($token->[0] eq 'C') || ($token->[0] eq 'D') ) {
    if ($metamode<1) {
     $result=$token->[1];
    }
         } elsif ($token->[0] eq 'PI') {
    if ($metamode<1) {
     $result=$token->[2];
    }
         } elsif ($token->[0] eq 'S') {
    # add tag to stack    
    push (@$stack,$token->[1]);
    # add parameters list to another stack
    push (@$parstack,&parstring($token));
    &increasedepth($token);       
    if (exists $$style_for_target{$token->[1]}) {
     if ($Apache::lonxml::redirection) {
       $Apache::lonxml::outputstack['-1'] .=  
         &recurse($$style_for_target{$token->[1]},$target,$safeeval,
          $style_for_target,@$parstack);
     } else {
       $finaloutput .= &recurse($$style_for_target{$token->[1]},$target,
        $safeeval,$style_for_target,@$parstack);
     }
    } else {
     $result = &callsub("start_$token->[1]", $target, $token, $stack,
        $parstack, $pars, $safeeval, $style_for_target);
    }              
         } elsif ($token->[0] eq 'E') {
    #clear out any tags that didn't end
    while ($token->[1] ne $$stack['-1'] && ($#$stack > -1)) {
     &Apache::lonxml::warning("Unbalanced tags in resource $$stack['-1']");
     &end_tag($stack,$parstack,$token);
    }
   
    if (exists $$style_for_target{'/'."$token->[1]"}) {
     if ($Apache::lonxml::redirection) {
       $Apache::lonxml::outputstack['-1'] .=  
         &recurse($$style_for_target{'/'."$token->[1]"},
          $target,$safeeval,$style_for_target,@$parstack);
     } else {
       $finaloutput .= &recurse($$style_for_target{'/'."$token->[1]"},
        $target,$safeeval,$style_for_target,
        @$parstack);
     }
       
    } else {
     $result = &callsub("end_$token->[1]", $target, $token, $stack,
        $parstack, $pars,$safeeval, $style_for_target);
    }
         } else {
    &Apache::lonxml::error("Unknown token event :$token->[0]:$token->[1]:");
         }
         #evaluate variable refs in result
         if ($result ne "") {
    if ( $#$parstack > -1 ) {
     if ($Apache::lonxml::redirection) {
       $Apache::lonxml::outputstack['-1'] .= 
         &Apache::run::evaluate($result,$safeeval,$$parstack['-1']);
     } else {
       $finaloutput .= &Apache::run::evaluate($result,$safeeval,
      $$parstack['-1']);
     }
    } else {
     $finaloutput .= &Apache::run::evaluate($result,$safeeval,'');
    }
    $result = '';
         } 
         if ($token->[0] eq 'E') { 
    &end_tag($stack,$parstack,$token);
         }
       }
       pop @$pars;
       pop @Apache::lonxml::pwd;
   }    }
   
  return $finaloutput;    # if ($target eq 'meta') {
 }    #   $finaloutput.=&endredirection;
     # }
   
     if (($ENV{'QUERY_STRING'}) && ($target eq 'web')) {
       $finaloutput=&afterburn($finaloutput);
     }
     return $finaloutput;
   }
   
 sub recurse {  sub recurse {
     
   my @innerstack = ();     my @innerstack = (); 
   my @innerparstack = ();    my @innerparstack = ();
   my ($newarg,$target,$safeeval,$style_for_target,@parstack) = @_;    my ($newarg,$target,$safeeval,$style_for_target,@parstack) = @_;
Line 363  sub recurse { Line 376  sub recurse {
  while ($tokenpat->[1] ne $innerstack[$#innerstack]    while ($tokenpat->[1] ne $innerstack[$#innerstack] 
        && ($#innerstack > -1)) {         && ($#innerstack > -1)) {
   &Apache::lonxml::warning("Unbalanced tags in resource $innerstack['-1']");    &Apache::lonxml::warning("Unbalanced tags in resource $innerstack['-1']");
   pop @innerstack;pop @innerparstack;&decreasedepth($tokenpat);    &end_tag(\@innerstack,\@innerparstack,$tokenpat);
  }   }
  $partstring = &callsub("end_$tokenpat->[1]", $target, $tokenpat,   $partstring = &callsub("end_$tokenpat->[1]", $target, $tokenpat,
        \@innerstack, \@innerparstack, \@pat,         \@innerstack, \@innerparstack, \@pat,
Line 413  sub callsub { Line 426  sub callsub {
  $sub=~tr/A-Z/a-z/;   $sub=~tr/A-Z/a-z/;
  $space=$Apache::lonxml::alltags{$tag}   $space=$Apache::lonxml::alltags{$tag}
     }      }
     if ($space) {  
       #&Apache::lonxml::debug("Calling sub $sub in $space $metamode<br />\n");      my $deleted=0;
       $sub1="$space\:\:$sub";      $Apache::lonxml::curdepth=join('_',@Apache::lonxml::depthcounter);
       $Apache::lonxml::curdepth=join('_',@Apache::lonxml::depthcounter);      if (($token->[0] eq 'S') && ($target eq 'modified')) {
       ($currentstring,$nodefault) = &$sub1($target,$token,$tagstack,        $deleted=&Apache::edit::handle_delete($space,$target,$token,$tagstack,
    $parstack,$parser,$safeeval,       $parstack,$parser,$safeeval,
    $style);       $style);
     } else {      }
       #&Apache::lonxml::debug("NOT Calling sub $sub in $space $metamode<br />\n");      if (!$deleted) {
       if ($metamode <1) {        if ($space) {
  if (defined($token->[4]) && ($metamode < 1)) {   #&Apache::lonxml::debug("Calling sub $sub in $space $metamode<br />\n");
   $currentstring = $token->[4];   $sub1="$space\:\:$sub";
  } else {   ($currentstring,$nodefault) = &$sub1($target,$token,$tagstack,
   $currentstring = $token->[2];       $parstack,$parser,$safeeval,
        $style);
         } else {
    #&Apache::lonxml::debug("NOT Calling sub $sub in $space $metamode<br />\n");
    if ($metamode <1) {
     if (defined($token->[4]) && ($metamode < 1)) {
       $currentstring = $token->[4];
     } else {
       $currentstring = $token->[2];
     }
  }   }
       }        }
     }        #    &Apache::lonxml::debug("nodefalt:$nodefault:");
 #    &Apache::lonxml::debug("nodefalt:$nodefault:");        if ($currentstring eq '' && $nodefault eq '') {
     if ($currentstring eq '' && $nodefault eq '') {   if ($target eq 'edit') {
       if ($target eq 'edit') {    &Apache::lonxml::debug("doing default edit for $token->[1]");
  &Apache::lonxml::debug("doing default edit for $token->[1]");    if ($token->[0] eq 'S') {
  if ($token->[0] eq 'S') {      $currentstring = &Apache::edit::tag_start($target,$token);
   $currentstring = &Apache::edit::tag_start($target,$token);    } elsif ($token->[0] eq 'E') {
  } elsif ($token->[0] eq 'E') {      $currentstring = &Apache::edit::tag_end($target,$token);
   $currentstring = &Apache::edit::tag_end($target,$token);    }
  }   } elsif ($target eq 'modified') {
       } elsif ($target eq 'modified') {    if ($token->[0] eq 'S') {
  if ($token->[0] eq 'S') {      $currentstring = $token->[4];
   $currentstring = $token->[4];      $currentstring.=&Apache::edit::handle_insert();
   $currentstring.=&Apache::edit::handle_insert();    } else {
  } else {      $currentstring = $token->[2];
   $currentstring = $token->[2];    }
  }   }
       }        }
     }      }
Line 455  sub callsub { Line 477  sub callsub {
   
 sub setup_globals {  sub setup_globals {
   my ($target)=@_;    my ($target)=@_;
     $Apache::lonxml::registered = 0;
     @Apache::lonxml::pwd=();
   if ($target eq 'meta') {    if ($target eq 'meta') {
     $Apache::lonxml::redirection = 0;      $Apache::lonxml::redirection = 0;
     $Apache::lonxml::metamode = 1;      $Apache::lonxml::metamode = 1;
Line 489  sub init_safespace { Line 513  sub init_safespace {
   $safeeval->permit(":base_math");    $safeeval->permit(":base_math");
   $safeeval->permit("sort");    $safeeval->permit("sort");
   $safeeval->deny(":base_io");    $safeeval->deny(":base_io");
     $safehole->wrap(\&Apache::scripttag::xmlparse,$safeeval,'&xmlparse');
   $safehole->wrap(\&Apache::lonnet::EXT,$safeeval,'&EXT');    $safehole->wrap(\&Apache::lonnet::EXT,$safeeval,'&EXT');
       
   $safehole->wrap(\&Math::Cephes::asin,$safeeval,'&asin');    $safehole->wrap(\&Math::Cephes::asin,$safeeval,'&asin');
Line 553  sub endredirection { Line 578  sub endredirection {
   pop @Apache::lonxml::outputstack;    pop @Apache::lonxml::outputstack;
 }  }
   
   sub end_tag {
     my ($tagstack,$parstack,$token)=@_;
     pop(@$tagstack);
     pop(@$parstack);
     &decreasedepth($token);
   }
   
 sub initdepth {  sub initdepth {
   @Apache::lonxml::depthcounter=();    @Apache::lonxml::depthcounter=();
   $Apache::lonxml::depth=-1;    $Apache::lonxml::depth=-1;
Line 894  sub register_insert { Line 926  sub register_insert {
     $tagnum++;      $tagnum++;
   }    }
 }  }
   
   sub description {
     my ($token)=@_;
     return $insertlist{$insertlist{"$token->[1].num"}.'.description'};
   }
 1;  1;
 __END__  __END__
   
Removed from v.1.96  
changed lines
  Added in v.1.102

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