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

Diff for /loncom/xml/lonxml.pm between versions 1.266.2.1 and 1.275

version 1.266.2.1, 2003/08/07 19:31:16 version 1.275, 2003/09/11 22:37:54
Line 69  use Safe::Hole(); Line 69  use Safe::Hole();
 use Math::Cephes();  use Math::Cephes();
 use Math::Random();  use Math::Random();
 use Opcode();  use Opcode();
   use POSIX qw(strftime);
   
   
 sub register {  sub register {
Line 183  sub xmlend { Line 184  sub xmlend {
        }                          }                 
        $crs=~s/\_/\//g;         $crs=~s/\_/\//g;
        my $seeid=&Apache::lonnet::allowed('rin',$crs);         my $seeid=&Apache::lonnet::allowed('rin',$crs);
          my $viewgrades=&Apache::lonnet::allowed('vgr',$crs);
        unless ($symb) {         unless ($symb) {
            $symb=&Apache::lonnet::symbread();             $symb=&Apache::lonnet::symbread();
        }         }
Line 249  sub xmlend { Line 251  sub xmlend {
   $sender='<i>'.$screenname.'</i>';    $sender='<i>'.$screenname.'</i>';
                       }                        }
                   }                    }
   $discussion.='<p><b>'.$sender.'</b> ('.    my $vgrlink;
     if ($viewgrades) {
         $vgrlink=&Apache::loncommon::submlink('Submissions',$contrib{$idx.':sendername'},$contrib{$idx.':senderdomain'},$symb);
     }
     $discussion.='<p><b>'.$sender.'</b> '.$vgrlink.' ('.
                       localtime($contrib{$idx.':timestamp'}).                        localtime($contrib{$idx.':timestamp'}).
                       '):<blockquote>'.$message.                        '):<blockquote>'.$message.
                       '</blockquote></p>';                        '</blockquote></p>';
