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

Diff for /rat/lonratsrv.pm between versions 1.14 and 1.42

version 1.14, 2001/07/04 19:59:24 version 1.42, 2011/10/25 19:23:20
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  
 #  #
 # 05/29/00,05/30 Gerd Kortemeyer)  # Copyright Michigan State University Board of Trustees
 # 7/1 Gerd Kortemeyer)  #
 # 7/1,7/3,7/4,7/7,7/8,7/10,7/26,10/2 Gerd Kortemeyer  # This file is part of the LearningOnline Network with CAPA (LON-CAPA).
 # 4/30/2001 Scott Harrison  #
 # 5/3,06/25,07/03,07/04 Gerd Kortemeyer  # 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/
   #
   
   
 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();
 use HTML::TokeParser;  use LONCAPA::map();
   
   
 # ------------------------------------------------------------- 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
   
 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;
   
   my $url=$r->uri;    my $url=$r->uri;
   $url=~/\/(\w+)\/ratserver$/;    $url=~m{/(\w+)/ratserver$};
   my $mode=$1;    my $mode=$1;
   
   $url=~s/\/loadonly\/ratserver$/\/save\/ratserver/;    $url=~s{/loadonly/ratserver$}{/save/ratserver};
       
   my $fn=$r->filename;    my $fn=$r->filename;
   my $errtext='';    my $errtext='';
     my $infotext='';
   my $outtext='';    my $outtext='';
   
   if ($mode ne 'loadonly') {    if ($mode ne 'loadonly') {
      $errtext=&savemap($fn,$errtext);       ($errtext,$infotext)=&LONCAPA::map::savemap($fn,$errtext);
   }    }
   ($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">  <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;
 }  }
   
 1;  1;
 __END__  __END__
   
   
   =head1 NAME
   
   Apache::lonratsrv
   
   =head1 SYNOPSIS
   
   Handler that takes output from RAT and stores
   it on disk. Handles the upper hidden frame of
   the added window that comes up in RAT. (3
   frames come up in RAT server, code, and
   output. This module handles server
   connection.)
   
   This is part of the LearningOnline Network with CAPA project
   described at http://www.lon-capa.org.
   
   =cut
Removed from v.1.14  
changed lines
  Added in v.1.42

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