version 1.2, 2006/12/04 14:59:55
|
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 Apache::lonnet; |
use Apache::lonnet; |
use Apache::lonlocal; |
use Apache::lonlocal; |
use File::Copy; |
use File::Copy; |
Line 144 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 153 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; |
} |
} |
|
|
# ------------------------------------- Revive zombie idx or get unused number |
# ------------------------------------- Revive zombie idx or get unused number |
|
|
sub getresidx { |
sub getresidx { |
my $url=shift; |
my ($url,$residx)= @_; |
my $max=1+($#resources>$#zombies?$#resources:$#zombies); |
my $max=1+($#resources>$#zombies?$#resources:$#zombies); |
unless ($url) { return $max; } |
unless ($url) { return $max; } |
for (my $i=0; $i<=$#zombies; $i++) { |
for (my $i=0; $i<=$#zombies; $i++) { |
my ($title,$src,$ext,$type)=split(/\:/,$zombies[$i]); |
my ($title,$src,$ext,$type)=split(/\:/,$zombies[$i]); |
if ($src eq $url) { |
if ($src eq $url) { |
undef($zombies[$i]); |
if ($residx) { |
return $i; |
if ($i == $residx) { |
|
undef($zombies[$i]); |
|
return $i; |
|
} |
|
} else { |
|
undef($zombies[$i]); |
|
return $i; |
|
} |
} |
} |
} |
} |
return $max; |
return $max; |
Line 276 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/\:/\:/g; |
$url=~s/\:/\:/g; |
$name=~s/\:/\:/g; |
$name=~s/\:/\:/g; |
$resources[$idx]=$name.':'.$url.':'.$ext.':normal:res'; |
$resources[$idx]=$name.':'.$url.':'.$ext.':normal:res'; |
Line 301 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 375 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 439 sub qtescape {
|
Line 421 sub qtescape {
|
$str=~s/\&\#58\;/\:/g; |
$str=~s/\&\#58\;/\:/g; |
$str=~s/\&\#39\;/\'/g; |
$str=~s/\&\#39\;/\'/g; |
$str=~s/\&\#44\;/\,/g; |
$str=~s/\&\#44\;/\,/g; |
$str=~s/\"/\&\#34\;/g; |
$str=~s/\&\#34\;/\"/g; |
return $str; |
return $str; |
} |
} |
|
|
Line 474 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') { |
$errtext.=&mt('Map not loaded: The file [_1] does not exist.',$fn); |
# Map doesn't exist |
} elsif ($instr) { |
} elsif ($instr) { |
my $parser = HTML::TokeParser->new(\$instr); |
my $parser = HTML::TokeParser->new(\$instr); |
my $token; |
my $token; |
Line 625 sub savemap {
|
Line 607 sub savemap {
|
# --------------------------------------------------------------- Logical input |
# --------------------------------------------------------------- Logical input |
if (($comp[$#comp] eq 'res') || ($comp[$#comp] eq 'zombie')) { |
if (($comp[$#comp] eq 'res') || ($comp[$#comp] eq 'zombie')) { |
$comp[0]=qtescape($comp[0]); |
$comp[0]=qtescape($comp[0]); |
|
$comp[0] = &HTML::Entities::encode($comp[0],'&<>"'); |
|
|
$comp[1]=qtescape($comp[1]); |
$comp[1]=qtescape($comp[1]); |
if ($comp[2] eq 'true') { |
if ($comp[2] eq 'true') { |
if ($comp[1]!~/^http\:\/\//) { |
if ($comp[1]!~/^http\:\/\//) { |
Line 632 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 690 sub savemap {
|
Line 674 sub savemap {
|
} |
} |
} |
} |
$outstr.="</map>\n"; |
$outstr.="</map>\n"; |
if ($fn=~/^\/*uploaded\/(\w+)\/(\w+)\/(.*)$/) { |
if ($fn=~m{^/*uploaded/($LONCAPA::domain_re)/($LONCAPA::courseid_re)/(.*)$}) { |
$env{'form.output'}=$outstr; |
$env{'form.output'}=$outstr; |
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")) { |