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: # -------------------------------------------------------------------- Resource
62: $outstr.='<&>objcont';
63: if ($token->[2]->{'id'}) {
64: $outstr.='<:>'.$token->[2]->{'id'};
65: if ($obj[$token->[2]->{'id'}]==1) {
66: $errtext.='Error: multiple use of ID '.
67: $token->[2]->{'id'}.'. ';
68: }
69: $obj[$token->[2]->{'id'}]=1;
70: } else {
71: my $i=1;
72: while (($i<=$#obj) && ($obj[$i]!=0)) { $i++; }
73: $outstr.='<:>'.$i;
74: $obj[$i]=1;
75: }
76: $outstr.='<:>';
77: } elsif ($token->[1] eq 'condition') {
78: # ------------------------------------------------------------------- Condition
79: $outstr.='<&>objcont';
80: if ($token->[2]->{'id'}) {
81: $outstr.='<:>'.$token->[2]->{'id'};
82: if ($obj[$token->[2]->{'id'}]==1) {
83: $errtext.='Error: multiple use of ID '.
84: $token->[2]->{'id'}.'. ';
85: }
86: $obj[$token->[2]->{'id'}]=1;
87: } else {
88: my $i=1;
89: while (($i<=$#obj) && ($obj[$i]!=0)) { $i++; }
90: $outstr.='<:>'.$i;
91: $obj[$i]=1;
92: }
93: $outstr.='<:>';
94: } elsif ($token->[1] eq 'link') {
95: # ----------------------------------------------------------------------- Links
96: $outstr.='<&>objlinks';
97: if ($graphmode) {
98: if ($token->[2]->{'index'}) {
99: $errtext.='Error: multiple use of link index '.
100: $token->[2]->{'index'}.'. ';
101: $outstr.='<:>'.$token->[2]->{'index'};
102: $links[$token->[2]->{'index'}]=1;
103: } else {
104: my $i=1;
105: while (($i<=$#links) && ($links[$i]==1)) { $i++; }
106: $outstr.='<:>'.$i;
107: $links[$i]=1;
108: }
109: $outstr.='<:>'.$token->[2]->{'from'}.
110: '<:>'.$token->[2]->{'to'};
111: if ($token->[2]->{'condition'}) {
112: $outstr.='<:>'.$token->[2]->{'condition'};
113: } else {
114: $outstr.='<:>0';
115: }
116: } elsif ($graphmode) {
117: # --------------------------------------------- All other tags (graphical only)
118: $outstr.='<&>'.$token->[1];
119: if ($token->[2]->{'index'}) {
120: $outstr.='<:>'.$token->[2]->{'index'};
121: if ($token->[1] eq 'obj') {
122: $obj[$token->[2]->{'index'}]=2;
123: }
124: }
125: $outstr.='<:>'.$token->[2]->{'value'};
126: }
127: }
128: }
129:
130: } else {
131: $errtext.='Map not loaded: The file does not exist. ';
132: }
133: return($outstr,$errtext);
134: }
135:
136:
137: # ----------------------------------------------------------- Saves map to disk
138:
139: sub savemap {
140: my ($fn,$errtext)=@_;
141: if (($fn=~/\.course$/) ||
142: ($fn=~/\.sequence$/) ||
143: ($fn=~/\.page$/)) {
144: # ------------------------------------------------------------- Deal with input
145: my @tags=split(/<&>/,$ENV{'form.output'});
146: my $outstr='';
147: my $graphdef=0;
148: if ($tags[0] eq 'graphdef<:>yes') {
149: $outstr='<map mode="rat/graphical">'."\n";
150: $graphdef=1;
151: } else {
152: $outstr="<map>\n";
153: }
154: map {
155: my @parts=split(/<:>/,$_);
156: if ($parts[0] eq 'objcont') {
157: my @comp=split(/:/,$parts[$#parts]);
158: # --------------------------------------------------------------- Logical input
159: if ($comp[$#comp] eq 'res') {
160: $comp[0]=~s/\&\#(\d+)\;/pack("C",$1)/eg;
161: $comp[1]=~s/\&\#(\d+)\;/pack("C",$1)/eg;
162: if ($comp[2] eq 'true') {
163: if ($comp[1]!~/^http\:\/\//) {
164: $comp[1]='http://'.$comp[1];
165: }
166: } else {
167: if ($comp[1]=~/^http\:\/\//) {
168: $comp[1]=~s/^http\:\/\/[^\/]*\//\//;
169: }
170: }
171: $outstr.='<resource id="'.$parts[1].'" src="'
172: .qtescape($comp[1]).'"';
173:
174: if (($comp[3] ne '') && ($comp[3] ne 'normal')) {
175: $outstr.=' type="'.$comp[3].'"';
176: }
177: if ($comp[0] ne '') {
178: $outstr.=' title="'.qtescape($comp[0]).'"';
179: }
180: $outstr.="></resource>\n";
181: } elsif ($comp[$#comp] eq 'cond') {
182: $outstr.='<condition id="'.$parts[1].'"';
183: if (($comp[1] ne '') && ($comp[1] ne 'normal')) {
184: $outstr.=' type="'.$comp[1].'"';
185: }
186: $outstr.=' value="'.qtescape($comp[0]).'"';
187: $outstr.="></condition>\n";
188: }
189: } elsif ($parts[0] eq 'objlinks') {
190: my @comp=split(/:/,$parts[$#parts]);
191: $outstr.='<link';
192: $outstr.=' from="'.$comp[0].'"';
193: $outstr.=' to="'.$comp[1].'"';
194: if (($comp[2] ne '') && ($comp[2]!=0)) {
195: $outstr.=' condition="'.$comp[2].'"';
196: }
197: $outstr.=' index="'.$parts[1].'"';
198: $outstr.="></link>\n";
199: } elsif (($parts[0] ne '') && ($graphdef)) {
200: # ------------------------------------------------------------- Graphical input
201: $outstr.='<'.$parts[0];
202: if ($#parts==2) {
203: $outstr.=' index="'.$parts[1].'"';
204: }
205: $outstr.=' value="'.qtescape($parts[$#parts]).'"></'.
206: $parts[0].">\n";
207: }
208: } @tags;
209: $outstr.="</map>\n";
210: {
211: my $fh;
212: if ($fh=Apache::File->new(">$fn")) {
213: print $fh $outstr;
214: $errtext.="Map saved as $fn. ";
215: } else {
216: $errtext.='Could not write file $fn. Map not saved. ';
217: }
218: }
219: } else {
220: # -------------------------------------------- Cannot write to that file, error
221: $errtext.='Map not saved: The specified path does not exist. ';
222: }
223: return $errtext;
224: }
225:
226: # ================================================================ Main Handler
227:
228: sub handler {
229: my $r=shift;
230: $r->content_type('text/html');
231: $r->send_http_header;
232:
233: return OK if $r->header_only;
234:
235: my $url=$r->uri;
236: $url=~/\/(\w+)\/ratserver$/;
237: my $mode=$1;
238:
239: $url=~s/\/loadonly\/ratserver$/\/save\/ratserver/;
240:
241: my $fn=$r->filename;
242: my $errtext='';
243: my $outtext='';
244:
245: if ($mode ne 'loadonly') {
246: $errtext=&savemap($fn,$errtext);
247: }
248: ($outtext,$errtext)=&loadmap($fn,$errtext);
249:
250: $r->print(<<ENDDOCUMENT);
251: <html>
252: <body bgcolor="#FFFFFF">
253: <form name=storage method=post action="$url">
254: <input type=hidden name=output value="$outtext">
255: </form>
256: ENDDOCUMENT
257: if ($errtext ne '') {
258: $r->print(<<ENDSCRIPT);
259: <script>
260: alert("$errtext");
261: </script>
262: ENDSCRIPT
263: }
264: $r->print("</body>\n</html>\n");
265:
266: return OK;
267: }
268:
269: 1;
270: __END__
271:
272:
273:
274:
275:
276:
277:
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>