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

version 1.35, 2006/04/04 15:32:12 version 1.42, 2011/10/25 19:23:20
Line 26 Line 26
 # http://www.lon-capa.org/  # 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();
 use Apache::lonnet;  
   
 # ------------------------------------------------------------- From RAT to XML  
   
 sub qtescape {  
     my $str=shift;  
     $str=~s/\:/\:/g;  
     $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,$infotext)=@_;  
     if ($errtext) { return('',$errtext); }  
     my $outstr='';  
     my @obj=();  
     my @links=();  
     my $instr='';  
     if ($fn=~/^\/*uploaded\//) {  
         $instr=&Apache::lonnet::getfile($fn);  
     } elsif (-e $fn) {  
         my @content=();  
         {  
     my $fh=Apache::File->new($fn);  
             @content=<$fh>;  
         }  
         $instr=join('',@content);  
     }  
     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 $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 (defined($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 (defined($token->[2]->{'type'})) {  
  $outstr.=$token->[2]->{'type'}.':';  
                     }  else {  
                         $outstr.='normal:';  
                     }  
     if ($token->[2]->{'type'} ne 'zombie') {  
  $outstr.='res';  
     } else {  
                         $outstr.='zombie';  
     }  
                 } elsif ($token->[1] eq 'condition') {  
 # ------------------------------------------------------------------- Condition  
                     $outstr.='<&>objcont';  
                     if (defined($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 (defined($token->[2]->{'type'})) {  
  $outstr.=$token->[2]->{'type'}.':';  
                     } else {  
                         $outstr.='normal:';  
                     }  
                     $outstr.='cond';  
                 } elsif ($token->[1] eq 'link') {  
 # ----------------------------------------------------------------------- Links  
                     $outstr.='<&>objlinks';  
   
                         if (defined($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 (defined($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,$infotext);  
 }  
   
   
 # ----------------------------------------------------------- Saves map to disk  
   
 sub savemap {  
     my ($fn,$errtext)=@_;  
     my $infotext='';  
     my %alltypes;  
     my %allvalues;  
     if (($fn=~/\.sequence(\.tmp)*$/) ||  
         ($fn=~/\.page(\.tmp)*$/)) {  
   
 # ------------------------------------------------------------- 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";  
         }  
         foreach (@tags) {  
    my @parts=split(/<:>/,$_);  
            if ($parts[0] eq 'objcont') {  
                my @comp=split(/:/,$parts[$#parts]);  
 # --------------------------------------------------------------- Logical input  
        if (($comp[$#comp] eq 'res') || ($comp[$#comp] eq 'zombie')) {  
                    $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.=" />\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.=" />\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.=" />\n";  
            } elsif ($parts[0] eq 'objparms') {  
                undef %alltypes;  
                undef %allvalues;  
                foreach (split(/:/,$parts[$#parts])) {  
                    my ($type,$name,$value)=split(/\_\_\_/,$_);  
                    $alltypes{$name}=$type;  
                    $allvalues{$name}=$value;  
                }  
                foreach (keys %allvalues) {  
                   if ($allvalues{$_} ne '') {  
                    $outstr.='<param to="'.$parts[1].'" type="'  
                           .$alltypes{$_}.'" name="'.$_  
                           .'" value="'.$allvalues{$_}.'" />'  
                           ."\n";  
           }  
                }  
            } elsif (($parts[0] ne '') && ($graphdef)) {  
 # ------------------------------------------------------------- Graphical input  
                $outstr.='<'.$parts[0];  
                if ($#parts==2) {  
    $outstr.=' index="'.$parts[1].'"';  
                }  
                $outstr.=' value="'.qtescape($parts[$#parts]).'" />'."\n";  
            }  
         }  
         $outstr.="</map>\n";  
  if ($fn=~/^\/*uploaded\/(\w+)\/(\w+)\/(.*)$/) {  
     $env{'form.output'}=$outstr;  
             my $result=&Apache::lonnet::finishuserfileupload($2,$1,  
      'output',$3);  
     if ($result != m|^/uploaded/|) {  
  $errtext.='Map not saved: A network error occured when trying to save the map. ';  
     }  
         } else {  
           my $fh;  
           if ($fh=Apache::File->new(">$fn")) {  
              print $fh $outstr;  
              $infotext.="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,$infotext);  
 }  
   
 # ================================================================ Main Handler  # ================================================================ Main Handler
   
Line 324  sub handler { Line 45  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$/;    $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 $lonDocRoot=$r->dir_config('lonDocRoot');  
   if ( $fn =~ /$lonDocRoot/ ) {  
       #internal authentication, needs fixup.  
       $fn = $url;  
       $fn=~s|^/~(\w+)|/home/$1/public_html|;  
       $fn=~s|/[^/]*/ratserver$||;  
   }  
   my $errtext='';    my $errtext='';
   my $infotext='';    my $infotext='';
   my $outtext='';    my $outtext='';
   
   if ($mode ne 'loadonly') {    if ($mode ne 'loadonly') {
      ($errtext,$infotext)=&savemap($fn,$errtext);       ($errtext,$infotext)=&LONCAPA::map::savemap($fn,$errtext);
   }    }
   ($outtext,$errtext,$infotext)=&loadmap($fn,$errtext,$infotext);    ($outtext,$errtext,$infotext)=&LONCAPA::map::loadmap($fn,$errtext,$infotext);
   
   my $start_page =    my $start_page =
       &Apache::loncommon::start_page('Alert',undef,        &Apache::loncommon::start_page('Alert',undef,
Line 376  ENDSCRIPT Line 90  ENDSCRIPT
   
 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.35  
changed lines
  Added in v.1.42


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