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

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

version 1.37, 2006/07/21 08:30:57 version 1.38, 2006/11/02 21:26:54
Line 30  package Apache::lonratsrv; Line 30  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;  
 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 331  sub handler { Line 50  sub handler {
       
   my $fn=$r->filename;    my $fn=$r->filename;
   my $lonDocRoot=$r->dir_config('lonDocRoot');    my $lonDocRoot=$r->dir_config('lonDocRoot');
   if ( $fn =~ /$lonDocRoot/ ) {    if ( $fn =~ /\Q$lonDocRoot\E/ ) {
       #internal authentication, needs fixup.        #internal authentication, needs fixup.
       $fn = $url;        $fn = $url;
       $fn=~s|^/~(\w+)|/home/$1/public_html|;        $fn=~s|^/~(\w+)|/home/$1/public_html|;
Line 342  sub handler { Line 61  sub handler {
   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,
Removed from v.1.37  
changed lines
  Added in v.1.38

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