version 1.2, 2000/07/04 16:24:17
|
version 1.9, 2001/05/01 15:23:40
|
Line 6
|
Line 6
|
# |
# |
# 05/29/00,05/30 Gerd Kortemeyer) |
# 05/29/00,05/30 Gerd Kortemeyer) |
# 7/1 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 |
|
|
package Apache::lonratsrv; |
package Apache::lonratsrv; |
|
|
Line 16 use Apache::File;
|
Line 17 use Apache::File;
|
use HTML::TokeParser; |
use HTML::TokeParser; |
|
|
|
|
# ---------------------------------------------------------- Escape Quote Chars |
# ------------------------------------------------------------- From RAT to XML |
|
|
sub qtescape { |
sub qtescape { |
my $str=shift; |
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; |
return $str; |
} |
} |
|
|
# ----------------------------------------------------- Un-Escape Special Chars |
# ------------------------------------------------------------- From XML to RAT |
|
|
sub unescape { |
sub qtunescape { |
my $str=shift; |
my $str=shift; |
$str =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg; |
$str=~s/\:/\&\#58\;/g; |
|
$str=~s/\'/\&\#39\;/g; |
|
$str=~s/\,/\&\#44\;/g; |
|
$str=~s/\"/\&\#34\;/g; |
return $str; |
return $str; |
} |
} |
|
|
Line 58 sub loadmap {
|
Line 65 sub loadmap {
|
if ($token->[1] eq 'map') { |
if ($token->[1] eq 'map') { |
$graphmode=($token->[2]->{'mode'} eq 'rat/graphical'); |
$graphmode=($token->[2]->{'mode'} eq 'rat/graphical'); |
} elsif ($token->[1] eq 'resource') { |
} 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.='<:>'; |
|
$outstr.=qtunescape($token->[2]->{'title'}).":"; |
|
$outstr.=qtunescape($token->[2]->{'src'}).":"; |
|
if ($token->[2]->{'src'}=~/\/\//) { |
|
$outstr.='true:'; |
|
} else { |
|
$outstr.='false:'; |
|
} |
|
if ($token->[2]->{'type'}) { |
|
$outstr.=$token->[2]->{'type'}.':'; |
|
} else { |
|
$outstr.='normal:'; |
|
} |
|
$outstr.='res'; |
} elsif ($token->[1] eq 'condition') { |
} elsif ($token->[1] eq 'condition') { |
} elsif ($token->[1] eq 'link') { |
# ------------------------------------------------------------------- Condition |
$outstr.='<&>objlinks'; |
$outstr.='<&>objcont'; |
if ($graphmode) { |
if ($token->[2]->{'id'}) { |
$outstr.='<:>'.$token->[2]->{'index'}; |
$outstr.='<:>'.$token->[2]->{'id'}; |
@links[$token->[2]->{'index'}]=1; |
if ($obj[$token->[2]->{'id'}]==1) { |
|
$errtext.='Error: multiple use of ID '. |
|
$token->[2]->{'id'}.'. '; |
|
} |
|
$obj[$token->[2]->{'id'}]=1; |
} else { |
} else { |
my $i=1; |
my $i=1; |
while (($i<=$#links) && ($links[$i]==1)) { $i++; } |
while (($i<=$#obj) && ($obj[$i]!=0)) { $i++; } |
$outstr.='<:>'.$i; |
$outstr.='<:>'.$i; |
} |
$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 ($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'}. |
$outstr.='<:>'.$token->[2]->{'from'}. |
'<:>'.$token->[2]->{'to'}; |
':'.$token->[2]->{'to'}; |
if ($token->[2]->{'condition'}) { |
if ($token->[2]->{'condition'}) { |
$outstr.='<:>'.$token->[2]->{'condition'}; |
$outstr.=':'.$token->[2]->{'condition'}; |
} else { |
} else { |
$outstr.='<:>0'; |
$outstr.=':0'; |
} |
} |
} elsif ($graphmode) { |
} 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 { |
} else { |
$errtext.='Map not loaded: The file does not exist.'; |
$errtext.='Map not loaded: The file does not exist. '; |
} |
} |
return($outstr,$errtext); |
return($outstr,$errtext); |
} |
} |
Line 92 sub loadmap {
|
Line 168 sub loadmap {
|
|
|
sub savemap { |
sub savemap { |
my ($fn,$errtext)=@_; |
my ($fn,$errtext)=@_; |
if (($fn=~/\.course$/) || |
if (($fn=~/\.sequence$/) || |
($fn=~/\.sequence$/) || |
|
($fn=~/\.page$/)) { |
($fn=~/\.page$/)) { |
|
|
# ------------------------------------------------------------- Deal with input |
# ------------------------------------------------------------- Deal with input |
my @tags=split(/<&>/,$ENV{'form.output'}); |
my @tags=split(/<&>/,$ENV{'form.output'}); |
my $outstr=''; |
my $outstr=''; |
Line 111 sub savemap {
|
Line 187 sub savemap {
|
my @comp=split(/:/,$parts[$#parts]); |
my @comp=split(/:/,$parts[$#parts]); |
# --------------------------------------------------------------- Logical input |
# --------------------------------------------------------------- Logical input |
if ($comp[$#comp] eq 'res') { |
if ($comp[$#comp] eq 'res') { |
$comp[0]=~s/\&\#(\d+)\;/pack("C",$1)/eg; |
$comp[0]=qtescape($comp[0]); |
$comp[1]=~s/\&\#(\d+)\;/pack("C",$1)/eg; |
$comp[1]=qtescape($comp[1]); |
if ($comp[2] eq 'true') { |
if ($comp[2] eq 'true') { |
if ($comp[1]!~/^http\:\/\//) { |
if ($comp[1]!~/^http\:\/\//) { |
$comp[1]='http://'.$comp[1]; |
$comp[1]='http://'.$comp[1]; |
Line 123 sub savemap {
|
Line 199 sub savemap {
|
} |
} |
} |
} |
$outstr.='<resource id="'.$parts[1].'" src="' |
$outstr.='<resource id="'.$parts[1].'" src="' |
.qtescape($comp[1]).'"'; |
.$comp[1].'"'; |
|
|
if (($comp[3] ne '') && ($comp[3] ne 'normal')) { |
if (($comp[3] ne '') && ($comp[3] ne 'normal')) { |
$outstr.=' type="'.$comp[3].'"'; |
$outstr.=' type="'.$comp[3].'"'; |
} |
} |
if ($comp[0] ne '') { |
if ($comp[0] ne '') { |
$outstr.=' title="'.qtescape($comp[0]).'"'; |
$outstr.=' title="'.$comp[0].'"'; |
} |
} |
$outstr.="></resource>\n"; |
$outstr.="></resource>\n"; |
} elsif ($comp[$#comp] eq 'cond') { |
} elsif ($comp[$#comp] eq 'cond') { |
Line 165 sub savemap {
|
Line 241 sub savemap {
|
my $fh; |
my $fh; |
if ($fh=Apache::File->new(">$fn")) { |
if ($fh=Apache::File->new(">$fn")) { |
print $fh $outstr; |
print $fh $outstr; |
$errtext.="Map saved as $fn."; |
$errtext.="Map saved as $fn. "; |
} else { |
} else { |
$errtext.='Could not write file $fn. Map not saved.'; |
$errtext.='Could not write file $fn. Map not saved. '; |
} |
} |
} |
} |
} else { |
} else { |
# -------------------------------------------- Cannot write to that file, error |
# -------------------------------------------- Cannot write to that file, error |
$errtext.='Map not saved: The specified path does not exist.'; |
$errtext.='Map not saved: The specified path does not exist. '; |
} |
} |
return $errtext; |
return $errtext; |
} |
} |
Line 195 sub handler {
|
Line 271 sub handler {
|
my $fn=$r->filename; |
my $fn=$r->filename; |
my $errtext=''; |
my $errtext=''; |
my $outtext=''; |
my $outtext=''; |
|
my $onload=''; |
|
|
if ($mode ne 'loadonly') { |
if ($mode ne 'loadonly') { |
$errtext=&savemap($fn,$errtext); |
$errtext=&savemap($fn,$errtext); |
|
# $onload='onLoad="parent.code.srvloaded();"'; |
} |
} |
($outtext,$errtext)=&loadmap($fn,$errtext); |
($outtext,$errtext)=&loadmap($fn,$errtext); |
|
|
Line 207 sub handler {
|
Line 285 sub handler {
|
<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> |
|
parent.flag=1; |
|
</script> |
ENDDOCUMENT |
ENDDOCUMENT |
if ($errtext ne '') { |
if ($errtext ne '') { |
$r->print(<<ENDSCRIPT); |
$r->print(<<ENDSCRIPT); |