[LON-CAPA-cvs] cvs: rat / lonratsrv.pm
albertel
lon-capa-cvs@mail.lon-capa.org
Thu, 02 Nov 2006 21:26:54 -0000
This is a MIME encoded message
--albertel1162502814
Content-Type: text/plain
albertel Thu Nov 2 16:26:54 2006 EDT
Modified files:
/rat lonratsrv.pm
Log:
- complete switch to LONCAPA::map
--albertel1162502814
Content-Type: text/plain
Content-Disposition: attachment; filename="albertel-20061102162654.txt"
Index: rat/lonratsrv.pm
diff -u rat/lonratsrv.pm:1.37 rat/lonratsrv.pm:1.38
--- rat/lonratsrv.pm:1.37 Fri Jul 21 04:30:57 2006
+++ rat/lonratsrv.pm Thu Nov 2 16:26:54 2006
@@ -1,7 +1,7 @@
# The LearningOnline Network with CAPA
# Server for RAT Maps
#
-# $Id: lonratsrv.pm,v 1.37 2006/07/21 08:30:57 albertel Exp $
+# $Id: lonratsrv.pm,v 1.38 2006/11/02 21:26:54 albertel Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -30,289 +30,8 @@
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;
- $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'};
- }
- }
- }
+use LONCAPA::map();
- } 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
@@ -331,7 +50,7 @@
my $fn=$r->filename;
my $lonDocRoot=$r->dir_config('lonDocRoot');
- if ( $fn =~ /$lonDocRoot/ ) {
+ if ( $fn =~ /\Q$lonDocRoot\E/ ) {
#internal authentication, needs fixup.
$fn = $url;
$fn=~s|^/~(\w+)|/home/$1/public_html|;
@@ -342,9 +61,9 @@
my $outtext='';
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 =
&Apache::loncommon::start_page('Alert',undef,
--albertel1162502814--