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

Diff for /loncom/xml/lonxml.pm between versions 1.252 and 1.266.2.2

version 1.252, 2003/05/16 18:34:56 version 1.266.2.2, 2003/09/27 04:15:26
Line 70  use Math::Cephes(); Line 70  use Math::Cephes();
 use Math::Random();  use Math::Random();
 use Opcode();  use Opcode();
   
   
 sub register {  sub register {
   my ($space,@taglist) = @_;    my ($space,@taglist) = @_;
   foreach my $temptag (@taglist) {    foreach my $temptag (@taglist) {
Line 95  use Apache::run(); Line 96  use Apache::run();
 use Apache::londefdef();  use Apache::londefdef();
 use Apache::scripttag();  use Apache::scripttag();
 use Apache::edit();  use Apache::edit();
   use Apache::inputtags();
   use Apache::outputtags();
 use Apache::lonnet();  use Apache::lonnet();
 use Apache::File();  use Apache::File();
 use Apache::loncommon();  use Apache::loncommon();
Line 151  $Apache::lonxml::counter_changed=0; Line 154  $Apache::lonxml::counter_changed=0;
 #internal check on whether to look at style defs  #internal check on whether to look at style defs
 $Apache::lonxml::usestyle=1;  $Apache::lonxml::usestyle=1;
   
   #locations used to store the parameter string for style substitutions
   $Apache::lonxml::style_values='';
   $Apache::lonxml::style_end_values='';
   
   #array of ssi calls that need to occur after we are done parsing
   @Apache::lonxml::ssi_info=();
   
 sub xmlbegin {  sub xmlbegin {
   my $output='';    my $output='';
   if ($ENV{'browser.mathml'}) {    if ($ENV{'browser.mathml'}) {
Line 382  sub fontsettings() { Line 392  sub fontsettings() {
     if (($ENV{'browser.os'} eq 'mac') && (!$ENV{'browser.mathml'})) {       if (($ENV{'browser.os'} eq 'mac') && (!$ENV{'browser.mathml'})) { 
  $headerstring.=   $headerstring.=
     '<meta Content-Type="text/html; charset=x-mac-roman">';      '<meta Content-Type="text/html; charset=x-mac-roman">';
     } elsif (!$ENV{'browser.mathml'}) {      } elsif (!$ENV{'browser.mathml'} && $ENV{'browser.unicode'}) {
  $headerstring.=   $headerstring.=
     '<meta http-equiv="Content-Type" content="text/html; charset=utf-8" />';      '<meta http-equiv="Content-Type" content="text/html; charset=utf-8" />';
     }      }
Line 421  sub xmlparse { Line 431  sub xmlparse {
        }         }
     }      }
  }   }
   #&printalltags();
  #&printalltags();  
  my @pars = ();   my @pars = ();
  my $pwd=$ENV{'request.filename'};   my $pwd=$ENV{'request.filename'};
  $pwd =~ s:/[^/]*$::;   $pwd =~ s:/[^/]*$::;
Line 441  sub xmlparse { Line 450  sub xmlparse {
   
  my $finaloutput = &inner_xmlparse($target,\@stack,\@parstack,\@pars,   my $finaloutput = &inner_xmlparse($target,\@stack,\@parstack,\@pars,
    $safeeval,\%style_for_target);     $safeeval,\%style_for_target);
   
  if ($ENV{'request.uri'}) {   if ($ENV{'request.uri'}) {
     &writeallows($ENV{'request.uri'});      &writeallows($ENV{'request.uri'});
  }   }
    &do_registered_ssi();
  if ($Apache::lonxml::counter_changed) { &store_counter() }   if ($Apache::lonxml::counter_changed) { &store_counter() }
  return $finaloutput;   return $finaloutput;
 }  }
Line 494  sub inner_xmlparse { Line 505  sub inner_xmlparse {
   my $finaloutput = '';    my $finaloutput = '';
   my $result;    my $result;
   my $token;    my $token;
     my $dontpop=0;
   while ( $#$pars > -1 ) {    while ( $#$pars > -1 ) {
     while ($token = $$pars['-1']->get_token) {      while ($token = $$pars['-1']->get_token) {
       if (($token->[0] eq 'T') || ($token->[0] eq 'C') || ($token->[0] eq 'D') ) {        if (($token->[0] eq 'T') || ($token->[0] eq 'C') ) {
  if ($metamode<1) {   if ($metamode<1) {
     my $text=$token->[1];      my $text=$token->[1];
     if ($token->[0] eq 'C' && $target eq 'tex') {      if ($token->[0] eq 'C' && $target eq 'tex') {
Line 505  sub inner_xmlparse { Line 517  sub inner_xmlparse {
     }      }
     $result.=$text;      $result.=$text;
  }   }
         } elsif (($token->[0] eq 'D')) {
    if ($metamode<1 && $target eq 'web') {
       my $text=$token->[1];
       $result.=$text;
    }
       } elsif ($token->[0] eq 'PI') {        } elsif ($token->[0] eq 'PI') {
  if ($metamode<1) {   if ($metamode<1 && $target eq 'web') {
   $result=$token->[2];    $result=$token->[2];
  }   }
       } elsif ($token->[0] eq 'S') {        } elsif ($token->[0] eq 'S') {
Line 521  sub inner_xmlparse { Line 538  sub inner_xmlparse {
     my $string=$$style_for_target{$token->[1]}.      my $string=$$style_for_target{$token->[1]}.
       '<LONCAPA_INTERNAL_TURN_STYLE_ON />';        '<LONCAPA_INTERNAL_TURN_STYLE_ON />';
     &Apache::lonxml::newparser($pars,\$string);      &Apache::lonxml::newparser($pars,\$string);
       $Apache::lonxml::style_values=$$parstack[-1];
       $Apache::lonxml::style_end_values=$$parstack[-1];
  } else {   } else {
   $result = &callsub("start_$token->[1]", $target, $token, $stack,    $result = &callsub("start_$token->[1]", $target, $token, $stack,
      $parstack, $pars, $safeeval, $style_for_target);       $parstack, $pars, $safeeval, $style_for_target);
  }   }
       } elsif ($token->[0] eq 'E') {        } elsif ($token->[0] eq 'E') {
  #clear out any tags that didn't end  
  while ($token->[1] ne $$stack['-1'] && ($#$stack > -1)) {  
   my $lasttag=$$stack[-1];  
   if ($token->[1] =~ /^$lasttag$/i) {  
     &Apache::lonxml::warning('Using tag &lt;/'.$token->[1].'&gt; on line '.$token->[3].' as end tag to &lt;'.$$stack[-1].'&gt;');  
     last;  
   } else {  
     &Apache::lonxml::warning('Found tag &lt;/'.$token->[1].'&gt; on line '.$token->[3].' when looking for &lt;/'.$$stack[-1].'&gt; in file');  
     &end_tag($stack,$parstack,$token);  
   }  
  }  
   
  if ($Apache::lonxml::usestyle &&   if ($Apache::lonxml::usestyle &&
     exists($$style_for_target{'/'."$token->[1]"})) {      exists($$style_for_target{'/'."$token->[1]"})) {
     $Apache::lonxml::usestyle=0;      $Apache::lonxml::usestyle=0;
     my $string=$$style_for_target{'/'.$token->[1]}.      my $string=$$style_for_target{'/'.$token->[1]}.
       '<LONCAPA_INTERNAL_TURN_STYLE_ON />';        '<LONCAPA_INTERNAL_TURN_STYLE_ON end="'.$token->[1].'" />';
     &Apache::lonxml::newparser($pars,\$string);      &Apache::lonxml::newparser($pars,\$string);
       $Apache::lonxml::style_values=$Apache::lonxml::style_end_values;
       $Apache::lonxml::style_end_values='';
       $dontpop=1;
  } else {   } else {
   $result = &callsub("end_$token->[1]", $target, $token, $stack,      #clear out any tags that didn't end
      $parstack, $pars,$safeeval, $style_for_target);      while ($token->[1] ne $$stack['-1'] && ($#$stack > -1)) {
    my $lasttag=$$stack[-1];
    if ($token->[1] =~ /^$lasttag$/i) {
       &Apache::lonxml::warning('Using tag &lt;/'.$token->[1].'&gt; on line '.$token->[3].' as end tag to &lt;'.$$stack[-1].'&gt;');
       last;
    } else {
       &Apache::lonxml::warning('Found tag &lt;/'.$token->[1].'&gt; on line '.$token->[3].' when looking for &lt;/'.$$stack[-1].'&gt; in file');
       &end_tag($stack,$parstack,$token);
    }
       }
       $result = &callsub("end_$token->[1]", $target, $token, $stack,
          $parstack, $pars,$safeeval, $style_for_target);
  }   }
       } else {        } else {
  &Apache::lonxml::error("Unknown token event :$token->[0]:$token->[1]:");   &Apache::lonxml::error("Unknown token event :$token->[0]:$token->[1]:");
       }        }
       #evaluate variable refs in result        #evaluate variable refs in result
       if ($result ne "") {        if ($result ne "") {
     my $extras;
     if (!$Apache::lonxml::usestyle) {
         $extras=$Apache::lonxml::style_values;
     }
  if ( $#$parstack > -1 ) {   if ( $#$parstack > -1 ) {
   $result=&Apache::run::evaluate($result,$safeeval,$$parstack[-1]);    $result=&Apache::run::evaluate($result,$safeeval,$extras.$$parstack[-1]);
  } else {   } else {
   $result= &Apache::run::evaluate($result,$safeeval,'');    $result= &Apache::run::evaluate($result,$safeeval,$extras);
  }   }
       }        }
       if (($token->[0] eq 'T') || ($token->[0] eq 'C') || ($token->[0] eq 'D') ) {        if (($token->[0] eq 'T') || ($token->[0] eq 'C') || ($token->[0] eq 'D') ) {
Line 577  sub inner_xmlparse { Line 602  sub inner_xmlparse {
       }        }
       $result = '';        $result = '';
   
       if ($token->[0] eq 'E') {         if ($token->[0] eq 'E' && !$dontpop) {
  &end_tag($stack,$parstack,$token);   &end_tag($stack,$parstack,$token);
       }        }
         $dontpop=0;
     }      }
     if ($#$pars > -1) {      if ($#$pars > -1) {
  pop @$pars;   pop @$pars;
Line 677  sub setup_globals { Line 703  sub setup_globals {
   &init_counter();    &init_counter();
   @Apache::lonxml::pwd=();    @Apache::lonxml::pwd=();
   @Apache::lonxml::extlinks=();    @Apache::lonxml::extlinks=();
     @Apache::lonxml::ssi_info=();
   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 1017  sub newparser { Line 1044  sub newparser {
   } else {    } else {
     push (@Apache::lonxml::pwd, $dir);      push (@Apache::lonxml::pwd, $dir);
   }     } 
 #  &Apache::lonxml::debug("pwd:$#Apache::lonxml::pwd");  
 #  &Apache::lonxml::debug("pwd:$Apache::lonxml::pwd[$#Apache::lonxml::pwd]");  
 }  }
   
 sub parstring {  sub parstring {
Line 1052  sub writeallows { Line 1077  sub writeallows {
     &Apache::lonnet::appenv(%httpref);      &Apache::lonnet::appenv(%httpref);
 }  }
   
   sub register_ssi {
       my ($url,%form)=@_;
       push (@Apache::lonxml::ssi_info,{'url'=>$url,'form'=>\%form});
       return '';
   }
   
   sub do_registered_ssi {
       foreach my $info (@Apache::lonxml::ssi_info) {
    my %form=%{ $info->{'form'}};
    my $url=$info->{'url'};
    &Apache::lonnet::ssi($url,%form);
       }
   }
 #  #
 # Afterburner handles anchors, highlights and links  # Afterburner handles anchors, highlights and links
 #  #
Line 1122  sub inserteditinfo { Line 1160  sub inserteditinfo {
       my ($result,$filecontents)=@_;        my ($result,$filecontents)=@_;
       $filecontents = &HTML::Entities::encode($filecontents);        $filecontents = &HTML::Entities::encode($filecontents);
 #      my $editheader='<a href="#editsection">Edit below</a><hr />';  #      my $editheader='<a href="#editsection">Edit below</a><hr />';
       my $xml_help = '<table><tr><td>'.        my $xml_help = Apache::loncommon::helpLatexCheatsheet();
   &Apache::loncommon::help_open_topic("Greek_Symbols",'Greek Symbols',        my $titledisplay=&display_title();
       undef,undef,600)  
       .'</td><td>'.  
           &Apache::loncommon::help_open_topic("Other_Symbols",'Other Symbols',  
       undef,undef,600)  
       .'</td></tr></table>';  
       my $buttons=(<<BUTTONS);        my $buttons=(<<BUTTONS);
 <input type="submit" name="attemptclean"   <input type="submit" name="attemptclean" 
        value="Save and then attempt to clean HTML" />         value="Save and then attempt to clean HTML" />
Line 1146  $buttons<br /> Line 1179  $buttons<br />
 <br />$buttons  <br />$buttons
 <br />  <br />
 </form>  </form>
   $titledisplay
 ENDFOOTER  ENDFOOTER
 #      $result=~s/(\<body[^\>]*\>)/$1$editheader/is;  #      $result=~s/(\<body[^\>]*\>)/$1$editheader/is;
       $result=~s/(\<\/body\>)/$editfooter/is;        $result=~s/(\<\/body\>)/$editfooter/is;
Line 1180  sub get_target { Line 1214  sub get_target {
 }  }
   
 sub handler {  sub handler {
   my $request=shift;      my $request=shift;
       
   my $target=&get_target();      my $target=&get_target();
       
   $Apache::lonxml::debug=0;      $Apache::lonxml::debug=$ENV{'user.debug'};
       
   if ($ENV{'browser.mathml'}) {      if ($ENV{'browser.mathml'}) {
     $request->content_type('text/xml');   $request->content_type('text/xml');
   } else {      } else {
     $request->content_type('text/html');   $request->content_type('text/html');
   }      }
   &Apache::loncommon::no_cache($request);      &Apache::loncommon::no_cache($request);
   $request->send_http_header;      $request->send_http_header;
       
   return OK if $request->header_only;      return OK if $request->header_only;
   
   
   my $file=&Apache::lonnet::filelocation("",$request->uri);      my $file=&Apache::lonnet::filelocation("",$request->uri);
 #  #
 # Edit action? Save file.  # Edit action? Save file.
 #  #
   unless ($ENV{'request.state'} eq 'published') {      unless ($ENV{'request.state'} eq 'published') {
       if (($ENV{'form.savethisfile'}) || ($ENV{'form.attemptclean'})) {   if (($ENV{'form.savethisfile'}) || ($ENV{'form.attemptclean'})) {
   &storefile($file,$ENV{'form.filecont'});      &storefile($file,$ENV{'form.filecont'});
       }   }
   }      }
   my %mystyle;      my %mystyle;
   my $result = '';      my $result = '';
   my $filecontents=&Apache::lonnet::getfile($file);      my $filecontents=&Apache::lonnet::getfile($file);
   if ($filecontents eq -1) {      if ($filecontents eq -1) {
     $result=(<<ENDNOTFOUND);   $result=(<<ENDNOTFOUND);
 <html>  <html>
 <head>  <head>
 <title>File not found</title>  <title>File not found</title>
Line 1221  sub handler { Line 1255  sub handler {
 </html>  </html>
 ENDNOTFOUND  ENDNOTFOUND
     $filecontents='';      $filecontents='';
     if ($ENV{'request.state'} ne 'published') {   if ($ENV{'request.state'} ne 'published') {
       $filecontents=&createnewhtml();      $filecontents=&createnewhtml();
       $ENV{'form.editmode'}='Edit'; #force edit mode      $ENV{'form.editmode'}='Edit'; #force edit mode
     }   }
   } else {      } else {
     unless ($ENV{'request.state'} eq 'published') {   unless ($ENV{'request.state'} eq 'published') {
       if ($ENV{'form.attemptclean'}) {      if ($ENV{'form.attemptclean'}) {
  $filecontents=&htmlclean($filecontents,1);   $filecontents=&htmlclean($filecontents,1);
       }      }
     }  #
     if (!$ENV{'form.editmode'} || $ENV{'form.viewmode'}) {  # we are in construction space, see if edit mode forced
       $result = &Apache::lonxml::xmlparse($request,$target,$filecontents,              &Apache::loncommon::get_unprocessed_cgi
   '',%mystyle);                            ($ENV{'QUERY_STRING'},['editmode']);
    }
    if (!$ENV{'form.editmode'} || $ENV{'form.viewmode'}) {
       $result = &Apache::lonxml::xmlparse($request,$target,$filecontents,
    '',%mystyle);
    }
     }      }
   }      
   
 #  #
 # Edit action? Insert editing commands  # Edit action? Insert editing commands
 #  #
   unless ($ENV{'request.state'} eq 'published') {      unless ($ENV{'request.state'} eq 'published') {
     if ($ENV{'form.editmode'} && (!($ENV{'form.viewmode'}))) {   if ($ENV{'form.editmode'} && (!($ENV{'form.viewmode'}))) {
  my $displayfile=$request->uri;      my $displayfile=$request->uri;
         $displayfile=~s/^\/[^\/]*//;      $displayfile=~s/^\/[^\/]*//;
       $result='<html><body bgcolor="#FFFFFF"><h3>'.$displayfile.      $result='<html><body bgcolor="#FFFFFF"><h3>'.$displayfile.
               '</h3></body></html>';   '</h3></body></html>';
       $result=&inserteditinfo($result,$filecontents);      $result=&inserteditinfo($result,$filecontents);
    }
     }      }
   }      
       writeallows($request->uri);
   writeallows($request->uri);      
   
   # If we're editing, show the filename of the resource in the frame's main      $request->print($result);
   # title      
   if ($ENV{'form.editmode'}) {      return OK;
       my $filename = $request->uri;  }
       # Everything after the last /  
       $filename = substr($filename, rindex($filename, '/') + 1);  sub display_title {
       $result = substr($result, 0, rindex($result, '</html>'));      my $result;
       $result .= "<script>top.document.title = '$filename - LON-CAPA Construction Space';</script>";      if ($ENV{'request.state'} eq 'construct') {
       $result .= "\n</html>\n";   my $title=&Apache::lonnet::gettitle();
   }   if (!defined($title) || $title eq '') {
       $title = $ENV{'request.filename'};
       $title = substr($title, rindex($title, '/') + 1);
   $request->print($result);   }
    $result = "<script type='text/javascript'>top.document.title = '$title - LON-CAPA Construction Space';</script>";
   return OK;      }
       return $result;
 }  }
   
 sub debug {  sub debug {
Line 1304  sub error { Line 1344  sub error {
   
 sub warning {  sub warning {
   $warningcount++;    $warningcount++;
   if ($ENV{'request.state'} eq 'construct') {    
     print "<b>W</b>ARNING<b>:</b>".join('<br />',@_)."<br />\n";    if ($ENV{'form.grade_target'} ne 'tex') {
         if ($ENV{'request.state'} eq 'construct' || $Apache::lonxml::debug) {
           print "<b>W</b>ARNING<b>:</b>".join('<br />',@_)."<br />\n";
         }
   }    }
 }  }
   
Line 1414  sub description { Line 1457  sub description {
 # calls to lonnet functions for this setup.  # calls to lonnet functions for this setup.
 # - looks for form.grade_ parameters  # - looks for form.grade_ parameters
 sub whichuser {  sub whichuser {
     my ($passedsymb)=@_;
   my ($symb,$courseid,$domain,$name,$publicuser);    my ($symb,$courseid,$domain,$name,$publicuser);
   if (defined($ENV{'form.grade_symb'})) {    if (defined($ENV{'form.grade_symb'})) {
     my $tmp_courseid=$ENV{'form.grade_courseid'};      my $tmp_courseid=$ENV{'form.grade_courseid'};
     my $allowed=&Apache::lonnet::allowed('mgr',$tmp_courseid);      my $allowed=&Apache::lonnet::allowed('vgr',$tmp_courseid);
     if ($allowed) {      if ($allowed) {
       $symb=$ENV{'form.grade_symb'};        $symb=$ENV{'form.grade_symb'};
       $courseid=$ENV{'form.grade_courseid'};        $courseid=$ENV{'form.grade_courseid'};
Line 1425  sub whichuser { Line 1469  sub whichuser {
       $name=$ENV{'form.grade_username'};        $name=$ENV{'form.grade_username'};
     }      }
   } else {    } else {
       $symb=&Apache::lonnet::symbread();        if (!$passedsymb) {
             $symb=&Apache::lonnet::symbread();
         } else {
             $symb=$passedsymb;
         }
       $courseid=$ENV{'request.course.id'};        $courseid=$ENV{'request.course.id'};
       $domain=$ENV{'user.domain'};        $domain=$ENV{'user.domain'};
       $name=$ENV{'user.name'};        $name=$ENV{'user.name'};
Removed from v.1.252  
changed lines
  Added in v.1.266.2.2

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