Line 477  sub htmlclean { Line 483  sub htmlclean {
 }  }
   
 sub latex_special_symbols {  sub latex_special_symbols {
     my ($current_token,$stack,$parstack,$where)=@_;      my ($string,$where)=@_;
     if ($where eq 'header') {      if ($where eq 'header') {
  $current_token =~ s/(\\|_|\^)/ /g;   $string =~ s/(\\|_|\^)/ /g;
  $current_token =~ s/(\$|%|\#|&|\{|\})/\\$1/g;   $string =~ s/(\$|%|\#|&|\{|\})/\\$1/g;
    $string =~ s/_/ /g;
     } else {      } else {
  $current_token=~s/\\ /\\char92 /g;   $string=~s/\\ /\\char92 /g;
  $current_token=~s/\^/\\char94 /g;   $string=~s/\^/\\char94 /g;
  $current_token=~s/\~/\\char126 /g;   $string=~s/\~/\\char126 /g;
  $current_token=~s/(&[^A-Za-z\#])/\\$1/g;   $string=~s/(&[^A-Za-z\#])/\\$1/g;
  $current_token=~s/([^&])\#/$1\\#/g;   $string=~s/([^&])\#/$1\\#/g;
  $current_token=~s/(\$|_|{|})/\\$1/g;   $string=~s/(\$|_|{|})/\\$1/g;
  $current_token=~s/\\char92 /\\texttt{\\char92}/g;   $string=~s/\\char92 /\\texttt{\\char92}/g;
  $current_token=~s/(>|<)/\$$1\$/g; #more or less   $string=~s/(>|<)/\$$1\$/g; #more or less
  if ($current_token=~m/\d%/) {$current_token =~ s/(\d)%/$1\\%/g;} #percent after digit   if ($string=~m/\d%/) {$string =~ s/(\d)%/$1\\%/g;} #percent after digit
  if ($current_token=~m/\s%/) {$current_token =~ s/(\s)%/$1\\%/g;} #persent after space   if ($string=~m/\s%/) {$string =~ s/(\s)%/$1\\%/g;} #percent after space
    if ($string eq '%.') {$string = '\%.';} #percent at the end of statement
     }      }
     return $current_token;      return $string;
 }  }
   
 sub inner_xmlparse {  sub inner_xmlparse {
Line 583  sub inner_xmlparse { Line 591  sub inner_xmlparse {
       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') ) {
   #Style file definitions should be correct    #Style file definitions should be correct
   if ($target eq 'tex' && ($Apache::lonxml::usestyle)) {    if ($target eq 'tex' && ($Apache::lonxml::usestyle)) {
       $result=&latex_special_symbols($result,$stack,$parstack);        $result=&latex_special_symbols($result);
   }    }
       }        }
   
Line 951  sub store_counter { Line 959  sub store_counter {
 }  }
   
 sub get_all_text {  sub get_all_text {
  my($tag,$pars)= @_;      my($tag,$pars,$style)= @_;
  &Apache::lonxml::debug("Got a ".ref($pars));      &Apache::lonxml::debug("Got a ".ref($pars));
  my $gotfullstack=1;      my $gotfullstack=1;
  if (ref($pars) ne 'ARRAY') {      if (ref($pars) ne 'ARRAY') {
      $gotfullstack=0;   $gotfullstack=0;
      $pars=[$pars];   $pars=[$pars];
  }      }
  my $depth=0;      &Apache::lonxml::debug("Got a ".ref($style));
  my $token;      if (ref($style) ne 'HASH') {
  my $result='';   $style={};
  if ( $tag =~ m:^/: ) {       } else {
    my $tag=substr($tag,1);    &Apache::lonhomework::showhash(%$style);
    #&Apache::lonxml::debug("have:$tag:");      }
    my $top_empty=0;      my $depth=0;
    while (($depth >=0) && ($#$pars > -1) && (!$top_empty)) {      my $token;
      while (($depth >=0) && ($token = $$pars[-1]->get_token)) {      my $result='';
        #&Apache::lonxml::debug("e token:$token->[0]:$depth:$token->[1]:".$#$pars.":".$#Apache::lonxml::pwd);      if ( $tag =~ m:^/: ) { 
        if (($token->[0] eq 'T')||($token->[0] eq 'C')||($token->[0] eq 'D')) {   my $tag=substr($tag,1); 
  $result.=$token->[1];   #&Apache::lonxml::debug("have:$tag:");
        } elsif ($token->[0] eq 'PI') {   my $top_empty=0;
  $result.=$token->[2];   while (($depth >=0) && ($#$pars > -1) && (!$top_empty)) {
        } elsif ($token->[0] eq 'S') {      while (($depth >=0) && ($token = $$pars[-1]->get_token)) {
  if ($token->[1] =~ /^$tag$/i) { $depth++; }   #&Apache::lonxml::debug("e token:$token->[0]:$depth:$token->[1]:".$#$pars.":".$#Apache::lonxml::pwd);
  $result.=$token->[4];   if (($token->[0] eq 'T')||($token->[0] eq 'C')||($token->[0] eq 'D')) {
        } elsif ($token->[0] eq 'E')  {      $result.=$token->[1];
  if ( $token->[1] =~ /^$tag$/i) { $depth--; }   } elsif ($token->[0] eq 'PI') {
  #skip sending back the last end tag      $result.=$token->[2];
  if ($depth > -1) { $result.=$token->[2]; } else {   } elsif ($token->[0] eq 'S') {
    $$pars[-1]->unget_token($token);      if ($token->[1] =~ /^$tag$/i) { $depth++; }
  }      if ($token->[1] =~ /^LONCAPA_INTERNAL_TURN_STYLE_ON$/i) { $Apache::lonxml::usestyle=1; }
        }      if ($token->[1] =~ /^LONCAPA_INTERNAL_TURN_STYLE_OFF$/i) { $Apache::lonxml::usestyle=0; }
      }      $result.=$token->[4];
      if (($depth >=0) && ($#$pars == 0) ) { $top_empty=1; }   } elsif ($token->[0] eq 'E')  {
      if (($depth >=0) && ($#$pars > 0) ) {      if ( $token->[1] =~ /^$tag$/i) { $depth--; }
        pop(@$pars);      #skip sending back the last end tag
        pop(@Apache::lonxml::pwd);      if ($depth == 0 && exists($$style{'/'.$token->[1]})) {
      }   my $string=
    }      '<LONCAPA_INTERNAL_TURN_STYLE_OFF end="yes" />'.
    if ($top_empty && $depth >= 0) {   $$style{'/'.$token->[1]}.
        #never found the end tag ran out of text, throw error send back blank      $token->[2].
        &error('Never found end tag for &lt;'.$tag.'&gt;');   '<LONCAPA_INTERNAL_TURN_STYLE_ON />';
        if ($gotfullstack) {   &Apache::lonxml::newparser($pars,\$string);
    my $newstring='</'.$tag.'>'.$result;   #&Apache::lonxml::debug("reParsing $string");
    &Apache::lonxml::newparser($pars,\$newstring);   next;
        }      }
        $result='';      if ($depth > -1) {
    }   $result.=$token->[2];
  } else {      } else {
      while ($#$pars > -1) {   $$pars[-1]->unget_token($token);
  while ($token = $$pars[-1]->get_token) {      }
      #&Apache::lonxml::debug("s token:$token->[0]:$depth:$token->[1]");   }
      if (($token->[0] eq 'T')||($token->[0] eq 'C')||      }
  ($token->[0] eq 'D')) {      if (($depth >=0) && ($#$pars == 0) ) { $top_empty=1; }
  $result.=$token->[1];      if (($depth >=0) && ($#$pars > 0) ) {
      } elsif ($token->[0] eq 'PI') {   pop(@$pars);
  $result.=$token->[2];   pop(@Apache::lonxml::pwd);
      } elsif ($token->[0] eq 'S') {      }
  if ( $token->[1] =~ /^$tag$/i) {   }
      $$pars[-1]->unget_token($token); last;   if ($top_empty && $depth >= 0) {
  } else {      #never found the end tag ran out of text, throw error send back blank
      $result.=$token->[4];      &error('Never found end tag for &lt;'.$tag.
  }     '&gt; current string <pre>'.
      } elsif ($token->[0] eq 'E')  {     &HTML::Entities::encode($result).
  $result.=$token->[2];     '</pre>');
      }      if ($gotfullstack) {
  }   my $newstring='</'.$tag.'>'.$result;
  if (($#$pars > 0) ) {   &Apache::lonxml::newparser($pars,\$newstring);
      pop(@$pars);      }
      pop(@Apache::lonxml::pwd);      $result='';
  } else { last; }   }
      }      } else {
  }   while ($#$pars > -1) {
  if ($result =~ m|<LONCAPA_INTERNAL_TURN_STYLE_ON />|) {      while ($token = $$pars[-1]->get_token) {
      $Apache::lonxml::usestyle=1;   #&Apache::lonxml::debug("s token:$token->[0]:$depth:$token->[1]");
  }   if (($token->[0] eq 'T')||($token->[0] eq 'C')||
  #&Apache::lonxml::debug("Exit:$result:");      ($token->[0] eq 'D')) {
  return $result      $result.=$token->[1];
    } elsif ($token->[0] eq 'PI') {
       $result.=$token->[2];
    } elsif ($token->[0] eq 'S') {
       if ( $token->[1] =~ /^$tag$/i) {
    $$pars[-1]->unget_token($token); last;
       } else {
    $result.=$token->[4];
       }
       if ($token->[1] =~ /^LONCAPA_INTERNAL_TURN_STYLE_ON$/i) { $Apache::lonxml::usestyle=1; }
       if ($token->[1] =~ /^LONCAPA_INTERNAL_TURN_STYLE_OFF$/i) { $Apache::lonxml::usestyle=0; }
    } elsif ($token->[0] eq 'E')  {
       $result.=$token->[2];
    }
       }
       if (($#$pars > 0) ) {
    pop(@$pars);
    pop(@Apache::lonxml::pwd);
       } else { last; }
    }
       }
       #&Apache::lonxml::debug("Exit:$result:");
       return $result
 }  }
   
 sub newparser {  sub newparser {
Line 1049  sub parstring { Line 1079  sub parstring {
       my $val=$token->[2]->{$_};        my $val=$token->[2]->{$_};
       $val =~ s/([\%\@\\\"\'])/\\$1/g;        $val =~ s/([\%\@\\\"\'])/\\$1/g;
       #if ($val =~ m/^[\%\@]/) { $val="\\".$val; }        #if ($val =~ m/^[\%\@]/) { $val="\\".$val; }
       $temp .= "my \$$_=\"$val\";"        $temp .= "my \$$_=\"$val\";";
     }      }
   }    }
   return $temp;    return $temp;
Line 1114  sub storefile { Line 1144  sub storefile {
     if (my $fh=Apache::File->new('>'.$file)) {      if (my $fh=Apache::File->new('>'.$file)) {
  print $fh $contents;   print $fh $contents;
         $fh->close();          $fh->close();
           return 1;
     } else {      } else {
       &warning("Unable to save file $file");   &warning("Unable to save file $file");
    return 0;
     }      }
 }  }
   
Line 1137  SIMPLECONTENT Line 1169  SIMPLECONTENT
   return $filecontents;    return $filecontents;
 }  }
   
   sub createnewsty {
     my $filecontents=(<<SIMPLECONTENT);
   <definetag name="">
       <render>
          <web></web>
          <tex></tex>
       </render>
   </definetag>
   SIMPLECONTENT
     return $filecontents;
   }
   
   
 sub inserteditinfo {  sub inserteditinfo {
       my ($result,$filecontents)=@_;        my ($result,$filecontents,$filetype)=@_;
       $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 = Apache::loncommon::helpLatexCheatsheet();        my $xml_help = '';
         if ($filetype eq 'html') {
     $xml_help=Apache::loncommon::helpLatexCheatsheet();
         }
         my $cleanbut = '';
         if ($filetype eq 'html') {
     $cleanbut='<input type="submit" name="attemptclean" 
                          value="Save and then attempt to clean HTML" />';
         }
       my $titledisplay=&display_title();        my $titledisplay=&display_title();
       my $buttons=(<<BUTTONS);        my $buttons=(<<BUTTONS);
 <input type="submit" name="attemptclean"   $cleanbut
        value="Save and then attempt to clean HTML" />  
 <input type="submit" name="savethisfile" value="Save this" />  <input type="submit" name="savethisfile" value="Save this" />
 <input type="submit" name="viewmode" value="View" />  <input type="submit" name="viewmode" value="View" />
 BUTTONS  BUTTONS
Line 1214  sub handler { Line 1265  sub handler {
   
   
     my $file=&Apache::lonnet::filelocation("",$request->uri);      my $file=&Apache::lonnet::filelocation("",$request->uri);
       my $filetype;
       if ($file =~ /\.sty$/) {
    $filetype='sty';
       } else {
    $filetype='html';
       }
 #  #
 # 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'});      if (&storefile($file,$ENV{'form.filecont'})) {
    $request->print("<font COLOR=\"#0000FF\">Updated: ". strftime("%d %b %H:%M:%S",localtime())." </font>");
       } 
  }   }
     }      }
     my %mystyle;      my %mystyle;
Line 1238  sub handler { Line 1297  sub handler {
 ENDNOTFOUND  ENDNOTFOUND
     $filecontents='';      $filecontents='';
  if ($ENV{'request.state'} ne 'published') {   if ($ENV{'request.state'} ne 'published') {
     $filecontents=&createnewhtml();      if ($filetype eq 'sty') {
    $filecontents=&createnewsty();
       } else {
    $filecontents=&createnewhtml();
       }
     $ENV{'form.editmode'}='Edit'; #force edit mode      $ENV{'form.editmode'}='Edit'; #force edit mode
  }   }
     } else {      } else {
Line 1266  ENDNOTFOUND Line 1329  ENDNOTFOUND
     $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,$filetype);
  }   }
     }      }
           if ($filetype eq 'html') { writeallows($request->uri); }
     writeallows($request->uri);  
           
   
     $request->print($result);      $request->print($result);
Line 1392  sub register_insert { Line 1455  sub register_insert {
     my $line = $data[$i];      my $line = $data[$i];
     if ( $line =~ /^\#/ || $line =~ /^\s*\n/) { next; }      if ( $line =~ /^\#/ || $line =~ /^\s*\n/) { next; }
     if ( $line =~ /TABLE/ ) { last; }      if ( $line =~ /TABLE/ ) { last; }
     my ($tag,$descrip,$color,$function,$show) = split(/,/, $line);      my ($tag,$descrip,$color,$function,$show,$helpfile,$helpdesc) = split(/,/, $line);
     if ($tag) {      if ($tag) {
       $insertlist{"$tagnum.tag"} = $tag;        $insertlist{"$tagnum.tag"} = $tag;
       $insertlist{"$tagnum.description"} = $descrip;        $insertlist{"$tagnum.description"} = $descrip;
Line 1400  sub register_insert { Line 1463  sub register_insert {
       $insertlist{"$tagnum.function"} = $function;        $insertlist{"$tagnum.function"} = $function;
       if (!defined($show)) { $show='yes'; }        if (!defined($show)) { $show='yes'; }
       $insertlist{"$tagnum.show"}= $show;        $insertlist{"$tagnum.show"}= $show;
         $insertlist{"$tagnum.helpfile"} = $helpfile;
         $insertlist{"$tagnum.helpdesc"} = $helpdesc;
       $insertlist{"$tag.num"}=$tagnum;        $insertlist{"$tag.num"}=$tagnum;
       $tagnum++;        $tagnum++;
     }      }
Line 1434  sub description { Line 1499  sub description {
   return $insertlist{$tagnum.'.description'};    return $insertlist{$tagnum.'.description'};
 }  }
   
   # Returns a list containing the help file, and the description
   sub helpinfo {
     my ($token)=@_;
     my $tagnum;
     my $tag=$token->[1];
     foreach my $namespace (reverse @Apache::lonxml::namespace) {
       my $testtag=$namespace.'::'.$tag;
       $tagnum=$insertlist{"$testtag.num"};
       if (defined($tagnum)) { last; }
     }
     if (!defined ($tagnum)) { $tagnum=$Apache::lonxml::insertlist{"$tag.num"}; }
     return ($insertlist{$tagnum.'.helpfile'}, $insertlist{$tagnum.'.helpdesc'});
   }
   
 # ----------------------------------------------------------------- whichuser  # ----------------------------------------------------------------- whichuser
 # returns a list of $symb, $courseid, $domain, $name that is correct for  # returns a list of $symb, $courseid, $domain, $name that is correct for
 # calls to lonnet functions for this setup.  # calls to lonnet functions for this setup.
Removed from v.1.266.2.1  
changed lines
  Added in v.1.275

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