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>