[BACK]Return to lonratsrv.pm CVS log [TXT] [DIR] Up to [LON-CAPA] / rat

Diff for /rat/lonratsrv.pm between versions 1.21 and 1.37

version 1.21, 2002/08/19 21:15:08 version 1.37, 2006/07/21 08:30:57
Line 25 Line 25
 #  #
 # http://www.lon-capa.org/  # http://www.lon-capa.org/
 #  #
 # (Edit Handler for RAT Maps  
 # (TeX Content Handler  
 #  
 # 05/29/00,05/30 Gerd Kortemeyer)  
 # 7/1 Gerd Kortemeyer)  
 # 7/1,7/3,7/4,7/7,7/8,7/10,7/26,10/2 Gerd Kortemeyer  
 # 4/30/2001 Scott Harrison  
 # 5/3,06/25,07/03,07/04,07/05 Gerd Kortemeyer  
   
 package Apache::lonratsrv;  package Apache::lonratsrv;
   
Line 40  use strict; Line 32  use strict;
 use Apache::Constants qw(:common);  use Apache::Constants qw(:common);
 use Apache::File;  use Apache::File;
 use HTML::TokeParser;  use HTML::TokeParser;
   use Apache::lonnet;
   
 # ------------------------------------------------------------- From RAT to XML  # ------------------------------------------------------------- From RAT to XML
   
 sub qtescape {  sub qtescape {
     my $str=shift;      my $str=shift;
       $str=~s/\:/\:/g;
     $str=~s/\&\#58\;/\:/g;      $str=~s/\&\#58\;/\:/g;
     $str=~s/\&\#39\;/\'/g;      $str=~s/\&\#39\;/\'/g;
     $str=~s/\&\#44\;/\,/g;      $str=~s/\&\#44\;/\,/g;
Line 67  sub qtunescape { Line 60  sub qtunescape {
 # --------------------------------------------------------- Loads map from disk  # --------------------------------------------------------- Loads map from disk
   
 sub loadmap {  sub loadmap {
     my ($fn,$errtext)=@_;      my ($fn,$errtext,$infotext)=@_;
       if ($errtext) { return('',$errtext); }
     my $outstr='';      my $outstr='';
     my @obj=();      my @obj=();
     my @links=();      my @links=();
Line 82  sub loadmap { Line 76  sub loadmap {
         }          }
         $instr=join('',@content);          $instr=join('',@content);
     }      }
     if ($instr) {      if ($instr eq -2) {
           $errtext.='Map not loaded: An error occured while trying to load the map.';
       } elsif ($instr) {
         my $parser = HTML::TokeParser->new(\$instr);          my $parser = HTML::TokeParser->new(\$instr);
         my $token;          my $token;
         my $graphmode=0;          my $graphmode=0;
Line 97  sub loadmap { Line 93  sub loadmap {
                 } elsif ($token->[1] eq 'resource') {                  } elsif ($token->[1] eq 'resource') {
 # -------------------------------------------------------------------- Resource  # -------------------------------------------------------------------- Resource
                     $outstr.='<&>objcont';                      $outstr.='<&>objcont';
                     if ($token->[2]->{'id'}) {                      if (defined($token->[2]->{'id'})) {
  $outstr.='<:>'.$token->[2]->{'id'};   $outstr.='<:>'.$token->[2]->{'id'};
                         if ($obj[$token->[2]->{'id'}]==1) {                          if ($obj[$token->[2]->{'id'}]==1) {
                            $errtext.='Error: multiple use of ID '.                             $errtext.='Error: multiple use of ID '.
Line 118  sub loadmap { Line 114  sub loadmap {
                     } else {                      } else {
                         $outstr.='false:';                          $outstr.='false:';
                     }                      }
                     if ($token->[2]->{'type'}) {                      if (defined($token->[2]->{'type'})) {
  $outstr.=$token->[2]->{'type'}.':';   $outstr.=$token->[2]->{'type'}.':';
                     }  else {                      }  else {
                         $outstr.='normal:';                          $outstr.='normal:';
                     }                      }
                     $outstr.='res';      if ($token->[2]->{'type'} ne 'zombie') {
    $outstr.='res';
       } else {
                           $outstr.='zombie';
       }
                 } elsif ($token->[1] eq 'condition') {                  } elsif ($token->[1] eq 'condition') {
 # ------------------------------------------------------------------- Condition  # ------------------------------------------------------------------- Condition
                     $outstr.='<&>objcont';                      $outstr.='<&>objcont';
                     if ($token->[2]->{'id'}) {                      if (defined($token->[2]->{'id'})) {
  $outstr.='<:>'.$token->[2]->{'id'};   $outstr.='<:>'.$token->[2]->{'id'};
                         if ($obj[$token->[2]->{'id'}]==1) {                          if ($obj[$token->[2]->{'id'}]==1) {
                            $errtext.='Error: multiple use of ID '.                             $errtext.='Error: multiple use of ID '.
Line 142  sub loadmap { Line 142  sub loadmap {
                     }                      }
                     $outstr.='<:>';                      $outstr.='<:>';
                     $outstr.=qtunescape($token->[2]->{'value'}).':';                      $outstr.=qtunescape($token->[2]->{'value'}).':';
                     if ($token->[2]->{'type'}) {                      if (defined($token->[2]->{'type'})) {
  $outstr.=$token->[2]->{'type'}.':';   $outstr.=$token->[2]->{'type'}.':';
                     } else {                      } else {
                         $outstr.='normal:';                          $outstr.='normal:';
Line 152  sub loadmap { Line 152  sub loadmap {
 # ----------------------------------------------------------------------- Links  # ----------------------------------------------------------------------- Links
                     $outstr.='<&>objlinks';                      $outstr.='<&>objlinks';
   
                         if ($token->[2]->{'index'}) {                          if (defined($token->[2]->{'index'})) {
    if ($links[$token->[2]->{'index'}]) {     if ($links[$token->[2]->{'index'}]) {
                                $errtext.='Error: multiple use of link index '.                                 $errtext.='Error: multiple use of link index '.
        $token->[2]->{'index'}.'. ';         $token->[2]->{'index'}.'. ';
Line 168  sub loadmap { Line 168  sub loadmap {
           
                     $outstr.='<:>'.$token->[2]->{'from'}.                      $outstr.='<:>'.$token->[2]->{'from'}.
                              ':'.$token->[2]->{'to'};                               ':'.$token->[2]->{'to'};
                     if ($token->[2]->{'condition'}) {                      if (defined($token->[2]->{'condition'})) {
  $outstr.=':'.$token->[2]->{'condition'};   $outstr.=':'.$token->[2]->{'condition'};
                     } else {                      } else {
   $outstr.=':0';    $outstr.=':0';
Line 195  sub loadmap { Line 195  sub loadmap {
     } else {      } else {
         $errtext.='Map not loaded: The file does not exist. ';          $errtext.='Map not loaded: The file does not exist. ';
     }      }
     return($outstr,$errtext);      return($outstr,$errtext,$infotext);
 }  }
   
   
Line 203  sub loadmap { Line 203  sub loadmap {
   
 sub savemap {  sub savemap {
     my ($fn,$errtext)=@_;      my ($fn,$errtext)=@_;
       my $infotext='';
     my %alltypes;      my %alltypes;
     my %allvalues;      my %allvalues;
     if (($fn=~/\.sequence$/) ||      if (($fn=~/\.sequence(\.tmp)*$/) ||
         ($fn=~/\.page$/)) {          ($fn=~/\.page(\.tmp)*$/)) {
   
 # ------------------------------------------------------------- Deal with input  # ------------------------------------------------------------- Deal with input
         my @tags=split(/<&>/,$ENV{'form.output'});          my @tags=split(/<&>/,$env{'form.output'});
         my $outstr='';          my $outstr='';
         my $graphdef=0;          my $graphdef=0;
         if ($tags[0] eq 'graphdef<:>yes') {          if ($tags[0] eq 'graphdef<:>yes') {
Line 218  sub savemap { Line 219  sub savemap {
         } else {          } else {
             $outstr="<map>\n";              $outstr="<map>\n";
         }          }
         map {          foreach (@tags) {
    my @parts=split(/<:>/,$_);     my @parts=split(/<:>/,$_);
            if ($parts[0] eq 'objcont') {             if ($parts[0] eq 'objcont') {
                my @comp=split(/:/,$parts[$#parts]);                 my @comp=split(/:/,$parts[$#parts]);
 # --------------------------------------------------------------- Logical input  # --------------------------------------------------------------- Logical input
        if ($comp[$#comp] eq 'res') {         if (($comp[$#comp] eq 'res') || ($comp[$#comp] eq 'zombie')) {
                    $comp[0]=qtescape($comp[0]);                     $comp[0]=qtescape($comp[0]);
                    $comp[1]=qtescape($comp[1]);                     $comp[1]=qtescape($comp[1]);
                    if ($comp[2] eq 'true') {                     if ($comp[2] eq 'true') {
Line 245  sub savemap { Line 246  sub savemap {
                    if ($comp[0] ne '') {                     if ($comp[0] ne '') {
        $outstr.=' title="'.$comp[0].'"';         $outstr.=' title="'.$comp[0].'"';
                    }                     }
                    $outstr.="></resource>\n";                     $outstr.=" />\n";
                } elsif ($comp[$#comp] eq 'cond') {                 } elsif ($comp[$#comp] eq 'cond') {
                    $outstr.='<condition id="'.$parts[1].'"';                     $outstr.='<condition id="'.$parts[1].'"';
                    if (($comp[1] ne '') && ($comp[1] ne 'normal')) {                     if (($comp[1] ne '') && ($comp[1] ne 'normal')) {
        $outstr.=' type="'.$comp[1].'"';         $outstr.=' type="'.$comp[1].'"';
                    }                     }
                    $outstr.=' value="'.qtescape($comp[0]).'"';                     $outstr.=' value="'.qtescape($comp[0]).'"';
                    $outstr.="></condition>\n";                     $outstr.=" />\n";
                }                 }
            } elsif ($parts[0] eq 'objlinks') {             } elsif ($parts[0] eq 'objlinks') {
                my @comp=split(/:/,$parts[$#parts]);                 my @comp=split(/:/,$parts[$#parts]);
Line 263  sub savemap { Line 264  sub savemap {
                   $outstr.=' condition="'.$comp[2].'"';                    $outstr.=' condition="'.$comp[2].'"';
                }                 }
                $outstr.=' index="'.$parts[1].'"';                 $outstr.=' index="'.$parts[1].'"';
                $outstr.="></link>\n";                 $outstr.=" />\n";
            } elsif ($parts[0] eq 'objparms') {             } elsif ($parts[0] eq 'objparms') {
                undef %alltypes;                 undef %alltypes;
                undef %allvalues;                 undef %allvalues;
Line 276  sub savemap { Line 277  sub savemap {
                   if ($allvalues{$_} ne '') {                    if ($allvalues{$_} ne '') {
                    $outstr.='<param to="'.$parts[1].'" type="'                     $outstr.='<param to="'.$parts[1].'" type="'
                           .$alltypes{$_}.'" name="'.$_                            .$alltypes{$_}.'" name="'.$_
                           .'" value="'.$allvalues{$_}.'">'                            .'" value="'.$allvalues{$_}.'" />'
                           ."</param>\n";                            ."\n";
           }            }
                }                 }
            } elsif (($parts[0] ne '') && ($graphdef)) {             } elsif (($parts[0] ne '') && ($graphdef)) {
Line 286  sub savemap { Line 287  sub savemap {
                if ($#parts==2) {                 if ($#parts==2) {
    $outstr.=' index="'.$parts[1].'"';     $outstr.=' index="'.$parts[1].'"';
                }                 }
                $outstr.=' value="'.qtescape($parts[$#parts]).'"></'.                 $outstr.=' value="'.qtescape($parts[$#parts]).'" />'."\n";
                         $parts[0].">\n";  
            }             }
         } @tags;          }
         $outstr.="</map>\n";          $outstr.="</map>\n";
  if ($fn=~/^\/*uploaded\//) {   if ($fn=~/^\/*uploaded\/(\w+)\/(\w+)\/(.*)$/) {
     $ENV{'form.output'}=$outstr;      $env{'form.output'}=$outstr;
             &Apache::lonnet::finishuserfileupload(              my $result=&Apache::lonnet::finishuserfileupload($2,$1,
               $ENV{'course.'.$ENV{'request.course.id'}.'.num'},       'output',$3);
               $ENV{'course.'.$ENV{'request.course.id'}.'.domain'},      if ($result != m|^/uploaded/|) {
               $ENV{'course.'.$ENV{'request.course.id'}.'.home'},   $errtext.='Map not saved: A network error occured when trying to save the map. ';
               'output',(split(/\//,$fn))[-1]);      }
         } else {          } else {
           my $fh;            my $fh;
           if ($fh=Apache::File->new(">$fn")) {            if ($fh=Apache::File->new(">$fn")) {
              print $fh $outstr;               print $fh $outstr;
              $errtext.="Map saved as $fn. ";               $infotext.="Map saved as $fn. ";
   } else {    } else {
              $errtext.='Could not write file '.$fn.'.  Map not saved. ';               $errtext.='Could not write file '.$fn.'.  Map not saved. ';
   }    }
Line 311  sub savemap { Line 311  sub savemap {
 # -------------------------------------------- Cannot write to that file, error  # -------------------------------------------- Cannot write to that file, error
         $errtext.='Map not saved: The specified path does not exist. ';          $errtext.='Map not saved: The specified path does not exist. ';
     }      }
     return $errtext;      return ($errtext,$infotext);
 }  }
   
 # ================================================================ Main Handler  # ================================================================ Main Handler
   
 sub handler {  sub handler {
   my $r=shift;    my $r=shift;
   $r->content_type('text/html');    &Apache::loncommon::content_type($r,'text/html');
   $r->send_http_header;    $r->send_http_header;
   
   return OK if $r->header_only;    return OK if $r->header_only;
Line 338  sub handler { Line 338  sub handler {
       $fn=~s|/[^/]*/ratserver$||;        $fn=~s|/[^/]*/ratserver$||;
   }    }
   my $errtext='';    my $errtext='';
     my $infotext='';
   my $outtext='';    my $outtext='';
   
   if ($mode ne 'loadonly') {    if ($mode ne 'loadonly') {
      $errtext=&savemap($fn,$errtext);       ($errtext,$infotext)=&savemap($fn,$errtext);
   }    }
   ($outtext,$errtext)=&loadmap($fn,$errtext);    ($outtext,$errtext,$infotext)=&loadmap($fn,$errtext,$infotext);
   
     my $start_page =
         &Apache::loncommon::start_page('Alert',undef,
        {'only_body' => 1,
         'bgcolor'   => '#FFFFFF',});
     my $end_page =
         &Apache::loncommon::end_page();
   
   $r->print(<<ENDDOCUMENT);    $r->print(<<ENDDOCUMENT);
 <html>  $start_page
 <body bgcolor="#FFFFFF">  <form name="storage" method="post" action="$url">
 <form name=storage method=post action="$url">  <input type="hidden" name="output" value="$outtext" />
 <input type=hidden name=output value="$outtext">  
 </form>  </form>
 <script>  <script type ="text/javascript">
     parent.flag=1;      parent.flag=1;
 </script>  </script>
 ENDDOCUMENT  ENDDOCUMENT
     if ($errtext ne '') {      if (($errtext ne '') || ($infotext ne '')) {
  $r->print(<<ENDSCRIPT);   $r->print(<<ENDSCRIPT);
 <script>  <script type="text/javascript">
     alert("$errtext");      alert("$infotext $errtext");
 </script>  </script>
 ENDSCRIPT  ENDSCRIPT
     }      }
     $r->print("</body>\n</html>\n");      $r->print($end_page);
   
   return OK;    return OK;
 }  }
Removed from v.1.21  
changed lines
  Added in v.1.37

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.