Annotation of rat/lonratsrv.pm, revision 1.2
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') {
! 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: }
1.1 www 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;
1.2 ! www 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);
1.1 www 203:
204: $r->print(<<ENDDOCUMENT);
205: <html>
206: <body bgcolor="#FFFFFF">
1.2 ! www 207: <form name=storage method=post action="$url">
! 208: <input type=hidden name=output value="$outtext">
1.1 www 209: </form>
1.2 ! www 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");
1.1 www 219:
220: return OK;
221: }
222:
223: 1;
224: __END__
225:
226:
227:
228:
229:
230:
231:
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