--- rat/lonratsrv.pm 2000/07/04 16:24:17 1.2
+++ rat/lonratsrv.pm 2002/06/24 14:05:51 1.18
@@ -1,12 +1,38 @@
# The LearningOnline Network with CAPA
# Server for RAT Maps
#
+# $Id: lonratsrv.pm,v 1.18 2002/06/24 14:05:51 www Exp $
+#
+# Copyright Michigan State University Board of Trustees
+#
+# This file is part of the LearningOnline Network with CAPA (LON-CAPA).
+#
+# 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/
+#
# (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 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;
@@ -16,19 +42,25 @@ use Apache::File;
use HTML::TokeParser;
-# ---------------------------------------------------------- Escape Quote Chars
+# ------------------------------------------------------------- From RAT to XML
sub qtescape {
my $str=shift;
- $str =~ s/([\"\%])/"%".unpack('H2',$1)/eg;
+ $str=~s/\&\#58\;/\:/g;
+ $str=~s/\&\#39\;/\'/g;
+ $str=~s/\&\#44\;/\,/g;
+ $str=~s/\"/\&\#34\;/g;
return $str;
}
-# ----------------------------------------------------- Un-Escape Special Chars
+# ------------------------------------------------------------- From XML to RAT
-sub unescape {
+sub qtunescape {
my $str=shift;
- $str =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
+ $str=~s/\:/\&colon\;/g;
+ $str=~s/\'/\&\#39\;/g;
+ $str=~s/\,/\&\#44\;/g;
+ $str=~s/\"/\&\#34\;/g;
return $str;
}
@@ -58,31 +90,105 @@ sub loadmap {
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') {
- } elsif ($token->[1] eq 'link') {
- $outstr.='<&>objlinks';
- if ($graphmode) {
- $outstr.='<:>'.$token->[2]->{'index'};
- @links[$token->[2]->{'index'}]=1;
+# ------------------------------------------------------------------- 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<=$#links) && ($links[$i]==1)) { $i++; }
+ 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'};
+ ':'.$token->[2]->{'to'};
if ($token->[2]->{'condition'}) {
- $outstr.='<:>'.$token->[2]->{'condition'};
+ $outstr.=':'.$token->[2]->{'condition'};
} else {
- $outstr.='<:>0';
- }
+ $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.';
+ $errtext.='Map not loaded: The file does not exist. ';
}
return($outstr,$errtext);
}
@@ -92,9 +198,11 @@ sub loadmap {
sub savemap {
my ($fn,$errtext)=@_;
- if (($fn=~/\.course$/) ||
- ($fn=~/\.sequence$/) ||
+ my %alltypes;
+ my %allvalues;
+ if (($fn=~/\.sequence$/) ||
($fn=~/\.page$/)) {
+
# ------------------------------------------------------------- Deal with input
my @tags=split(/<&>/,$ENV{'form.output'});
my $outstr='';
@@ -111,25 +219,26 @@ sub savemap {
my @comp=split(/:/,$parts[$#parts]);
# --------------------------------------------------------------- Logical input
if ($comp[$#comp] eq 'res') {
- $comp[0]=~s/\&\#(\d+)\;/pack("C",$1)/eg;
- $comp[1]=~s/\&\#(\d+)\;/pack("C",$1)/eg;
+ $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.='