--- rat/lonratsrv.pm 2000/07/05 21:05:28 1.3 +++ rat/lonratsrv.pm 2002/06/27 17:00:12 1.20 @@ -1,12 +1,38 @@ # The LearningOnline Network with CAPA # Server for RAT Maps # +# $Id: lonratsrv.pm,v 1.20 2002/06/27 17:00:12 albertel 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; } @@ -74,6 +106,19 @@ sub loadmap { $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'; @@ -91,32 +136,47 @@ sub loadmap { $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 ($graphmode) { + if ($token->[2]->{'index'}) { - $errtext.='Error: multiple use of link 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]->{'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 ($token->[2]->{'index'}) { + if (defined($token->[2]->{'index'})) { $outstr.='<:>'.$token->[2]->{'index'}; if ($token->[1] eq 'obj') { $obj[$token->[2]->{'index'}]=2; @@ -138,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=''; @@ -157,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.='' + ."\n"; + } + } } elsif (($parts[0] ne '') && ($graphdef)) { # ------------------------------------------------------------- Graphical input $outstr.='<'.$parts[0]; @@ -213,7 +292,7 @@ sub savemap { print $fh $outstr; $errtext.="Map saved as $fn. "; } else { - $errtext.='Could not write file $fn. Map not saved. '; + $errtext.='Could not write file '.$fn.'. Map not saved. '; } } } else { @@ -239,6 +318,13 @@ 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 $outtext=''; @@ -253,6 +339,9 @@ sub handler {
+ ENDDOCUMENT if ($errtext ne '') { $r->print(<