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

Diff for /rat/lonratsrv.pm between versions 1.1 and 1.3

version 1.1, 2000/07/01 17:55:31 version 1.3, 2000/07/05 21:05:28
Line 6 Line 6
 #  #
 # 05/29/00,05/30 Gerd Kortemeyer)  # 05/29/00,05/30 Gerd Kortemeyer)
 # 7/1 Gerd Kortemeyer)  # 7/1 Gerd Kortemeyer)
 # 7/1 Gerd Kortemeyer  # 7/1,7/3,7/4 Gerd Kortemeyer
   
 package Apache::lonratsrv;  package Apache::lonratsrv;
   
 use strict;  use strict;
 use Apache::Constants qw(:common);  use Apache::Constants qw(:common);
   use Apache::File;
   use HTML::TokeParser;
   
   
   # ---------------------------------------------------------- Escape Quote Chars
   
   sub qtescape {
       my $str=shift;
       $str =~ s/([\"\%])/"%".unpack('H2',$1)/eg;
       return $str;
   }
   
   # ----------------------------------------------------- Un-Escape Special Chars
   
   sub unescape {
       my $str=shift;
       $str =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
       return $str;
   }
   
   # --------------------------------------------------------- Loads map from disk
   
   sub loadmap {
       my ($fn,$errtext)=@_;
       my $outstr='';
       my @content=();
       my @obj=();
       my @links=();
       if (-e $fn) {
           {
       my $fh=Apache::File->new($fn);
               @content=<$fh>;
           }
           my $instr=join('',@content);
           my $parser = HTML::TokeParser->new(\$instr);
           my $token;
           my $graphmode=0;
   
           $fn=~/\.(\w+)$/;
           $outstr="mode<:>$1";
   
           while ($token = $parser->get_token) {
       if ($token->[0] eq 'S') {
                   if ($token->[1] eq 'map') {
       $graphmode=($token->[2]->{'mode'} eq 'rat/graphical');
                   } elsif ($token->[1] eq 'resource') {
   # -------------------------------------------------------------------- Resource
                       $outstr.='<&>objcont';
                       if ($token->[2]->{'id'}) {
    $outstr.='<:>'.$token->[2]->{'id'};
                           if ($obj[$token->[2]->{'id'}]==1) {
                              $errtext.='Error: multiple use of ID '.
                                        $token->[2]->{'id'}.'. ';
                           }
                           $obj[$token->[2]->{'id'}]=1; 
                       } else {
                           my $i=1;
                           while (($i<=$#obj) && ($obj[$i]!=0)) { $i++; }
                           $outstr.='<:>'.$i;
                           $obj[$i]=1;
                       }
                       $outstr.='<:>';
                   } elsif ($token->[1] eq 'condition') {
   # ------------------------------------------------------------------- Condition
                       $outstr.='<&>objcont';
                       if ($token->[2]->{'id'}) {
    $outstr.='<:>'.$token->[2]->{'id'};
                           if ($obj[$token->[2]->{'id'}]==1) {
                              $errtext.='Error: multiple use of ID '.
                                        $token->[2]->{'id'}.'. ';
                           }
                           $obj[$token->[2]->{'id'}]=1; 
                       } else {
                           my $i=1;
                           while (($i<=$#obj) && ($obj[$i]!=0)) { $i++; }
                           $outstr.='<:>'.$i;
                           $obj[$i]=1;
                       }
                       $outstr.='<:>';
                   } elsif ($token->[1] eq 'link') {
   # ----------------------------------------------------------------------- Links
                       $outstr.='<&>objlinks';
                       if ($graphmode) {
                           if ($token->[2]->{'index'}) {
                              $errtext.='Error: multiple use of link index '.
          $token->[2]->{'index'}.'. ';
    $outstr.='<:>'.$token->[2]->{'index'};
                           $links[$token->[2]->{'index'}]=1;
                       } else {
                           my $i=1;
                           while (($i<=$#links) && ($links[$i]==1)) { $i++; }
                           $outstr.='<:>'.$i;
                           $links[$i]=1;
       }
                       $outstr.='<:>'.$token->[2]->{'from'}.
                                '<:>'.$token->[2]->{'to'};
                       if ($token->[2]->{'condition'}) {
    $outstr.='<:>'.$token->[2]->{'condition'};
                       } else {
     $outstr.='<:>0';
                      }
                   } elsif ($graphmode) {
   # --------------------------------------------- All other tags (graphical only)
                       $outstr.='<&>'.$token->[1];
                       if ($token->[2]->{'index'}) {
    $outstr.='<:>'.$token->[2]->{'index'};
                           if ($token->[1] eq 'obj') {
       $obj[$token->[2]->{'index'}]=2;
                           }
                       }
                       $outstr.='<:>'.$token->[2]->{'value'};
                   }
               }
           }
   
       } else {
           $errtext.='Map not loaded: The file does not exist. ';
       }
       return($outstr,$errtext);
   }
   
   
   # ----------------------------------------------------------- Saves map to disk
   
   sub savemap {
       my ($fn,$errtext)=@_;
       if (($fn=~/\.course$/) ||
           ($fn=~/\.sequence$/) ||
           ($fn=~/\.page$/)) {
   # ------------------------------------------------------------- Deal with input
           my @tags=split(/<&>/,$ENV{'form.output'});
           my $outstr='';
           my $graphdef=0;
           if ($tags[0] eq 'graphdef<:>yes') {
       $outstr='<map mode="rat/graphical">'."\n";
               $graphdef=1;
           } else {
               $outstr="<map>\n";
           }
           map {
      my @parts=split(/<:>/,$_);
              if ($parts[0] eq 'objcont') {
                  my @comp=split(/:/,$parts[$#parts]);
   # --------------------------------------------------------------- Logical input
          if ($comp[$#comp] eq 'res') {
                      $comp[0]=~s/\&\#(\d+)\;/pack("C",$1)/eg;
                      $comp[1]=~s/\&\#(\d+)\;/pack("C",$1)/eg;
                      if ($comp[2] eq 'true') {
          if ($comp[1]!~/^http\:\/\//) {
      $comp[1]='http://'.$comp[1];
                          }
                      } else {
          if ($comp[1]=~/^http\:\/\//) {
      $comp[1]=~s/^http\:\/\/[^\/]*\//\//;
                          }
                      }
      $outstr.='<resource id="'.$parts[1].'" src="'
                             .qtescape($comp[1]).'"';
   
                      if (($comp[3] ne '') && ($comp[3] ne 'normal')) {
          $outstr.=' type="'.$comp[3].'"';
                      }
                      if ($comp[0] ne '') {
          $outstr.=' title="'.qtescape($comp[0]).'"';
                      }
                      $outstr.="></resource>\n";
                  } elsif ($comp[$#comp] eq 'cond') {
                      $outstr.='<condition id="'.$parts[1].'"';
                      if (($comp[1] ne '') && ($comp[1] ne 'normal')) {
          $outstr.=' type="'.$comp[1].'"';
                      }
                      $outstr.=' value="'.qtescape($comp[0]).'"';
                      $outstr.="></condition>\n";
                  }
              } elsif ($parts[0] eq 'objlinks') {
                  my @comp=split(/:/,$parts[$#parts]);
                  $outstr.='<link';
                  $outstr.=' from="'.$comp[0].'"';
                  $outstr.=' to="'.$comp[1].'"';
                  if (($comp[2] ne '') && ($comp[2]!=0)) {
                     $outstr.=' condition="'.$comp[2].'"';
                  }
                  $outstr.=' index="'.$parts[1].'"';
                  $outstr.="></link>\n";
              } elsif (($parts[0] ne '') && ($graphdef)) {
   # ------------------------------------------------------------- Graphical input
                  $outstr.='<'.$parts[0];
                  if ($#parts==2) {
      $outstr.=' index="'.$parts[1].'"';
                  }
                  $outstr.=' value="'.qtescape($parts[$#parts]).'"></'.
                           $parts[0].">\n";
              }
           } @tags;
           $outstr.="</map>\n";
           {
             my $fh;
             if ($fh=Apache::File->new(">$fn")) {
                print $fh $outstr;
                $errtext.="Map saved as $fn. ";
     } else {
                $errtext.='Could not write file $fn. Map not saved. ';
     }
           }
       } else {
   # -------------------------------------------- Cannot write to that file, error
           $errtext.='Map not saved: The specified path does not exist. ';
       }
       return $errtext;
   }
   
 # ================================================================ Main Handler  # ================================================================ Main Handler
   
Line 23  sub handler { Line 233  sub handler {
   return OK if $r->header_only;    return OK if $r->header_only;
   
   my $url=$r->uri;    my $url=$r->uri;
     $url=~/\/(\w+)\/ratserver$/;
     my $mode=$1;
   
     $url=~s/\/loadonly\/ratserver$/\/save\/ratserver/;
     
     my $fn=$r->filename;
     my $errtext='';
     my $outtext='';
   
     if ($mode ne 'loadonly') {
        $errtext=&savemap($fn,$errtext);
     }
     ($outtext,$errtext)=&loadmap($fn,$errtext);
   
   $r->print(<<ENDDOCUMENT);    $r->print(<<ENDDOCUMENT);
 <html>  <html>
 <body bgcolor="#FFFFFF">  <body bgcolor="#FFFFFF">
 <form name=storage method=post>  <form name=storage method=post action="$url">
 <input type=hidden name=output>  <input type=hidden name=output value="$outtext">
 </form>  </form>
 </body>  
 </html>  
   
 ENDDOCUMENT  ENDDOCUMENT
       if ($errtext ne '') {
    $r->print(<<ENDSCRIPT);
   <script>
       alert("$errtext");
   </script>
   ENDSCRIPT
       }
       $r->print("</body>\n</html>\n");
   
   return OK;    return OK;
 }  }
   
Removed from v.1.1  
changed lines
  Added in v.1.3

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