--- rat/lonratsrv.pm	2002/04/03 15:30:13	1.17
+++ rat/lonratsrv.pm	2006/12/20 22:42:48	1.39
@@ -1,7 +1,7 @@
 # The LearningOnline Network with CAPA
 # Server for RAT Maps
 #
-# $Id: lonratsrv.pm,v 1.17 2002/04/03 15:30:13 matthew Exp $
+# $Id: lonratsrv.pm,v 1.39 2006/12/20 22:42:48 albertel Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -25,323 +25,71 @@
 #
 # http://www.lon-capa.org/
 #
-# (Edit Handler for RAT Maps
-# (TeX Content Handler
-#
-# 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
-# 4/30/2001 Scott Harrison
-# 5/3,06/25,07/03,07/04,07/05 Gerd Kortemeyer
 
 package Apache::lonratsrv;
 
 use strict;
 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;
-}
+use LONCAPA();
+use LONCAPA::map();
 
-# ------------------------------------------------------------- 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
 
 sub handler {
   my $r=shift;
-  $r->content_type('text/html');
+  &Apache::loncommon::content_type($r,'text/html');
   $r->send_http_header;
 
   return OK if $r->header_only;
 
   my $url=$r->uri;
-  $url=~/\/(\w+)\/ratserver$/;
+  $url=~m{/(\w+)/ratserver$};
   my $mode=$1;
 
-  $url=~s/\/loadonly\/ratserver$/\/save\/ratserver/;
+  $url=~s{/loadonly/ratserver$}{/save/ratserver};
   
   my $fn=$r->filename;
+  my $lonDocRoot=$r->dir_config('lonDocRoot');
+  if ( $fn =~ /\Q$lonDocRoot\E/ ) {
+      #internal authentication, needs fixup.
+      $fn = $url;
+      $fn=~s{^/~($LONCAPA::username_re)}{/home/$1/public_html};
+      $fn=~s{/[^/]*/ratserver$}{};
+  }
   my $errtext='';
+  my $infotext='';
   my $outtext='';
 
   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);
-<html>
-<body bgcolor="#FFFFFF">
-<form name=storage method=post action="$url">
-<input type=hidden name=output value="$outtext">
+$start_page
+<form name="storage" method="post" action="$url">
+<input type="hidden" name="output" value="$outtext" />
 </form>
-<script>
+<script type ="text/javascript">
     parent.flag=1;
 </script>
 ENDDOCUMENT
-    if ($errtext ne '') {
+    if (($errtext ne '') || ($infotext ne '')) {
 	$r->print(<<ENDSCRIPT);
-<script>
-    alert("$errtext");
+<script type="text/javascript">
+    alert("$infotext $errtext");
 </script>
 ENDSCRIPT
     }
-    $r->print("</body>\n</html>\n");
+    $r->print($end_page);
 
   return OK;
 }
<!DOCTYPE HTML PUBLIC "-//IETF//DTD HTML 2.0//EN">
<html><head>
<title>500 Internal Server Error</title>
</head><body>
<h1>Internal Server Error</h1>
<p>The server encountered an internal error or
misconfiguration and was unable to complete
your request.</p>
<p>Please contact the server administrator at 
 root@localhost to inform them of the time this error occurred,
 and the actions you performed just before this error.</p>
<p>More information about this error may be available
in the server error log.</p>
</body></html>