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

Diff for /rat/lonratsrv.pm between versions 1.7 and 1.38

version 1.7, 2000/10/02 16:10:12 version 1.38, 2006/11/02 21:26:54
Line 1 Line 1
 # The LearningOnline Network with CAPA  # The LearningOnline Network with CAPA
 # Server for RAT Maps  # Server for RAT Maps
 #  #
 # (Edit Handler for RAT Maps  # $Id$
 # (TeX Content Handler  #
   # 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/
 #  #
 # 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  
   
 package Apache::lonratsrv;  package Apache::lonratsrv;
   
 use strict;  use strict;
 use Apache::Constants qw(:common);  use Apache::Constants qw(:common);
 use Apache::File;  use LONCAPA::map();
 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/\:/\&\#58\;/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]->{'src'}=~/\/\//) {  
                         $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';  
                     }  
                 } 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)=@_;  
     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];  
                        }  
                    } 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] 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
   
 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 268  sub handler { Line 49  sub handler {
   $url=~s/\/loadonly\/ratserver$/\/save\/ratserver/;    $url=~s/\/loadonly\/ratserver$/\/save\/ratserver/;
       
   my $fn=$r->filename;    my $fn=$r->filename;
     my $lonDocRoot=$r->dir_config('lonDocRoot');
     if ( $fn =~ /\Q$lonDocRoot\E/ ) {
         #internal authentication, needs fixup.
         $fn = $url;
         $fn=~s|^/~(\w+)|/home/$1/public_html|;
         $fn=~s|/[^/]*/ratserver$||;
     }
   my $errtext='';    my $errtext='';
     my $infotext='';
   my $outtext='';    my $outtext='';
   my $onload='';  
   
   if ($mode ne 'loadonly') {    if ($mode ne 'loadonly') {
      $errtext=&savemap($fn,$errtext);       ($errtext,$infotext)=&LONCAPA::map::savemap($fn,$errtext);
      $onload='onLoad="parent.code.srvloaded();"';  
   }    }
   ($outtext,$errtext)=&loadmap($fn,$errtext);    ($outtext,$errtext,$infotext)=&LONCAPA::map::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" $onload>  <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 type ="text/javascript">
       parent.flag=1;
   </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;
 }  }
   
 1;  1;
 __END__  __END__
   
   
   
   
   
   
   
Removed from v.1.7  
changed lines
  Added in v.1.38

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