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>