Diff for /loncom/xml/scripttag.pm between versions 1.11 and 1.92

version 1.11, 2000/08/11 15:22:00 version 1.92, 2003/06/04 22:30:00
Line 1 Line 1
 # The LearningOnline Network with CAPA  # The LearningOnline Network with CAPA
 # <script> definiton  # <script> definiton
   #
   # $Id$
   #
   # Copyright Michigan State University Board of Trustees
   #
   # This file is part of the LearningOnline Network with CAPA (LON-CAPA).
   #
   # LON-CAPA is free software; you can redistribute it and/or modify
   # it under the terms of the GNU General Public License as published by
   # the Free Software Foundation; either version 2 of the License, or
   # (at your option) any later version.
   #
   # LON-CAPA is distributed in the hope that it will be useful,
   # but WITHOUT ANY WARRANTY; without even the implied warranty of
   # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
   # GNU General Public License for more details.
   #
   # You should have received a copy of the GNU General Public License
   # along with LON-CAPA; if not, write to the Free Software
   # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
   #
   # /home/httpd/html/adm/gpl.txt
   #
   # http://www.lon-capa.org/
   #
   # 2/21 Guy
   # 8/20 Gerd Kortemeyer
   
   package Apache::scripttag;
 package Apache::scripttag;   
   
 use strict;  use strict;
 use Apache::lonnet;  use Apache::lonnet;
   use Apache::style;
   
   #Globals
   # this used to pass around the standard callsub arguments to a tag func
   # so xmlparse can reenter the inner_xmlparse loop.
   
   @Apache::scripttag::parser_env = ();
   BEGIN {
     &Apache::lonxml::register('Apache::scripttag',
       ('script','scriptlib','parserlib','import',
        'window','display','storetc','physnet',
        'standalone','comment',
        'LONCAPA_INTERNAL_TURN_STYLE_ON',
        'LONCAPA_INTERNAL_LONHTTPD_PORT'));
   }
   
   sub start_LONCAPA_INTERNAL_TURN_STYLE_ON {
       $Apache::lonxml::usestyle=1;
       $Apache::lonxml::style_values='';
       return ('','no');
   }
   
   sub end_LONCAPA_INTERNAL_TURN_STYLE_ON {
       my ($target,$token,$tagstack,$parstack,$parser,$safeeval)=@_;
       my $end=&Apache::lonxml::get_param('end',$parstack,$safeeval);
       if (defined($end)) {
    &Apache::lonxml::end_tag($tagstack,$parstack,$token);
       }
       return ('','no');
   }
   
   sub start_LONCAPA_INTERNAL_LONHTTPD_PORT {
       my ($target,$token,$tagstack,$parstack,$parser,$safeeval)=@_;
       if ($target eq 'web') {
    my $lonhttpdPort=$Apache::lonnet::perlvar{'lonhttpdPort'};
    if (!defined($lonhttpdPort)) { $lonhttpdPort='8080'; }
    return '<script type="text/javascript">var lonhttpdport=\''.
       $lonhttpdPort.'\';</script>';
       }
       return ('','no');
   }
   
 sub BEGIN {  sub end_LONCAPA_INTERNAL_LONHTTPD_PORT {
   &Apache::lonxml::register('Apache::scripttag',('script','scriptlib',      return ('','no');
  'parserlib','import'));  
 }  }
   
 sub start_script {  sub start_script {
   my ($target,$token,$parstack,$parser,$safeeval)=@_;    my ($target,$token,$tagstack,$parstack,$parser,$safeeval)=@_;
   my $result="";    @Apache::scripttag::parser_env = @_;
   my $bodytext=$$parser[$#$parser]->get_text("/script");    my $result='';
   if ($target ne "edit" ) {    my $type= &Apache::lonxml::get_param('type',$parstack,$safeeval);
     $result = &Apache::run::run($bodytext,$safeeval);    &Apache::lonxml::debug("found type of $type");
     if ($type eq "loncapa/perl") {
       my $bodytext=&Apache::lonxml::get_all_text("/script",$parser);
       if ( $target eq "modified" ) {
         $result=$token->[4].&Apache::edit::modifiedfield();
       } elsif ( $target eq 'web' || $target eq 'tex' ||
         $target eq 'grade' || $target eq 'answer' ||
         $target eq 'analyze' ) {
    if (!$Apache::lonxml::default_homework_loaded) {
       &Apache::lonxml::default_homework_load($safeeval);
    }
    &Apache::run::run($bodytext,$safeeval);
    if (($target eq 'answer') &&
       ($ENV{'form.answer_output_mode'} ne 'tex') &&
       ($Apache::lonhomework::viewgrades == 'F')) {
       $Apache::lonxml::evaluate--;
       $result.="<a href=\"javascript:newWindow=open(\'\',\'new_W\',\'width=500,height=200,scrollbars=1\');newWindow.document.open(\'text/html\',\'replace\');newWindow.document.writeln(\'&lt;html&gt;&lt;head&gt;&lt;title&gt;newwindow&lt;/title&gt;&lt;/head&gt;&lt;body bgcolor=&quot;#FFFFFF&quot;&gt;&lt;pre&gt;";
       my $listing= &HTML::Entities::encode(&Apache::run::dump($target,$safeeval));
   
       $result.=$listing;
       $result.= "&lt;/pre&gt;&lt;/body&gt;&lt;/html&gt;\');newWindow.document.close();void(0);\">Script Vars</a><br />";
    }
       } elsif ($target eq "edit" ) {
         #&Apache::run::run($bodytext,$safeeval);
         #$result="<br /> &lt;$token->[1]&gt; output: <br />$bodytext<br />Source:<br />";
         $result=&Apache::edit::tag_start($target,$token,'Script');
         $result.=&Apache::edit::editfield($token->[1],$bodytext,'',80,4);
       }
   } else {    } else {
     $result=&editfield($token->[1],$bodytext);      if ($target ne "meta") {
         $result = $token->[4];
         my $bodytext=&Apache::lonxml::get_all_text("/script",$parser);
         $result.=$bodytext;
       }
   }    }
   return $result;    return $result;
 }  }
   
 sub end_script {}  sub end_script {
     my ($target,$token,$tagstack,$parstack,$parser,$safeeval)=@_;
     if ( $target eq "meta" ) { return ''; } 
     my $type = &Apache::lonxml::get_param('type',$parstack,$safeeval);
     my $result='';
     #other script blocks need to survive
     if ($type ne "loncapa/perl") {
       return $token->[2];
     } elsif ($target eq 'edit' ) {
       return &Apache::edit::end_table();
     } elsif ($target eq 'answer') {
       $Apache::lonxml::evaluate++;
     }
     return '';
   }
   
   sub start_display {
     my ($target,$token,$tagstack,$parstack,$parser,$safeeval)=@_;
   
     my $result;
     my $bodytext=&Apache::lonxml::get_all_text("/display",$parser);
   
     if ( $target eq "modified" ) {
       $result=$token->[4].&Apache::edit::modifiedfield();
     } elsif ( $target eq 'web' || $target eq 'tex' ||
       $target eq 'grade' || $target eq 'answer' ||
         $target eq 'analyze') {
         if (!$Apache::lonxml::default_homework_loaded) {
     &Apache::lonxml::default_homework_load($safeeval);
         }
         $result=&Apache::run::run($bodytext,$safeeval);
         if ($target eq 'grade' || $target eq 'answer' ||
     $target eq 'analyze') {
     $result=''; # grade should produce no output
         }
     } elsif ($target eq "edit" ) {
       #$result = 
       #  "<br /> &lt;$token->[1]&gt; output: <br />$bodytext<br />Source:<br />";
       #$result.=&Apache::edit::editfield($token->[1],$bodytext,'',40,1);
       $result=&Apache::edit::tag_start($target,$token,'Script With Display');
       $result.=&Apache::edit::editfield($token->[1],$bodytext,'',80,1)
     }
     return $result;
   }
   
   sub end_display {
     my ($target,$token,$tagstack,$parstack,$parser,$safeeval)=@_;
     if ($target eq 'edit' ) { return &Apache::edit::end_table(); }
     return '';
   }
   
 sub start_scriptlib {  sub start_scriptlib {
   my ($target,$token,$parstack,$parser,$safeeval)=@_;    my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
   my $bodytext=$$parser[$#$parser]->get_text("/scriptlib");    my $bodytext;
   my $result ="";    my $result ='';
   if ($target ne "edit" ) {    my $error='';
     $bodytext=Apache::run::evaluate($bodytext,$safeeval,$$parstack[$#$parstack]);  
     &Apache::run::run(&getfile($bodytext),$safeeval);    if ($target eq 'web' || $target eq 'grade' || $target eq 'meta' || 
     #print "ran $bodytext:<br>".&getfile($bodytext)."<br>";        $target eq 'edit' || $target eq 'answer' || $target eq 'analyze') {
   } else {      $bodytext=$$parser[$#$parser]->get_text("/scriptlib");
     $result=&editfield($token->[1],$bodytext);      $bodytext=&Apache::run::evaluate($bodytext,$safeeval,
        $$parstack[$#$parstack]);
       my $location=&Apache::lonnet::filelocation($Apache::lonxml::pwd['-1'],
          $bodytext);
       my $script=&Apache::lonnet::getfile($location);
       if ($script == -1) {
         if ($target eq 'edit') {
           $error='</tr><tr><td>Errors</td><td colspan="2"><b> Unable to find <i>'.$location.'</i></b></td>'."\n";
         } else {
    &Apache::lonxml::error("<b> Unable to find <i>$location</i> for scriptlib</b>");
    return "";
         }
       }
       &Apache::run::run($script,$safeeval);
       #&Apache::lonxml::debug("ran $bodytext:<br />".&Apache::lonnet::getfile($bodytext)."<br />");
     }
     if ($target eq "edit" ) {
       $result=
         &Apache::edit::tag_start($target,$token,'New Script Functions').
    &Apache::edit::editline($token->[1],$bodytext,'scriptlib',40).
               &Apache::edit::browse(undef,'textnode').
     $error.'</td></tr>'.
       &Apache::edit::end_table();
     }
     if ($target eq "modified" ) {
       $bodytext=$$parser[$#$parser]->get_text("/scriptlib");
       $result=$token->[4].&Apache::edit::modifiedfield($token);
       &Apache::lonxml::debug($result);
   }    }
   return $result;    return $result;
 }  }
   
 sub end_scriptlib {}  sub end_scriptlib {
     my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
     my @result;
     if ($target eq "edit" ) { $result[1]='no'; }
     return @result;
   }
   
 sub start_parserlib {  sub start_parserlib {
   my ($target,$token,$parstack,$parser,$safeeval,$style)=@_;    my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
   my $bodytext=$$parser[$#$parser]->get_text("/parserlib");    my $bodytext;
   my $result ="";    my $result ="";
   if ($target ne "edit" ) {    my $error='';
     $bodytext=Apache::run::evaluate($bodytext,$safeeval,$$parstack[$#$parstack]);    if ($target eq 'web' || $target eq 'grade' || $target eq 'meta' ||
     %$style = ( %$style , &Apache::style::styleparser($target,         $target eq 'edit' || $target eq 'answer' || $target eq 'analyze') {
  &getfile($bodytext)));      $bodytext=$$parser[$#$parser]->get_text("/parserlib");
   } else {      $bodytext=&Apache::run::evaluate($bodytext,$safeeval,
     $result=&editfield($token->[1],$bodytext);       $$parstack[$#$parstack]);
       my $location=&Apache::lonnet::filelocation($Apache::lonxml::pwd['-1'],
          $bodytext);
       my $styletext=&Apache::lonnet::getfile($location);
       #&Apache::lonxml::debug("found :$bodytext: in :$location: with :$styletext:");
       if ($styletext == -1) {
         if ($target eq 'edit') {
    $error='</tr><tr><td>Errors</td><td colspan="2"><b> Unable to find <i>'.$location.'</i></b></td>'."\n";
         } else {
    &Apache::lonxml::error("<b> Unable to find <i>$location</i> for parserlib</b>");
    return "";
         }
       }
       %$style = ( %$style , &Apache::style::styleparser($target,$styletext));
     }
     if ($target eq "edit" ) {
       $result=
         &Apache::edit::tag_start($target,$token,'New Tag Definitions').
    &Apache::edit::editline($token->[1],$bodytext,'',40).
     $error.'</td></tr>'.
       &Apache::edit::end_table();
     }
     if ($target eq "modified" ) {
       $bodytext=$$parser[$#$parser]->get_text("/parserlib");
       $result=$token->[4].&Apache::edit::modifiedfield($token);
       &Apache::lonxml::debug($result);
   }    }
   return $result;    return $result;
 }  }
   
 sub end_parserlib {  sub end_parserlib {
     my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
     my @result;
     if ($target eq "edit" ) { $result[1]='no'; }
     return @result;
   }
   
   sub start_window {
     my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
     my $result = '';
     if ($target eq 'web') {
       &Apache::lonxml::startredirection;
     }  elsif ($target eq 'tex') {
          $result = '\unskip\footnote{';
      }
     return $result;  
   }
   
   sub end_window {
     my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
     my $result;
     if ($target eq 'web') {
       my $output=&Apache::lonxml::endredirection;
       my $linktext= &Apache::lonxml::get_param('linktext',$parstack,$safeeval);
       if (!$linktext) { $linktext='<sup>*</sup>'; }
       my $width= &Apache::lonxml::get_param('width',$parstack,$safeeval);
       if (!$width) { $width='500'; }
       my $height= &Apache::lonxml::get_param('height',$parstack,$safeeval);
       if (!$height) { $height='200'; }
       $output =~ s/\"/\&quot\;/g;
       $result = "<a href=\"javascript:newWindow=open(\'\',\'new_W\',\'width=$width,height=$height,scrollbars=1\');newWindow.document.open(\'text/html\',\'replace\');newWindow.document.writeln(\'<html><head><title>newwindow</title></head><body bgcolor=&quot;#FFFFFF&quot;> $output </body></html>\');newWindow.document.close();void(0);\">$linktext</a>";
     } elsif ($target eq 'tex') {
         $result = '}';
     } else {
         $result = '';
     }
     return $result; 
 }  }
   
 sub start_import {  sub start_import {
   my ($target,$token,$parstack,$parser,$safeeval,$style)=@_;    my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
   my $bodytext=$$parser[$#$parser]->get_text("/import");    my $bodytext=$$parser[$#$parser]->get_text("/import");
   my $result ="";    my $result ="";
   if ($target ne "edit" ) {  
     $bodytext=Apache::run::evaluate($bodytext,$safeeval,$$parstack[$#$parstack]);    $bodytext=Apache::run::evaluate($bodytext,$safeeval,$$parstack[$#$parstack]);
     my $file=&getfile($bodytext);  
     my $tempparser=HTML::TokeParser->new(\$file);    if ($target eq 'web' || $target eq 'grade' || $target eq 'answer' ||
     push (@$parser,$tempparser);        $target eq 'tex' || $target eq 'analyze' ) {
   } else {      # FIXME this probably needs to be smart about construction vs.
     $result=&editfield($token->[1],$bodytext);      # non construction space.
     $result.="Click<a href=\"/res/$bodytext\">here</a> to edit<br></br>"      my $location=&Apache::lonnet::filelocation($Apache::lonxml::pwd['-1'],$bodytext);
       my $file=&Apache::lonnet::getfile($location);
       if ($file == -1) {
         &Apache::lonxml::error("<b> Unable to find <i>$bodytext as $location</i> for import</b>");
         return "";
       }
   
       my $dir=$location;
       $dir=~s:/[^/]*$::;
       #  &Apache::lonxml::debug("directory $dir $location file $file \n<b>END</b>\n");
       my $id= &Apache::lonxml::get_param('id',$parstack,$safeeval);
       if (!$id) { $id=$Apache::lonxml::curdepth; }
       push(@Apache::inputtags::import,$id);
       push(@Apache::inputtags::importlist,$id);
   
    &Apache::lonxml::newparser($parser,\$file,$dir);
   
     } elsif ($target eq "edit" ) {
       $result.=&Apache::edit::tag_start($target,$token);
       $result.=&Apache::edit::editline($token->[1],$bodytext,'',40);
       $result.=&Apache::edit::browse(undef,'textnode');
       #FIXME this need to convert $bodytext to be a contruction space reference
       #my $location=&Apache::lonnet::filelocation($Apache::lonxml::pwd['-1'],$bodytext);
       #$result.="Click<a href=\"$location\">here</a> to edit<br />"
     } elsif ($target eq 'modified') {
       $bodytext=$$parser[$#$parser]->get_text("/import");
       $result=$token->[4].&Apache::edit::modifiedfield($token);
       &Apache::lonxml::debug($result);
     } elsif ($target eq 'meta') {
       my $id= &Apache::lonxml::get_param('id',$parstack,$safeeval);
       $result.='<import part="'.$Apache::inputtags::part;
       if ($id) {
         $result.='" id="'.$id;
       }
       $result.='">';
       $result.=$bodytext;
       $result.='</import>';
   }    }
     return $result;
 }  }
   
 sub end_import {  sub end_import {
     my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
     pop(@Apache::inputtags::import);
     my $result;
     if ($target eq 'edit' ) { $result=&Apache::edit::end_table(); }
     return $result;
   }
   
   sub start_storetc {
     my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
     my $result = '';
     &Apache::lonxml::startredirection;
     return $result; 
   }
   
   sub end_storetc {
       my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
       my $result;
       my $output=&Apache::lonxml::endredirection;
       $output =~ s/\"/\&quot\;/g;
       $result = '{\bf '.$output.'.}}\write\tcfile{\protect\tcpc{ '.$output.'.}{\the\value{relpage}}}';
       return $result;
   }
   
   
   sub start_physnet {
       my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
       my $bodytext = '/adm/includes/physnet.sty';
       my $location=&Apache::lonnet::filelocation($Apache::lonxml::pwd['-1'],$bodytext);
       my $cbistyletext=&Apache::lonnet::getfile($location);
   
       %$style = (%$style,&Apache::style::styleparser($target,$cbistyletext));
       $$parser['-1']->unget_token($token);
   #    if ( defined($$style{'physnet'}) ) {
   #        &Apache::lonxml::newparser($parser,\$$style{'physnet'});
   #    }
       return "";
   }
   
   sub end_physnet {
     return '';
 }  }
   
 sub editfield {  sub start_standalone {
   my ($tag,$data)=@_;    my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
       my $result='';
   my $count=0;    if ($target eq 'web' ) {
   my $maxlength=-1;      if ( $ENV{'request.course.id'} ) {
   map { $count++;        my $inside = &Apache::lonxml::get_all_text("/standalone",$parser);
  if (length($_) > $maxlength) { $maxlength = length ($_); }      } else {
       } split ("\n", $data);        $result='<table bgcolor="#E1E1E1" border="2"><tr><td>';
         }
   return "<br></br>\n&lt;$tag&gt;<br></br>\n&nbsp;&nbsp;&nbsp;<textarea rows=\"$count\" cols=\"$maxlength\" name=homework_edit_".$Apache::lonxml::curdepth.">$data</textarea><br></br>\n&lt;/$tag&gt;<br></br>\n";  
 }  
   
 sub getfile {  
   my ($filename) = @_;  
   my $a="";  
     
   $filename=~ s/\s+//g;  
   $filename="/home/httpd/html/res".$filename;  
   if (! -e $filename ) {  
     &Apache::lonnet::subscribe($filename);  
     &Apache::lonnet::repcopy($filename);  
   }  
   my $fh=Apache::File->new($filename);  
   while (<$fh>) {  
       $a .=$_;  
   }    }
   return $a    return $result;
   }
   
   sub end_standalone {
     my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
     my $result='';
     if ($target eq 'web' ) {
       if ( $ENV{'request.course.id'} ) {
       } else {
         $result='</td></tr></table>';
       }
     }
     return $result;
   }
   
   sub start_comment {
     my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
     my $result='';
     if ($target eq 'edit') {
       $result=&Apache::edit::tag_start($target,$token);
       my $bodytext=&Apache::lonxml::get_all_text("/comment",$parser);
       $result.=&Apache::edit::editfield($token->[1],$bodytext,'',80,4)
     } elsif ( $target eq 'modified') {
       $result=$token->[4].&Apache::edit::modifiedfield($token);
     } elsif ( $target eq 'web' || $target eq 'tex' || $target eq 'grade' ||
       $target eq 'answer' || $target eq 'meta' || $target eq 'analyze') {
       #normally throw away comments
       my $bodytext=&Apache::lonxml::get_all_text("/comment",$parser);
     }
     return $result;
   }
   
   sub end_comment {
     my ($target,$token,$tagstack,$parstack,$parser,$safeeval)=@_;
     if ($target eq 'edit' ) { return &Apache::edit::end_table(); }
     return '';
   }
   
   
   sub xmlparse {
     my ($string) = @_;
   #  &Apache::lonxml::debug("Got $string");
     my ($target,$token,$tagstack,$parstack,$oldparser,$safeeval,$style)=
       @Apache::scripttag::parser_env;
     my @parser;
     &Apache::lonxml::newparser(\@parser,\$string);
     my $result=&Apache::lonxml::inner_xmlparse($target,$tagstack,
        $parstack,\@parser,
        $safeeval,$style);
     return $result;
 }  }
   
 1;  1;

Removed from v.1.11  
changed lines
  Added in v.1.92


FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
500 Internal Server Error

Internal Server Error

The server encountered an internal error or misconfiguration and was unable to complete your request.

Please contact the server administrator at root@localhost to inform them of the time this error occurred, and the actions you performed just before this error.

More information about this error may be available in the server error log.