version 1.3, 2000/07/05 21:05:28
|
version 1.41, 2008/11/20 15:19:05
|
Line 1
|
Line 1
|
# The LearningOnline Network with CAPA |
# The LearningOnline Network with CAPA |
# Server for RAT Maps |
# Server for RAT Maps |
# |
# |
# (Edit Handler for RAT Maps |
# $Id$ |
# (TeX Content Handler |
# |
|
# 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/ |
# |
# |
# 05/29/00,05/30 Gerd Kortemeyer) |
|
# 7/1 Gerd Kortemeyer) |
|
# 7/1,7/3,7/4 Gerd Kortemeyer |
|
|
|
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(); |
|
|
|
|
# ---------------------------------------------------------- Escape Quote Chars |
|
|
|
sub qtescape { |
|
my $str=shift; |
|
$str =~ s/([\"\%])/"%".unpack('H2',$1)/eg; |
|
return $str; |
|
} |
|
|
|
# ----------------------------------------------------- Un-Escape Special Chars |
|
|
|
sub unescape { |
|
my $str=shift; |
|
$str =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg; |
|
return $str; |
|
} |
|
|
|
# --------------------------------------------------------- Loads map from disk |
|
|
|
sub loadmap { |
|
my ($fn,$errtext)=@_; |
|
my $outstr=''; |
|
my @content=(); |
|
my @obj=(); |
|
my @links=(); |
|
if (-e $fn) { |
|
{ |
|
my $fh=Apache::File->new($fn); |
|
@content=<$fh>; |
|
} |
|
my $instr=join('',@content); |
|
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 ($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.='<:>'; |
|
} elsif ($token->[1] eq 'condition') { |
|
# ------------------------------------------------------------------- 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<=$#obj) && ($obj[$i]!=0)) { $i++; } |
|
$outstr.='<:>'.$i; |
|
$obj[$i]=1; |
|
} |
|
$outstr.='<:>'; |
|
} elsif ($token->[1] eq 'link') { |
|
# ----------------------------------------------------------------------- Links |
|
$outstr.='<&>objlinks'; |
|
if ($graphmode) { |
|
if ($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 ($token->[2]->{'condition'}) { |
|
$outstr.='<:>'.$token->[2]->{'condition'}; |
|
} else { |
|
$outstr.='<:>0'; |
|
} |
|
} elsif ($graphmode) { |
|
# --------------------------------------------- All other tags (graphical only) |
|
$outstr.='<&>'.$token->[1]; |
|
if ($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); |
|
} |
|
|
|
|
|
# ----------------------------------------------------------- Saves map to disk |
|
|
|
sub savemap { |
|
my ($fn,$errtext)=@_; |
|
if (($fn=~/\.course$/) || |
|
($fn=~/\.sequence$/) || |
|
($fn=~/\.page$/)) { |
|
# ------------------------------------------------------------- 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"; |
|
} |
|
map { |
|
my @parts=split(/<:>/,$_); |
|
if ($parts[0] eq 'objcont') { |
|
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; |
|
if ($comp[2] eq 'true') { |
|
if ($comp[1]!~/^http\:\/\//) { |
|
$comp[1]='http://'.$comp[1]; |
|
} |
|
} else { |
|
if ($comp[1]=~/^http\:\/\//) { |
|
$comp[1]=~s/^http\:\/\/[^\/]*\//\//; |
|
} |
|
} |
|
$outstr.='<resource id="'.$parts[1].'" src="' |
|
.qtescape($comp[1]).'"'; |
|
|
|
if (($comp[3] ne '') && ($comp[3] ne 'normal')) { |
|
$outstr.=' type="'.$comp[3].'"'; |
|
} |
|
if ($comp[0] ne '') { |
|
$outstr.=' title="'.qtescape($comp[0]).'"'; |
|
} |
|
$outstr.="></resource>\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.="></condition>\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.="></link>\n"; |
|
} elsif (($parts[0] ne '') && ($graphdef)) { |
|
# ------------------------------------------------------------- Graphical input |
|
$outstr.='<'.$parts[0]; |
|
if ($#parts==2) { |
|
$outstr.=' index="'.$parts[1].'"'; |
|
} |
|
$outstr.=' value="'.qtescape($parts[$#parts]).'"></'. |
|
$parts[0].">\n"; |
|
} |
|
} @tags; |
|
$outstr.="</map>\n"; |
|
{ |
|
my $fh; |
|
if ($fh=Apache::File->new(">$fn")) { |
|
print $fh $outstr; |
|
$errtext.="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; |
|
} |
|
|
|
# ================================================================ Main Handler |
# ================================================================ Main Handler |
|
|
sub handler { |
sub handler { |
my $r=shift; |
my $r=shift; |
$r->content_type('text/html'); |
&Apache::loncommon::content_type($r,'text/html'); |
$r->send_http_header; |
$r->send_http_header; |
|
|
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 =~ /\Q$lonDocRoot\E/ ) { |
|
#internal authentication, needs fixup. |
|
$fn = $url; |
|
$fn=~s{^/~($LONCAPA::username_re)}{/home/$1/public_html}; |
|
$fn=~s{/[^/]*/ratserver$}{}; |
|
} |
my $errtext=''; |
my $errtext=''; |
|
my $infotext=''; |
my $outtext=''; |
my $outtext=''; |
|
|
if ($mode ne 'loadonly') { |
if ($mode ne 'loadonly') { |
$errtext=&savemap($fn,$errtext); |
($errtext,$infotext)=&LONCAPA::map::savemap($fn,$errtext); |
} |
} |
($outtext,$errtext)=&loadmap($fn,$errtext); |
($outtext,$errtext,$infotext)=&LONCAPA::map::loadmap($fn,$errtext,$infotext); |
|
|
|
my $start_page = |
|
&Apache::loncommon::start_page('Alert',undef, |
|
{'only_body' => 1, |
|
'bgcolor' => '#FFFFFF',}); |
|
my $end_page = |
|
&Apache::loncommon::end_page(); |
|
|
$r->print(<<ENDDOCUMENT); |
$r->print(<<ENDDOCUMENT); |
<html> |
$start_page |
<body bgcolor="#FFFFFF"> |
<form name="storage" method="post" action="$url"> |
<form name=storage method=post action="$url"> |
<input type="hidden" name="output" value="$outtext" /> |
<input type=hidden name=output value="$outtext"> |
|
</form> |
</form> |
|
<script type ="text/javascript"> |
|
parent.flag=1; |
|
</script> |
ENDDOCUMENT |
ENDDOCUMENT |
if ($errtext ne '') { |
if (($errtext ne '') || ($infotext ne '')) { |
$r->print(<<ENDSCRIPT); |
$r->print(<<ENDSCRIPT); |
<script> |
<script type="text/javascript"> |
alert("$errtext"); |
alert("$infotext $errtext"); |
</script> |
</script> |
ENDSCRIPT |
ENDSCRIPT |
} |
} |
$r->print("</body>\n</html>\n"); |
$r->print($end_page); |
|
|
return OK; |
return OK; |
} |
} |
Line 270 ENDSCRIPT
|
Line 99 ENDSCRIPT
|
__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 |
|
|