Diff for /rat/map.pm between versions 1.7 and 1.12

version 1.7, 2007/07/12 01:04:32 version 1.12, 2008/12/19 03:49:56
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;
 }  }
   
Line 284  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 309  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 383  sub storemap { Line 357  sub storemap {
     $output.='<&>objcont<:>'.$i.'<:>'.$zombies[$i];      $output.='<&>objcont<:>'.$i.'<:>'.$zombies[$i];
         }          }
     }      }
     $output=~s/http\&colon\;\/\///g;      $output=~s/https?\&colon\;\/\///g;
     $env{'form.output'}=$output;      $env{'form.output'}=$output;
     return &loadmap($fn,&savemap($fn,''));      return &loadmap($fn,&savemap($fn,''));
 }  }
Line 482  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 642  sub savemap { Line 616  sub savemap {
  }   }
  $comp[1].='" external="true';   $comp[1].='" external="true';
     } else {      } else {
  if ($comp[1]=~/^http\:\/\//) {   if ($comp[1]=~/^https?\:\/\//) {
     $comp[1]=~s/^http\:\/\/[^\/]*\//\//;      $comp[1]=~s/^https?\:\/\/[^\/]*\//\//;
  }   }
     }      }
     $outstr.='<resource id="'.$parts[1].'" src="'      $outstr.='<resource id="'.$parts[1].'" src="'
Line 705  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.7  
changed lines
  Added in v.1.12


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