--- rat/map.pm	2007/01/03 20:46:04	1.4
+++ rat/map.pm	2009/02/12 11:35:10	1.13
@@ -1,7 +1,7 @@
 # The LearningOnline Network with CAPA
 # routines for modyfing .sequence and .page files
 #
-# $Id: map.pm,v 1.4 2007/01/03 20:46:04 albertel Exp $
+# $Id: map.pm,v 1.13 2009/02/12 11:35:10 raeburn Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -27,8 +27,9 @@
 #
 
 package LONCAPA::map;
-
+use strict;
 use HTML::TokeParser;
+use HTML::Entities();
 use Apache::lonnet;
 use Apache::lonlocal;
 use File::Copy;
@@ -144,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;
@@ -153,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;
@@ -276,14 +258,14 @@ 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'; }
+		if ($url=~/^https?\:\/\//) { $ext='true'; }
 		$url=~s/\:/\&colon;/g;
 		$name=~s/\:/\&colon;/g;
 		$resources[$idx]=$name.':'.$url.':'.$ext.':normal:res';
@@ -301,7 +283,7 @@ sub startfinish {
 # Remove all start and finish
     foreach (@order) {
 	my ($name,$url,$ext)=split(/\:/,$resources[$_]);
-        if ($url=~/http\&colon\:\/\//) { $ext='true'; }
+        if ($url=~/https?\&colon\:\/\//) { $ext='true'; }
         $resources[$_]=$name.':'.$url.':'.$ext.':normal:res';
     }
 # Garbage collection
@@ -439,7 +421,7 @@ sub qtescape {
     $str=~s/\&\#58\;/\:/g;
     $str=~s/\&\#39\;/\'/g;
     $str=~s/\&\#44\;/\,/g;
-    $str=~s/\"/\&\#34\;/g;
+    $str=~s/\&\#34\;/\"/g;
     return $str;
 }
 
@@ -474,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) {
@@ -625,6 +607,8 @@ sub savemap {
 # --------------------------------------------------------------- Logical input
 		if (($comp[$#comp] eq 'res') || ($comp[$#comp] eq 'zombie')) {
 		    $comp[0]=qtescape($comp[0]);
+		    $comp[0] = &HTML::Entities::encode($comp[0],'&<>"');
+		    
 		    $comp[1]=qtescape($comp[1]);
 		    if ($comp[2] eq 'true') {
 			if ($comp[1]!~/^http\:\/\//) {
@@ -695,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")) {