1: # The LearningOnline Network with CAPA
2: # Server for RAT Maps
3: #
4: # (Edit Handler for RAT Maps
5: # (TeX Content Handler
6: #
7: # 05/29/00,05/30 Gerd Kortemeyer)
8: # 7/1 Gerd Kortemeyer)
9: # 7/1,7/3,7/4 Gerd Kortemeyer
10:
11: package Apache::lonratsrv;
12:
13: use strict;
14: use Apache::Constants qw(:common);
15: use Apache::File;
16: use HTML::TokeParser;
17:
18:
19: # ---------------------------------------------------------- Escape Quote Chars
20:
21: sub qtescape {
22: my $str=shift;
23: $str =~ s/([\"\%])/"%".unpack('H2',$1)/eg;
24: return $str;
25: }
26:
27: # ----------------------------------------------------- Un-Escape Special Chars
28:
29: sub unescape {
30: my $str=shift;
31: $str =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
32: return $str;
33: }
34:
35: # --------------------------------------------------------- Loads map from disk
36:
37: sub loadmap {
38: my ($fn,$errtext)=@_;
39: my $outstr='';
40: my @content=();
41: my @obj=();
42: my @links=();
43: if (-e $fn) {
44: {
45: my $fh=Apache::File->new($fn);
46: @content=<$fh>;
47: }
48: my $instr=join('',@content);
49: my $parser = HTML::TokeParser->new(\$instr);
50: my $token;
51: my $graphmode=0;
52:
53: $fn=~/\.(\w+)$/;
54: $outstr="mode<:>$1";
55:
56: while ($token = $parser->get_token) {
57: if ($token->[0] eq 'S') {
58: if ($token->[1] eq 'map') {
59: $graphmode=($token->[2]->{'mode'} eq 'rat/graphical');
60: } elsif ($token->[1] eq 'resource') {
61: } elsif ($token->[1] eq 'condition') {
62: } elsif ($token->[1] eq 'link') {
63: $outstr.='<&>objlinks';
64: if ($graphmode) {
65: $outstr.='<:>'.$token->[2]->{'index'};
66: @links[$token->[2]->{'index'}]=1;
67: } else {
68: my $i=1;
69: while (($i<=$#links) && ($links[$i]==1)) { $i++; }
70: $outstr.='<:>'.$i;
71: }
72: $outstr.='<:>'.$token->[2]->{'from'}.
73: '<:>'.$token->[2]->{'to'};
74: if ($token->[2]->{'condition'}) {
75: $outstr.='<:>'.$token->[2]->{'condition'};
76: } else {
77: $outstr.='<:>0';
78: }
79: } elsif ($graphmode) {
80: }
81: }
82: }
83:
84: } else {
85: $errtext.='Map not loaded: The file does not exist.';
86: }
87: return($outstr,$errtext);
88: }
89:
90:
91: # ----------------------------------------------------------- Saves map to disk
92:
93: sub savemap {
94: my ($fn,$errtext)=@_;
95: if (($fn=~/\.course$/) ||
96: ($fn=~/\.sequence$/) ||
97: ($fn=~/\.page$/)) {
98: # ------------------------------------------------------------- Deal with input
99: my @tags=split(/<&>/,$ENV{'form.output'});
100: my $outstr='';
101: my $graphdef=0;
102: if ($tags[0] eq 'graphdef<:>yes') {
103: $outstr='<map mode="rat/graphical">'."\n";
104: $graphdef=1;
105: } else {
106: $outstr="<map>\n";
107: }
108: map {
109: my @parts=split(/<:>/,$_);
110: if ($parts[0] eq 'objcont') {
111: my @comp=split(/:/,$parts[$#parts]);
112: # --------------------------------------------------------------- Logical input
113: if ($comp[$#comp] eq 'res') {
114: $comp[0]=~s/\&\#(\d+)\;/pack("C",$1)/eg;
115: $comp[1]=~s/\&\#(\d+)\;/pack("C",$1)/eg;
116: if ($comp[2] eq 'true') {
117: if ($comp[1]!~/^http\:\/\//) {
118: $comp[1]='http://'.$comp[1];
119: }
120: } else {
121: if ($comp[1]=~/^http\:\/\//) {
122: $comp[1]=~s/^http\:\/\/[^\/]*\//\//;
123: }
124: }
125: $outstr.='<resource id="'.$parts[1].'" src="'
126: .qtescape($comp[1]).'"';
127:
128: if (($comp[3] ne '') && ($comp[3] ne 'normal')) {
129: $outstr.=' type="'.$comp[3].'"';
130: }
131: if ($comp[0] ne '') {
132: $outstr.=' title="'.qtescape($comp[0]).'"';
133: }
134: $outstr.="></resource>\n";
135: } elsif ($comp[$#comp] eq 'cond') {
136: $outstr.='<condition id="'.$parts[1].'"';
137: if (($comp[1] ne '') && ($comp[1] ne 'normal')) {
138: $outstr.=' type="'.$comp[1].'"';
139: }
140: $outstr.=' value="'.qtescape($comp[0]).'"';
141: $outstr.="></condition>\n";
142: }
143: } elsif ($parts[0] eq 'objlinks') {
144: my @comp=split(/:/,$parts[$#parts]);
145: $outstr.='<link';
146: $outstr.=' from="'.$comp[0].'"';
147: $outstr.=' to="'.$comp[1].'"';
148: if (($comp[2] ne '') && ($comp[2]!=0)) {
149: $outstr.=' condition="'.$comp[2].'"';
150: }
151: $outstr.=' index="'.$parts[1].'"';
152: $outstr.="></link>\n";
153: } elsif (($parts[0] ne '') && ($graphdef)) {
154: # ------------------------------------------------------------- Graphical input
155: $outstr.='<'.$parts[0];
156: if ($#parts==2) {
157: $outstr.=' index="'.$parts[1].'"';
158: }
159: $outstr.=' value="'.qtescape($parts[$#parts]).'"></'.
160: $parts[0].">\n";
161: }
162: } @tags;
163: $outstr.="</map>\n";
164: {
165: my $fh;
166: if ($fh=Apache::File->new(">$fn")) {
167: print $fh $outstr;
168: $errtext.="Map saved as $fn.";
169: } else {
170: $errtext.='Could not write file $fn. Map not saved.';
171: }
172: }
173: } else {
174: # -------------------------------------------- Cannot write to that file, error
175: $errtext.='Map not saved: The specified path does not exist.';
176: }
177: return $errtext;
178: }
179:
180: # ================================================================ Main Handler
181:
182: sub handler {
183: my $r=shift;
184: $r->content_type('text/html');
185: $r->send_http_header;
186:
187: return OK if $r->header_only;
188:
189: my $url=$r->uri;
190: $url=~/\/(\w+)\/ratserver$/;
191: my $mode=$1;
192:
193: $url=~s/\/loadonly\/ratserver$/\/save\/ratserver/;
194:
195: my $fn=$r->filename;
196: my $errtext='';
197: my $outtext='';
198:
199: if ($mode ne 'loadonly') {
200: $errtext=&savemap($fn,$errtext);
201: }
202: ($outtext,$errtext)=&loadmap($fn,$errtext);
203:
204: $r->print(<<ENDDOCUMENT);
205: <html>
206: <body bgcolor="#FFFFFF">
207: <form name=storage method=post action="$url">
208: <input type=hidden name=output value="$outtext">
209: </form>
210: ENDDOCUMENT
211: if ($errtext ne '') {
212: $r->print(<<ENDSCRIPT);
213: <script>
214: alert("$errtext");
215: </script>
216: ENDSCRIPT
217: }
218: $r->print("</body>\n</html>\n");
219:
220: return OK;
221: }
222:
223: 1;
224: __END__
225:
226:
227:
228:
229:
230:
231:
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>