--- rat/lonratsrv.pm 2001/11/29 19:23:49 1.16
+++ rat/lonratsrv.pm 2006/07/21 08:30:57 1.37
@@ -1,7 +1,7 @@
# The LearningOnline Network with CAPA
# Server for RAT Maps
#
-# $Id: lonratsrv.pm,v 1.16 2001/11/29 19:23:49 www Exp $
+# $Id: lonratsrv.pm,v 1.37 2006/07/21 08:30:57 albertel Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -25,14 +25,6 @@
#
# 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;
@@ -40,12 +32,13 @@ use strict;
use Apache::Constants qw(:common);
use Apache::File;
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;
@@ -67,17 +60,25 @@ sub qtunescape {
# --------------------------------------------------------- Loads map from disk
sub loadmap {
- my ($fn,$errtext)=@_;
+ my ($fn,$errtext,$infotext)=@_;
+ if ($errtext) { return('',$errtext); }
my $outstr='';
- my @content=();
my @obj=();
my @links=();
- if (-e $fn) {
+ my $instr='';
+ if ($fn=~/^\/*uploaded\//) {
+ $instr=&Apache::lonnet::getfile($fn);
+ } elsif (-e $fn) {
+ my @content=();
{
my $fh=Apache::File->new($fn);
@content=<$fh>;
}
- my $instr=join('',@content);
+ $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;
@@ -92,7 +93,7 @@ sub loadmap {
} elsif ($token->[1] eq 'resource') {
# -------------------------------------------------------------------- Resource
$outstr.='<&>objcont';
- if ($token->[2]->{'id'}) {
+ if (defined($token->[2]->{'id'})) {
$outstr.='<:>'.$token->[2]->{'id'};
if ($obj[$token->[2]->{'id'}]==1) {
$errtext.='Error: multiple use of ID '.
@@ -113,16 +114,20 @@ sub loadmap {
} else {
$outstr.='false:';
}
- if ($token->[2]->{'type'}) {
+ if (defined($token->[2]->{'type'})) {
$outstr.=$token->[2]->{'type'}.':';
} else {
$outstr.='normal:';
}
- $outstr.='res';
+ if ($token->[2]->{'type'} ne 'zombie') {
+ $outstr.='res';
+ } else {
+ $outstr.='zombie';
+ }
} elsif ($token->[1] eq 'condition') {
# ------------------------------------------------------------------- Condition
$outstr.='<&>objcont';
- if ($token->[2]->{'id'}) {
+ if (defined($token->[2]->{'id'})) {
$outstr.='<:>'.$token->[2]->{'id'};
if ($obj[$token->[2]->{'id'}]==1) {
$errtext.='Error: multiple use of ID '.
@@ -137,7 +142,7 @@ sub loadmap {
}
$outstr.='<:>';
$outstr.=qtunescape($token->[2]->{'value'}).':';
- if ($token->[2]->{'type'}) {
+ if (defined($token->[2]->{'type'})) {
$outstr.=$token->[2]->{'type'}.':';
} else {
$outstr.='normal:';
@@ -147,7 +152,7 @@ sub loadmap {
# ----------------------------------------------------------------------- Links
$outstr.='<&>objlinks';
- if ($token->[2]->{'index'}) {
+ if (defined($token->[2]->{'index'})) {
if ($links[$token->[2]->{'index'}]) {
$errtext.='Error: multiple use of link index '.
$token->[2]->{'index'}.'. ';
@@ -163,7 +168,7 @@ sub loadmap {
$outstr.='<:>'.$token->[2]->{'from'}.
':'.$token->[2]->{'to'};
- if ($token->[2]->{'condition'}) {
+ if (defined($token->[2]->{'condition'})) {
$outstr.=':'.$token->[2]->{'condition'};
} else {
$outstr.=':0';
@@ -190,7 +195,7 @@ sub loadmap {
} else {
$errtext.='Map not loaded: The file does not exist. ';
}
- return($outstr,$errtext);
+ return($outstr,$errtext,$infotext);
}
@@ -198,13 +203,14 @@ sub loadmap {
sub savemap {
my ($fn,$errtext)=@_;
+ my $infotext='';
my %alltypes;
my %allvalues;
- if (($fn=~/\.sequence$/) ||
- ($fn=~/\.page$/)) {
+ if (($fn=~/\.sequence(\.tmp)*$/) ||
+ ($fn=~/\.page(\.tmp)*$/)) {
# ------------------------------------------------------------- Deal with input
- my @tags=split(/<&>/,$ENV{'form.output'});
+ my @tags=split(/<&>/,$env{'form.output'});
my $outstr='';
my $graphdef=0;
if ($tags[0] eq 'graphdef<:>yes') {
@@ -213,12 +219,12 @@ sub savemap {
} else {
$outstr="\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;
- $errtext.="Map saved as $fn. ";
+ $infotext.="Map saved as $fn. ";
} else {
- $errtext.='Could not write file $fn. Map not saved. ';
+ $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;
+ return ($errtext,$infotext);
}
# ================================================================ 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;
@@ -316,32 +330,46 @@ sub handler {
$url=~s/\/loadonly\/ratserver$/\/save\/ratserver/;
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 $infotext='';
my $outtext='';
if ($mode ne 'loadonly') {
- $errtext=&savemap($fn,$errtext);
+ ($errtext,$infotext)=&savemap($fn,$errtext);
}
- ($outtext,$errtext)=&loadmap($fn,$errtext);
+ ($outtext,$errtext,$infotext)=&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
- if ($errtext ne '') {
+ if (($errtext ne '') || ($infotext ne '')) {
$r->print(<
- alert("$errtext");
+
ENDSCRIPT
}
- $r->print("\n