Annotation of rat/lonratsrv.pm, revision 1.3
1.1 www 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)
1.2 www 9: # 7/1,7/3,7/4 Gerd Kortemeyer
1.1 www 10:
11: package Apache::lonratsrv;
12:
13: use strict;
14: use Apache::Constants qw(:common);
1.2 www 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') {
1.3 ! www 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.='<:>';
1.2 www 77: } elsif ($token->[1] eq 'condition') {
1.3 ! www 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.='<:>';
1.2 www 94: } elsif ($token->[1] eq 'link') {
1.3 ! www 95: # ----------------------------------------------------------------------- Links
1.2 www 96: $outstr.='<&>objlinks';
97: if ($graphmode) {
1.3 ! www 98: if ($token->[2]->{'index'}) {
! 99: $errtext.='Error: multiple use of link index '.
! 100: $token->[2]->{'index'}.'. ';
1.2 www 101: $outstr.='<:>'.$token->[2]->{'index'};
1.3 ! www 102: $links[$token->[2]->{'index'}]=1;
1.2 www 103: } else {
104: my $i=1;
105: while (($i<=$#links) && ($links[$i]==1)) { $i++; }
106: $outstr.='<:>'.$i;
1.3 ! www 107: $links[$i]=1;
1.2 www 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) {
1.3 ! www 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'};
1.2 www 126: }
127: }
128: }
129:
130: } else {
1.3 ! www 131: $errtext.='Map not loaded: The file does not exist. ';
1.2 www 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;
1.3 ! www 214: $errtext.="Map saved as $fn. ";
1.2 www 215: } else {
1.3 ! www 216: $errtext.='Could not write file $fn. Map not saved. ';
1.2 www 217: }
218: }
219: } else {
220: # -------------------------------------------- Cannot write to that file, error
1.3 ! www 221: $errtext.='Map not saved: The specified path does not exist. ';
1.2 www 222: }
223: return $errtext;
224: }
1.1 www 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;
1.2 www 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);
1.1 www 249:
250: $r->print(<<ENDDOCUMENT);
251: <html>
252: <body bgcolor="#FFFFFF">
1.2 www 253: <form name=storage method=post action="$url">
254: <input type=hidden name=output value="$outtext">
1.1 www 255: </form>
1.2 www 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");
1.1 www 265:
266: return OK;
267: }
268:
269: 1;
270: __END__
271:
272:
273:
274:
275:
276:
277:
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/back.gif){kind=icon}
Return to lonratsrv.pm CVS log ![[TXT]](/icons/text.gif){kind=icon}
![[DIR]](/icons/dir.gif){kind=icon}
Up to [LON-CAPA] / rat