--- rat/map.pm 2007/01/26 23:37:51 1.6
+++ rat/map.pm 2008/09/11 14:47:24 1.11
@@ -1,7 +1,7 @@
# The LearningOnline Network with CAPA
# routines for modyfing .sequence and .page files
#
-# $Id: map.pm,v 1.6 2007/01/26 23:37:51 albertel Exp $
+# $Id: map.pm,v 1.11 2008/09/11 14:47:24 bisitz Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -27,7 +27,7 @@
#
package LONCAPA::map;
-
+use strict;
use HTML::TokeParser;
use HTML::Entities();
use Apache::lonnet;
@@ -145,7 +145,7 @@ sub mapread {
# Call lonsequence::attemptread to read from resource space
#
sub attemptread {
- my $fn=shift;
+ my ($fn,$unsorted)=@_;
my @links;
my @theseres;
@@ -154,105 +154,86 @@ sub attemptread {
if ($errtext) { return @theseres }
# -------------------------------------------------------------------- Read map
+ my ($start,$finish);
foreach (split(/\<\&\>/,$outtext)) {
my ($command,$number,$content)=split(/\<\:\>/,$_);
if ($command eq 'objcont') {
- my ($title,$src,$ext,$type)=split(/\:/,$content);
- unless ($type eq 'zombie') {
+ my ($title,$src,$ext,$type)=split(/\:/,$content);
+ if ($type ne 'zombie' && $ext ne 'cond') {
$theseres[$number]=$content;
}
+ if ($type eq 'start') {
+ $start = $number;
+ }
+ if ($type eq 'finish') {
+ $finish = $number;
+ }
}
if ($command eq 'objlinks') {
$links[$number]=$content;
}
}
-
-# --------------------------------------------------------------- Sort, sort of
-
- my @objsort;
-
- for (my $k=1;$k<=$#theseres;$k++) {
- if (defined($theseres[$k])) {
- $objsort[$#objsort+1]=$k;
- }
+ if ($unsorted) {
+ return @theseres;
}
- for (my $k=1;$k<=$#links;$k++) {
- 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
+# ---------------------------- attempt to flatten the map into a 'sorted' order
- @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 %path_length = ($start => 0);
+ my @todo = @links;
+ 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;
-
- for ($k=0;$k<=$#objsort;$k++) {
- $outres[$k]=$theseres[(split(/\:/,$objsort[$k]))[0]];
+ foreach my $ids_at_depth (@by_depth) {
+ foreach my $id (sort(@{$ids_at_depth})) {
+ # 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;
}
# ------------------------------------- Revive zombie idx or get unused number
sub getresidx {
- my $url=shift;
+ my ($url,$residx)= @_;
my $max=1+($#resources>$#zombies?$#resources:$#zombies);
unless ($url) { return $max; }
for (my $i=0; $i<=$#zombies; $i++) {
my ($title,$src,$ext,$type)=split(/\:/,$zombies[$i]);
if ($src eq $url) {
- undef($zombies[$i]);
- return $i;
+ if ($residx) {
+ if ($i == $residx) {
+ undef($zombies[$i]);
+ return $i;
+ }
+ } else {
+ undef($zombies[$i]);
+ return $i;
+ }
}
}
return $max;
@@ -277,11 +258,11 @@ sub pastetarget {
my @insertorder=();
foreach (@which) {
if (defined($_)) {
- my ($name,$url)=split(/\=/,$_);
+ my ($name,$url,$residx)=split(/\=/,$_);
$name=&unescape($name);
$url=&unescape($url);
if ($url) {
- my $idx=&getresidx($url);
+ my $idx=&getresidx($url,$residx);
$insertorder[$#insertorder+1]=$idx;
my $ext='false';
if ($url=~/^http\:\/\//) { $ext='true'; }
@@ -475,7 +456,7 @@ sub loadmap {
$instr=join('',@content);
}
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') {
# Map doesn't exist
} elsif ($instr) {
@@ -698,7 +679,7 @@ sub savemap {
my $result=&Apache::lonnet::finishuserfileupload($2,$1,
'output',$3);
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 {
if (open(my $fh,">$fn")) {
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.