[BACK]Return to map.pm CVS log [TXT] [DIR] Up to [LON-CAPA] / rat

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

version 1.9, 2007/12/01 01:59:54 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 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) {      if ($unsorted) {
        return @theseres;   return @theseres;
     }      }
   
 # --------------------------------------------------------------- Sort, sort of  # ---------------------------- attempt to flatten the map into a 'sorted' order
   
     my @objsort;  
   
     for (my $k=1;$k<=$#theseres;$k++) {      my %path_length = ($start => 0);
  if (defined($theseres[$k])) {      my @todo = @links;
     $objsort[$#objsort+1]=$k;  
  }  
     }  
   
     for (my $k=1;$k<=$#links;$k++) {      while (@todo) {
  if (defined($links[$k])) {   my $link = shift(@todo);
     my @data1=split(/\:/,$links[$k]);   next if (!defined($link));
     my $kj=-1;   my ($from,$to) = split(':',$link);
     for (my $j=0;$j<=$#objsort;$j++) {   if (!exists($path_length{$from})) {
  if ((split(/\:/,$objsort[$j]))[0]==$data1[0]) {      # don't know how long it takes to get to this link,
     $kj=$j;      # save away to retry
  }      push(@todo,$link);
     }      next;
     if ($kj!=-1) { $objsort[$kj].=':'.$data1[1]; }   }
  }   # already have a length, keep it
     }   next if (exists($path_length{$to}));
     for (my $k=0;$k<=$#objsort;$k++) {   $path_length{$to}=$path_length{$from}+1;
  for (my $j=0;$j<=$#objsort;$j++) {      }
     if ($k!=$j) {      # invert hash so we have the ids in depth order now
  my @data1=split(/\:/,$objsort[$k]);      my @by_depth;
  my @data2=split(/\:/,$objsort[$j]);      while (my ($key,$value) = each(%path_length)) {
  my $dol=$#data1+1;   push(@{$by_depth[$value]},$key);
  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      # reorder resources
   
     @objsort=sort {  
  my @data1=split(/\:/,$a);  
  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;  
   
     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 294  sub pastetarget { Line 265  sub pastetarget {
  my $idx=&getresidx($url,$residx);   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 312  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 386  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 485  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 645  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 708  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.9  
changed lines
  Added in v.1.12

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
500 Internal Server Error

Internal Server Error

The server encountered an internal error or misconfiguration and was unable to complete your request.

Please contact the server administrator at root@localhost to inform them of the time this error occurred, and the actions you performed just before this error.

More information about this error may be available in the server error log.