Return to lonratsrv.pm CVS log

Up to [LON-CAPA] / rat

Next version, deals partly with resources and conditions

    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: # -------------------------------------------------------------------- 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.='<:>';
   77:                 } elsif ($token->[1] eq 'condition') {
   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.='<:>';
   94:                 } elsif ($token->[1] eq 'link') {
   95: # ----------------------------------------------------------------------- Links
   96:                     $outstr.='<&>objlinks';
   97:                     if ($graphmode) {
   98:                         if ($token->[2]->{'index'}) {
   99:                            $errtext.='Error: multiple use of link index '.
  100: 			       $token->[2]->{'index'}.'. ';
  101: 			$outstr.='<:>'.$token->[2]->{'index'};
  102:                         $links[$token->[2]->{'index'}]=1;
  103:                     } else {
  104:                         my $i=1;
  105:                         while (($i<=$#links) && ($links[$i]==1)) { $i++; }
  106:                         $outstr.='<:>'.$i;
  107:                         $links[$i]=1;
  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) {
  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'};
  126:                 }
  127:             }
  128:         }
  129: 
  130:     } else {
  131:         $errtext.='Map not loaded: The file does not exist. ';
  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;
  214:              $errtext.="Map saved as $fn. ";
  215: 	  } else {
  216:              $errtext.='Could not write file $fn. Map not saved. ';
  217: 	  }
  218:         }
  219:     } else {
  220: # -------------------------------------------- Cannot write to that file, error
  221:         $errtext.='Map not saved: The specified path does not exist. ';
  222:     }
  223:     return $errtext;
  224: }
  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;
  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);
  249: 
  250:   $r->print(<<ENDDOCUMENT);
  251: <html>
  252: <body bgcolor="#FFFFFF">
  253: <form name=storage method=post action="$url">
  254: <input type=hidden name=output value="$outtext">
  255: </form>
  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");
  265: 
  266:   return OK;
  267: }
  268: 
  269: 1;
  270: __END__
  271: 
  272: 
  273: 
  274: 
  275: 
  276: 
  277: