# The LearningOnline Network with CAPA # Server for RAT Maps # # $Id: lonratsrv.pm,v 1.34 2005/10/31 18:52:10 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/ # package Apache::lonratsrv; 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'}; } } } } 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=''."\n"; $graphdef=1; } else { $outstr="\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.='' ."\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.="\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 sub handler { my $r=shift; &Apache::loncommon::content_type($r,'text/html'); $r->send_http_header; return OK if $r->header_only; my $url=$r->uri; $url=~/\/(\w+)\/ratserver$/; my $mode=$1; $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,$infotext)=&savemap($fn,$errtext); } ($outtext,$errtext,$infotext)=&loadmap($fn,$errtext,$infotext); $r->print(<
ENDDOCUMENT if (($errtext ne '') || ($infotext ne '')) { $r->print(< alert("$infotext $errtext"); ENDSCRIPT } $r->print("\n\n"); return OK; } 1; __END__