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

version 1.7, 2007/07/12 01:04:32 version 1.14, 2012/07/21 21:20:19
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 345  sub startfinish { Line 319  sub startfinish {
 # ------------------------------------------------------------------- Store map  # ------------------------------------------------------------------- Store map
   
 sub storemap {  sub storemap {
     my $realfn=shift;      my ($realfn,$useorig,$dotimeupdate) = @_;
     my $fn=$realfn;      my $fn=$realfn;
 # unless this is forced to work from the original file, use a temporary file  # unless this is forced to work from the original file, use a temporary file
 # instead  # instead
     unless (shift) {      unless ($useorig) {
  $fn=$realfn.'.tmp';   $fn=$realfn.'.tmp';
  unless (-e $fn) {   unless (-e $fn) {
     copy($realfn,$fn);      copy($realfn,$fn);
Line 385  sub storemap { Line 359  sub storemap {
     }      }
     $output=~s/http\&colon\;\/\///g;      $output=~s/http\&colon\;\/\///g;
     $env{'form.output'}=$output;      $env{'form.output'}=$output;
     return &loadmap($fn,&savemap($fn,''));      return &loadmap($fn,&savemap($fn,'',$dotimeupdate));
 }  }
   
 # ------------------------------------------ Store and get parameters in global  # ------------------------------------------ Store and get parameters in global
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 609  sub loadmap { Line 583  sub loadmap {
 # ----------------------------------------------------------- Saves map to disk  # ----------------------------------------------------------- Saves map to disk
   
 sub savemap {  sub savemap {
     my ($fn,$errtext)=@_;      my ($fn,$errtext,$dotimeupdate)=@_;
     my $infotext='';      my $infotext='';
     my %alltypes;      my %alltypes;
     my %allvalues;      my %allvalues;
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")) {
Line 715  sub savemap { Line 689  sub savemap {
  $errtext.='Could not write file '.$fn.'.  Map not saved. ';   $errtext.='Could not write file '.$fn.'.  Map not saved. ';
     }      }
         }          }
           if ($dotimeupdate) {
               unless ($errtext) {
                   if ($env{'request.course.id'}) {
                       my $now = time;
                       &Apache::lonnet::put('environment',{'internal.contentchange' => $now},
                                            $env{'course.'.$env{'request.course.id'}.'.domain'},
                                            $env{'course.'.$env{'request.course.id'}.'.num'});
                       &Apache::lonnet::appenv(
                           {'course.'.$env{'request.course.id'}.'.internal.contentchange' => $now});
                       &Apache::lonnet::do_cache_new('crschange',$env{'request.course.id'},$now,600);
                   }
               }
           }
     } else {      } else {
 # -------------------------------------------- Cannot write to that file, error  # -------------------------------------------- Cannot write to that file, error
         $errtext.='Map not saved: The specified path does not exist. ';          $errtext.='Map not saved: The specified path does not exist. ';

Removed from v.1.7  
changed lines
  Added in v.1.14


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