[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.14

version 1.1, 2000/07/01 17:55:31 version 1.14, 2001/07/04 19:59:24
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,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 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;
   
   
   # ------------------------------------------------------------- From RAT to XML
   
   sub qtescape {
       my $str=shift;
       $str=~s/\&\#58\;/\:/g;
       $str=~s/\&\#39\;/\'/g;
       $str=~s/\&\#44\;/\,/g;
       $str=~s/\&\#34\;/\"/g;
       return $str;
   }
   
   # ------------------------------------------------------------- From XML to RAT
   
   sub qtunescape {
       my $str=shift;
       $str=~s/\:/\&colon\;/g;
       $str=~s/\'/\&\#39\;/g;
       $str=~s/\,/\&\#44\;/g;
       $str=~s/\"/\&\#34\;/g;
       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.='<:>';
                       $outstr.=qtunescape($token->[2]->{'title'}).":";
                       $outstr.=qtunescape($token->[2]->{'src'}).":";
                       if ($token->[2]->{'external'} eq 'true') {
                           $outstr.='true:';
                       } else {
                           $outstr.='false:';
                       }
                       if ($token->[2]->{'type'}) {
    $outstr.=$token->[2]->{'type'}.':';
                       }  else {
                           $outstr.='normal:';
                       }
                       $outstr.='res';
                   } 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.='<:>';
                       $outstr.=qtunescape($token->[2]->{'value'}).':';
                       if ($token->[2]->{'type'}) {
    $outstr.=$token->[2]->{'type'}.':';
                       } else {
                           $outstr.='normal:';
                       }
                       $outstr.='cond';
                   } elsif ($token->[1] eq 'link') {
   # ----------------------------------------------------------------------- Links
                       $outstr.='<&>objlinks';
   
                           if ($token->[2]->{'index'}) {
      if ($links[$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';
                       }
   # ------------------------------------------------------------------- Parameter
                   } elsif ($token->[1] eq 'param') {
                       $outstr.='<&>objparms<:>'.$token->[2]->{'to'}.'<:>'.
                               $token->[2]->{'type'}.'___'.$token->[2]->{'name'}
                                                    .'___'.$token->[2]->{'value'};
                   } elsif ($graphmode) {
   # --------------------------------------------- All other tags (graphical only)
                       $outstr.='<&>'.$token->[1];
                       if (defined($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)=@_;
       my %alltypes;
       my %allvalues;
       if (($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]=qtescape($comp[0]);
                      $comp[1]=qtescape($comp[1]);
                      if ($comp[2] eq 'true') {
          if ($comp[1]!~/^http\:\/\//) {
      $comp[1]='http://'.$comp[1];
                          }
                          $comp[1].='" external="true';
                      } else {
          if ($comp[1]=~/^http\:\/\//) {
      $comp[1]=~s/^http\:\/\/[^\/]*\//\//;
                          }
                      }
      $outstr.='<resource id="'.$parts[1].'" src="'
                             .$comp[1].'"';
   
                      if (($comp[3] ne '') && ($comp[3] ne 'normal')) {
          $outstr.=' type="'.$comp[3].'"';
                      }
                      if ($comp[0] ne '') {
          $outstr.=' title="'.$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] eq 'objparms') {
                  undef %alltypes;
                  undef %allvalues;
                  map {
                      my ($type,$name,$value)=split(/\_\_\_/,$_);
                      $alltypes{$name}=$type;
                      $allvalues{$name}=$value;
                  } split(/:/,$parts[$#parts]);
                  map {
                      $outstr.='<param to="'.$parts[1].'" type="'
                             .$alltypes{$_}.'" name="'.$_
                             .'" value="'.$allvalues{$_}.'">'
                             ."</param>\n";
                  } keys %allvalues;
              } 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 286  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>  <script>
 </html>      parent.flag=1;
   </script>
 ENDDOCUMENT  ENDDOCUMENT
       if ($errtext ne '') {
    $r->print(<<ENDSCRIPT);
   <script>
       alert("$errtext");
   </script>
   ENDSCRIPT
       }
       $r->print("</body>\n</html>\n");
   
   return OK;    return OK;
 }  }
   
 1;  1;
 __END__  __END__
   
   
   
   
   
   
   
Removed from v.1.1  
changed lines
  Added in v.1.14

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