Diff for /rat/map.pm between versions 1.5 and 1.13

version 1.5, 2007/01/16 21:18:08 version 1.13, 2009/02/12 11:35:10
Line 27 Line 27
 #  #
   
 package LONCAPA::map;  package LONCAPA::map;
   use strict;
 use HTML::TokeParser;  use HTML::TokeParser;
 use HTML::Entities();  use HTML::Entities();
 use Apache::lonnet;  use Apache::lonnet;
Line 145  sub mapread { Line 145  sub mapread {
 # Call lonsequence::attemptread to read from resource space  # Call lonsequence::attemptread to read from resource space
 #  #
 sub attemptread {  sub attemptread {
     my $fn=shift;      my ($fn,$unsorted)=@_;
   
     my @links;      my @links;
     my @theseres;      my @theseres;
Line 154  sub attemptread { Line 154  sub attemptread {
     if ($errtext) { return @theseres }      if ($errtext) { return @theseres }
   
 # -------------------------------------------------------------------- Read map  # -------------------------------------------------------------------- Read map
       my ($start,$finish);
     foreach (split(/\<\&\>/,$outtext)) {      foreach (split(/\<\&\>/,$outtext)) {
  my ($command,$number,$content)=split(/\<\:\>/,$_);   my ($command,$number,$content)=split(/\<\:\>/,$_);
         if ($command eq 'objcont') {          if ($command eq 'objcont') {
     my ($title,$src,$ext,$type)=split(/\:/,$content);      my ($title,$src,$ext,$type)=split(/\:/,$content);    
     unless ($type eq 'zombie') {      if ($type ne 'zombie' && $ext ne 'cond') {
  $theseres[$number]=$content;   $theseres[$number]=$content;
     }      }
       if ($type eq 'start') {
    $start = $number;
       }
       if ($type eq 'finish') {
    $finish = $number;
       }
         }          }
         if ($command eq 'objlinks') {          if ($command eq 'objlinks') {
             $links[$number]=$content;              $links[$number]=$content;
         }          }
     }      }
       if ($unsorted) {
 # --------------------------------------------------------------- Sort, sort of   return @theseres;
   
     my @objsort;  
   
     for (my $k=1;$k<=$#theseres;$k++) {  
  if (defined($theseres[$k])) {  
     $objsort[$#objsort+1]=$k;  
  }  
     }      }
   
     for (my $k=1;$k<=$#links;$k++) {  # ---------------------------- attempt to flatten the map into a 'sorted' order
  if (defined($links[$k])) {  
     my @data1=split(/\:/,$links[$k]);  
     my $kj=-1;  
     for (my $j=0;$j<=$#objsort;$j++) {  
  if ((split(/\:/,$objsort[$j]))[0]==$data1[0]) {  
     $kj=$j;  
  }  
     }  
     if ($kj!=-1) { $objsort[$kj].=':'.$data1[1]; }  
  }  
     }  
     for (my $k=0;$k<=$#objsort;$k++) {  
  for (my $j=0;$j<=$#objsort;$j++) {  
     if ($k!=$j) {  
  my @data1=split(/\:/,$objsort[$k]);  
  my @data2=split(/\:/,$objsort[$j]);  
  my $dol=$#data1+1;  
  my $dtl=$#data2+1;  
  if ($dol+$dtl<1000) {  
     for (my $kj=1;$kj<$dol;$kj++) {  
  if ($data1[$kj]==$data2[0]) {  
     for ($ij=1;$ij<$dtl;$ij++) {  
  $data1[$#data1+1]=$data2[$ij];  
     }  
  }  
     }  
     for (my $kj=1;$kj<$dtl;$kj++) {  
  if ($data2[$kj]==$data1[0]) {  
     for ($ij=1;$ij<$dol;$ij++) {  
  $data2[$#data2+1]=$data1[$ij];  
     }  
  }  
     }  
     $objsort[$k]=join(':',@data1);  
     $objsort[$j]=join(':',@data2);  
  }  
     }  
  }   
     }  
 # ---------------------------------------------------------------- Now sort out  
   
     @objsort=sort {      my %path_length = ($start => 0);
  my @data1=split(/\:/,$a);      my @todo = @links;
  my @data2=split(/\:/,$b);  
  my $rvalue=0;  
  for (my $k=1;$k<=$#data1;$k++) {  
     if ($data1[$k]==$data2[0]) { $rvalue--; }  
  }  
  for (my $k=1;$k<=$#data2;$k++) {  
     if ($data2[$k]==$data1[0]) { $rvalue++; }  
  }  
  if ($rvalue==0) { $rvalue=$#data2-$#data1; }  
  $rvalue;  
     } @objsort;  
   
       while (@todo) {
    my $link = shift(@todo);
    next if (!defined($link));
    my ($from,$to) = split(':',$link);
    if (!exists($path_length{$from})) {
       # don't know how long it takes to get to this link,
       # save away to retry
       push(@todo,$link);
       next;
    }
    # already have a length, keep it
    next if (exists($path_length{$to}));
    $path_length{$to}=$path_length{$from}+1;
       }
       # invert hash so we have the ids in depth order now
       my @by_depth;
       while (my ($key,$value) = each(%path_length)) {
    push(@{$by_depth[$value]},$key);
       }
       # reorder resources
     my @outres;      my @outres;
       foreach my $ids_at_depth (@by_depth) {
     for ($k=0;$k<=$#objsort;$k++) {   foreach my $id (sort(@{$ids_at_depth})) {
  $outres[$k]=$theseres[(split(/\:/,$objsort[$k]))[0]];      # skip the finish resource
       next if ($id == $finish);
       push(@outres, $theseres[$id]);
    }
     }      }
       # make sure finish is last (in case there are cycles or bypass routes
       # finish can end up with a rather short possible path)
       push(@outres, $theseres[$finish]);
     return @outres;      return @outres;
 }  }
   
 # ------------------------------------- Revive zombie idx or get unused number  # ------------------------------------- Revive zombie idx or get unused number
   
 sub getresidx {  sub getresidx {
     my $url=shift;      my ($url,$residx)= @_;
     my $max=1+($#resources>$#zombies?$#resources:$#zombies);      my $max=1+($#resources>$#zombies?$#resources:$#zombies);
     unless ($url) { return $max; }      unless ($url) { return $max; }
     for (my $i=0; $i<=$#zombies; $i++) {      for (my $i=0; $i<=$#zombies; $i++) {
  my ($title,$src,$ext,$type)=split(/\:/,$zombies[$i]);   my ($title,$src,$ext,$type)=split(/\:/,$zombies[$i]);
  if ($src eq $url) {   if ($src eq $url) {
     undef($zombies[$i]);      if ($residx) {
     return $i;   if ($i == $residx) {
       undef($zombies[$i]);
       return $i;
    }
       } else {
    undef($zombies[$i]);
    return $i;
       }
  }   }
     }      }
     return $max;      return $max;
Line 277  sub pastetarget { Line 258  sub pastetarget {
     my @insertorder=();      my @insertorder=();
     foreach (@which) {      foreach (@which) {
         if (defined($_)) {          if (defined($_)) {
     my ($name,$url)=split(/\=/,$_);      my ($name,$url,$residx)=split(/\=/,$_);
             $name=&unescape($name);              $name=&unescape($name);
             $url=&unescape($url);              $url=&unescape($url);
             if ($url) {              if ($url) {
  my $idx=&getresidx($url);   my $idx=&getresidx($url,$residx);
  $insertorder[$#insertorder+1]=$idx;   $insertorder[$#insertorder+1]=$idx;
  my $ext='false';   my $ext='false';
  if ($url=~/^http\:\/\//) { $ext='true'; }   if ($url=~/^https?\:\/\//) { $ext='true'; }
  $url=~s/\:/\&colon;/g;   $url=~s/\:/\&colon;/g;
  $name=~s/\:/\&colon;/g;   $name=~s/\:/\&colon;/g;
  $resources[$idx]=$name.':'.$url.':'.$ext.':normal:res';   $resources[$idx]=$name.':'.$url.':'.$ext.':normal:res';
Line 302  sub startfinish { Line 283  sub startfinish {
 # Remove all start and finish  # Remove all start and finish
     foreach (@order) {      foreach (@order) {
  my ($name,$url,$ext)=split(/\:/,$resources[$_]);   my ($name,$url,$ext)=split(/\:/,$resources[$_]);
         if ($url=~/http\&colon\:\/\//) { $ext='true'; }          if ($url=~/https?\&colon\:\/\//) { $ext='true'; }
         $resources[$_]=$name.':'.$url.':'.$ext.':normal:res';          $resources[$_]=$name.':'.$url.':'.$ext.':normal:res';
     }      }
 # Garbage collection  # Garbage collection
Line 440  sub qtescape { Line 421  sub qtescape {
     $str=~s/\&\#58\;/\:/g;      $str=~s/\&\#58\;/\:/g;
     $str=~s/\&\#39\;/\'/g;      $str=~s/\&\#39\;/\'/g;
     $str=~s/\&\#44\;/\,/g;      $str=~s/\&\#44\;/\,/g;
     $str=~s/\"/\&\#34\;/g;      $str=~s/\&\#34\;/\"/g;
     return $str;      return $str;
 }  }
   
Line 475  sub loadmap { Line 456  sub loadmap {
         $instr=join('',@content);          $instr=join('',@content);
     }      }
     if ($instr eq -2) {      if ($instr eq -2) {
         $errtext.='Map not loaded: An error occured while trying to load the map.';          $errtext.='Map not loaded: An error occurred while trying to load the map.';
     } elsif ($instr eq '-1') {      } elsif ($instr eq '-1') {
  # Map doesn't exist    # Map doesn't exist 
     } elsif ($instr) {      } elsif ($instr) {
Line 626  sub savemap { Line 607  sub savemap {
 # --------------------------------------------------------------- Logical input  # --------------------------------------------------------------- Logical input
  if (($comp[$#comp] eq 'res') || ($comp[$#comp] eq 'zombie')) {   if (($comp[$#comp] eq 'res') || ($comp[$#comp] eq 'zombie')) {
     $comp[0]=qtescape($comp[0]);      $comp[0]=qtescape($comp[0]);
       $comp[0] = &HTML::Entities::encode($comp[0],'&<>"');
       
     $comp[1]=qtescape($comp[1]);      $comp[1]=qtescape($comp[1]);
     if ($comp[2] eq 'true') {      if ($comp[2] eq 'true') {
  if ($comp[1]!~/^http\:\/\//) {   if ($comp[1]!~/^http\:\/\//) {
Line 644  sub savemap { Line 627  sub savemap {
  $outstr.=' type="'.$comp[3].'"';   $outstr.=' type="'.$comp[3].'"';
     }      }
     if ($comp[0] ne '') {      if ($comp[0] ne '') {
  $outstr.=' title="'.&HTML::Entities::encode($comp[0]).'"';   $outstr.=' title="'.$comp[0].'"';
     }      }
     $outstr.=" />\n";      $outstr.=" />\n";
  } elsif ($comp[$#comp] eq 'cond') {   } elsif ($comp[$#comp] eq 'cond') {
Line 696  sub savemap { Line 679  sub savemap {
             my $result=&Apache::lonnet::finishuserfileupload($2,$1,              my $result=&Apache::lonnet::finishuserfileupload($2,$1,
      'output',$3);       'output',$3);
     if ($result != m|^/uploaded/|) {      if ($result != m|^/uploaded/|) {
  $errtext.='Map not saved: A network error occured when trying to save the map. ';   $errtext.='Map not saved: A network error occurred when trying to save the map. ';
     }      }
         } else {          } else {
     if (open(my $fh,">$fn")) {      if (open(my $fh,">$fn")) {

Removed from v.1.5  
changed lines
  Added in v.1.13


FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>