Return to lonratsrv.pm CVS log

Up to [LON-CAPA] / rat

New versions, still in development.

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