version 1.35, 2006/04/04 15:32:12
|
version 1.42, 2011/10/25 19:23:20
|
Line 26
|
Line 26
|
# http://www.lon-capa.org/ |
# http://www.lon-capa.org/ |
# |
# |
|
|
|
|
package Apache::lonratsrv; |
package Apache::lonratsrv; |
|
|
use strict; |
use strict; |
use Apache::Constants qw(:common); |
use Apache::Constants qw(:common); |
use Apache::File; |
use LONCAPA(); |
use HTML::TokeParser; |
use LONCAPA::map(); |
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='<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 |
# ================================================================ Main Handler |
|
|
Line 324 sub handler {
|
Line 45 sub handler {
|
return OK if $r->header_only; |
return OK if $r->header_only; |
|
|
my $url=$r->uri; |
my $url=$r->uri; |
$url=~/\/(\w+)\/ratserver$/; |
$url=~m{/(\w+)/ratserver$}; |
my $mode=$1; |
my $mode=$1; |
|
|
$url=~s/\/loadonly\/ratserver$/\/save\/ratserver/; |
$url=~s{/loadonly/ratserver$}{/save/ratserver}; |
|
|
my $fn=$r->filename; |
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 $errtext=''; |
my $infotext=''; |
my $infotext=''; |
my $outtext=''; |
my $outtext=''; |
|
|
if ($mode ne 'loadonly') { |
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 = |
my $start_page = |
&Apache::loncommon::start_page('Alert',undef, |
&Apache::loncommon::start_page('Alert',undef, |
Line 376 ENDSCRIPT
|
Line 90 ENDSCRIPT
|
|
|
1; |
1; |
__END__ |
__END__ |
|
|
|
|
|
=head1 NAME |
|
|
|
Apache::lonratsrv |
|
|
|
=head1 SYNOPSIS |
|
|
|
Handler that takes output from RAT and stores |
|
it on disk. Handles the upper hidden frame of |
|
the added window that comes up in RAT. (3 |
|
frames come up in RAT server, code, and |
|
output. This module handles server |
|
connection.) |
|
|
|
This is part of the LearningOnline Network with CAPA project |
|
described at http://www.lon-capa.org. |
|
|
|
=cut |