File:
[LON-CAPA] /
rat /
map.pm
Revision
1.2:
download - view:
text,
annotated -
select for diffs
Mon Dec 4 14:59:55 2006 UTC (18 years, 5 months ago) by
raeburn
Branches:
MAIN
CVS tags:
HEAD
Checking for existence of allgroups_folder.sequence uses map.pm to check the file system instead of using navmap object to check current user's session.
Locking added while allgroups_folder.sequence is being added, to avoid contention between two CCs adding the first group to a course at the same time.
rat::loadmap() now checks for a return value of -1, as lonnet::getfile() returns -1 when the file is missing. Not sure when the existing branch (checks for -2) is triggered.
# The LearningOnline Network with CAPA
# routines for modyfing .sequence and .page files
#
# $Id: map.pm,v 1.2 2006/12/04 14:59:55 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
# This file is part of the LearningOnline Network with CAPA (LON-CAPA).
#
# LON-CAPA is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# LON-CAPA is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with LON-CAPA; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
#
# /home/httpd/html/adm/gpl.txt
#
# http://www.lon-capa.org/
#
package LONCAPA::map;
use HTML::TokeParser;
use Apache::lonnet;
use Apache::lonlocal;
use File::Copy;
use LONCAPA;
use vars qw(@order @resources @resparms @zombies);
# Mapread read maps into global arrays @links and @resources, determines status
# sets @order - pointer to resources in right order
# sets @resources - array with the resources with correct idx
#
sub mapread {
my ($fn)= @_;
my @links;
@resources=('');
@order=();
@resparms=();
@zombies=();
my ($outtext,$errtext)=&loadmap($fn,'');
if ($errtext) { return ($errtext,2); }
# -------------------------------------------------------------------- Read map
foreach (split(/\<\&\>/,$outtext)) {
my ($command,$number,$content)=split(/\<\:\>/,$_);
if ($command eq 'objcont') {
my ($title,$src,$ext,$type)=split(/\:/,$content);
if ($ext eq 'cond') { next; }
if ($type ne 'zombie') {
$resources[$number]=$content;
} else {
$zombies[$number]=$content;
}
}
if ($command eq 'objlinks') {
$links[$number]=$content;
}
if ($command eq 'objparms') {
if ($resparms[$number]) {
$resparms[$number].='&&&'.$content;
} else {
$resparms[$number]=$content;
}
}
}
# ------------------------------------------------------- Is this a linear map?
my @starters;
my @endings;
foreach (@links) {
if (defined($_)) {
my ($start,$end,$cond)=split(/\:/,$_);
if ((defined($starters[$start])) || (defined($endings[$end]))) {
return
(&mt('Map has branchings. Use advanced editor.'),1);
}
$starters[$start]=1;
$endings[$end]=1;
if ($cond) {
return
(&mt('Map has conditions. Use advanced editor.'),1);
}
}
}
for (my $i=1; $i<=$#resources; $i++) {
if (defined($resources[$i])) {
unless (($starters[$i]) || ($endings[$i])) {
return
(&mt('Map has unconnected resources. Use advanced editor.'),1);
}
}
}
# ---------------------------------------------- Did we just read an empty map?
if ($#resources<1) {
undef $resources[0];
$resources[1]=':::start';
$resources[2]=':::finish';
}
# -------------------------------------------------- This is a linear map, sort
my $startidx=0;
my $endidx=0;
for (my $i=0; $i<=$#resources; $i++) {
if (defined($resources[$i])) {
my ($title,$url,$ext,$type)=split(/\:/,$resources[$i]);
if ($type eq 'start') { $startidx=$i; }
if ($type eq 'finish') { $endidx=$i; }
}
}
my $k=0;
my $currentidx=$startidx;
$order[$k]=$currentidx;
for (my $i=0; $i<=$#resources; $i++) {
foreach (@links) {
my ($start,$end)=split(/\:/,$_);
if ($start==$currentidx) {
$currentidx=$end;
$k++;
$order[$k]=$currentidx;
last;
}
}
if ($currentidx==$endidx) { last; }
}
return $errtext;
}
# ---------------------------------------------- Read a map as well as possible
# Also used by the sequence handler
# Call lonsequence::attemptread to read from resource space
#
sub attemptread {
my $fn=shift;
my @links;
my @theseres;
my ($outtext,$errtext)=&loadmap($fn,'');
if ($errtext) { return @theseres }
# -------------------------------------------------------------------- Read map
foreach (split(/\<\&\>/,$outtext)) {
my ($command,$number,$content)=split(/\<\:\>/,$_);
if ($command eq 'objcont') {
my ($title,$src,$ext,$type)=split(/\:/,$content);
unless ($type eq 'zombie') {
$theseres[$number]=$content;
}
}
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;
}
}
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
@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;
for ($k=0;$k<=$#objsort;$k++) {
$outres[$k]=$theseres[(split(/\:/,$objsort[$k]))[0]];
}
return @outres;
}
# ------------------------------------- Revive zombie idx or get unused number
sub getresidx {
my $url=shift;
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;
}
}
return $max;
}
# --------------------------------------------------------------- Make a zombie
sub makezombie {
my $idx=shift;
my ($name,$url,$ext)=split(/\:/,$resources[$idx]);
my $now=time;
$zombies[$idx]=$name.
' [('.$now.','.$env{'user.name'}.','.$env{'user.domain'}.')]:'.
$url.':'.$ext.':zombie';
}
# ----------------------------------------------------------- Paste into target
# modifies @order, @resources
sub pastetarget {
my ($after,@which)=@_;
my @insertorder=();
foreach (@which) {
if (defined($_)) {
my ($name,$url)=split(/\=/,$_);
$name=&unescape($name);
$url=&unescape($url);
if ($url) {
my $idx=&getresidx($url);
$insertorder[$#insertorder+1]=$idx;
my $ext='false';
if ($url=~/^http\:\/\//) { $ext='true'; }
$url=~s/\:/\:/g;
$name=~s/\:/\:/g;
$resources[$idx]=$name.':'.$url.':'.$ext.':normal:res';
}
}
}
my @oldorder=splice(@order,$after);
@order=(@order,@insertorder,@oldorder);
}
# ------------------------------------------------ Get start and finish correct
# modifies @resources
sub startfinish {
# Remove all start and finish
foreach (@order) {
my ($name,$url,$ext)=split(/\:/,$resources[$_]);
if ($url=~/http\&colon\:\/\//) { $ext='true'; }
$resources[$_]=$name.':'.$url.':'.$ext.':normal:res';
}
# Garbage collection
my $stillchange=1;
while (($#order>1) && ($stillchange)) {
$stillchange=0;
for (my $i=0;$i<=$#order;$i++) {
my ($name,$url,$ext)=split(/\:/,$resources[$order[$i]]);
unless ($url) {
# Take out empty resource
for (my $j=$i+1;$j<=$#order;$j++) {
$order[$j-1]=$order[$j];
}
$#order--;
$stillchange=1;
last;
}
}
}
# Put in a start resource
my ($name,$url,$ext)=split(/\:/,$resources[$order[0]]);
$resources[$order[0]]=$name.':'.$url.':'.$ext.':start:res';
# Make sure this has at least start and finish
if ($#order==0) {
$resources[&getresidx()]='::false';
$order[1]=$#resources;
}
# Make the last one a finish resource
($name,$url,$ext)=split(/\:/,$resources[$order[$#order]]);
$resources[$order[$#order]]=$name.':'.$url.':'.$ext.':finish:res';
}
# ------------------------------------------------------------------- Store map
sub storemap {
my $realfn=shift;
my $fn=$realfn;
# unless this is forced to work from the original file, use a temporary file
# instead
unless (shift) {
$fn=$realfn.'.tmp';
unless (-e $fn) {
copy($realfn,$fn);
}
}
# store data either into tmp or real file
&startfinish();
my $output='graphdef<:>no';
my $k=1;
for (my $i=0; $i<=$#order; $i++) {
if (defined($resources[$order[$i]])) {
$output.='<&>objcont<:>'.$order[$i].'<:>'.$resources[$order[$i]];
}
if (defined($resparms[$order[$i]])) {
foreach (split('&&&',$resparms[$order[$i]])) {
if ($_) {
$output.='<&>objparms<:>'.$order[$i].'<:>'.$_;
}
}
}
if (defined($order[$i+1])) {
if (defined($resources[$order[$i+1]])) {
$output.='<&>objlinks<:>'.$k.'<:>'.
$order[$i].':'.$order[$i+1].':0';
$k++;
}
}
}
for (my $i=0; $i<=$#zombies; $i++) {
if (defined($zombies[$i])) {
$output.='<&>objcont<:>'.$i.'<:>'.$zombies[$i];
}
}
$output=~s/http\&colon\;\/\///g;
$env{'form.output'}=$output;
return &loadmap($fn,&savemap($fn,''));
}
# ------------------------------------------ Store and get parameters in global
sub storeparameter {
my ($to,$name,$value,$ptype)=@_;
my $newentry='';
my $nametype='';
foreach (split('&&&',$resparms[$to])) {
my ($thistype,$thisname,$thisvalue)=split('___',$_);
if ($thisname) {
unless ($thisname eq $name) {
$newentry.=$_.'&&&';
} else {
$nametype=$thistype;
}
}
}
unless ($ptype) { $ptype=$nametype; }
unless ($ptype) { $ptype='string'; }
$newentry.=$ptype.'___'.$name.'___'.$value;
$resparms[$to]=$newentry;
}
sub delparameter {
my ($to,$name)=@_;
my $newentry='';
my $nametype='';
foreach (split('&&&',$resparms[$to])) {
my ($thistype,$thisname,$thisvalue)=split('___',$_);
if ($thisname) {
unless ($thisname eq $name) {
$newentry.=$_.'&&&';
}
}
}
$resparms[$to]=$newentry;
}
sub getparameter {
my ($to,$name)=@_;
my $value=undef;
my $ptype=undef;
foreach (split('&&&',$resparms[$to])) {
my ($thistype,$thisname,$thisvalue)=split('___',$_);
if ($thisname eq $name) {
$value=$thisvalue;
$ptype=$thistype;
}
}
return ($value,$ptype);
}
# ------------------------------------------------------------- From RAT to XML
sub qtescape {
my $str=shift;
$str=~s/\:/\:/g;
$str=~s/\&\#58\;/\:/g;
$str=~s/\&\#39\;/\'/g;
$str=~s/\&\#44\;/\,/g;
$str=~s/\"/\&\#34\;/g;
return $str;
}
# ------------------------------------------------------------- From XML to RAT
sub qtunescape {
my $str=shift;
$str=~s/\:/\&colon\;/g;
$str=~s/\'/\&\#39\;/g;
$str=~s/\,/\&\#44\;/g;
$str=~s/\"/\&\#34\;/g;
return $str;
}
# --------------------------------------------------------- Loads map from disk
sub loadmap {
my ($fn,$errtext,$infotext)=@_;
if ($errtext) { return('',$errtext); }
my $outstr='';
my @obj=();
my @links=();
my $instr='';
if ($fn=~/^\/*uploaded\//) {
$instr=&Apache::lonnet::getfile($fn);
} elsif (-e $fn) {
my @content=();
{
open(my $fh,"<$fn");
@content=<$fh>;
}
$instr=join('',@content);
}
if ($instr eq -2) {
$errtext.='Map not loaded: An error occured while trying to load the map.';
} elsif ($instr eq '-1') {
$errtext.=&mt('Map not loaded: The file [_1] does not exist.',$fn);
} elsif ($instr) {
my $parser = HTML::TokeParser->new(\$instr);
my $token;
my $graphmode=0;
$fn=~/\.(\w+)$/;
$outstr="mode<:>$1";
while ($token = $parser->get_token) {
if ($token->[0] eq 'S') {
if ($token->[1] eq 'map') {
$graphmode=($token->[2]->{'mode'} eq 'rat/graphical');
} elsif ($token->[1] eq 'resource') {
# -------------------------------------------------------------------- Resource
$outstr.='<&>objcont';
if (defined($token->[2]->{'id'})) {
$outstr.='<:>'.$token->[2]->{'id'};
if ($obj[$token->[2]->{'id'}]==1) {
$errtext.='Error: multiple use of ID '.
$token->[2]->{'id'}.'. ';
}
$obj[$token->[2]->{'id'}]=1;
} else {
my $i=1;
while (($i<=$#obj) && ($obj[$i]!=0)) { $i++; }
$outstr.='<:>'.$i;
$obj[$i]=1;
}
$outstr.='<:>';
$outstr.=qtunescape($token->[2]->{'title'}).":";
$outstr.=qtunescape($token->[2]->{'src'}).":";
if ($token->[2]->{'external'} eq 'true') {
$outstr.='true:';
} else {
$outstr.='false:';
}
if (defined($token->[2]->{'type'})) {
$outstr.=$token->[2]->{'type'}.':';
} else {
$outstr.='normal:';
}
if ($token->[2]->{'type'} ne 'zombie') {
$outstr.='res';
} else {
$outstr.='zombie';
}
} elsif ($token->[1] eq 'condition') {
# ------------------------------------------------------------------- Condition
$outstr.='<&>objcont';
if (defined($token->[2]->{'id'})) {
$outstr.='<:>'.$token->[2]->{'id'};
if ($obj[$token->[2]->{'id'}]==1) {
$errtext.='Error: multiple use of ID '.
$token->[2]->{'id'}.'. ';
}
$obj[$token->[2]->{'id'}]=1;
} else {
my $i=1;
while (($i<=$#obj) && ($obj[$i]!=0)) { $i++; }
$outstr.='<:>'.$i;
$obj[$i]=1;
}
$outstr.='<:>';
$outstr.=qtunescape($token->[2]->{'value'}).':';
if (defined($token->[2]->{'type'})) {
$outstr.=$token->[2]->{'type'}.':';
} else {
$outstr.='normal:';
}
$outstr.='cond';
} elsif ($token->[1] eq 'link') {
# ----------------------------------------------------------------------- Links
$outstr.='<&>objlinks';
if (defined($token->[2]->{'index'})) {
if ($links[$token->[2]->{'index'}]) {
$errtext.='Error: multiple use of link index '.
$token->[2]->{'index'}.'. ';
}
$outstr.='<:>'.$token->[2]->{'index'};
$links[$token->[2]->{'index'}]=1;
} else {
my $i=1;
while (($i<=$#links) && ($links[$i]==1)) { $i++; }
$outstr.='<:>'.$i;
$links[$i]=1;
}
$outstr.='<:>'.$token->[2]->{'from'}.
':'.$token->[2]->{'to'};
if (defined($token->[2]->{'condition'})) {
$outstr.=':'.$token->[2]->{'condition'};
} else {
$outstr.=':0';
}
# ------------------------------------------------------------------- Parameter
} elsif ($token->[1] eq 'param') {
$outstr.='<&>objparms<:>'.$token->[2]->{'to'}.'<:>'.
$token->[2]->{'type'}.'___'.$token->[2]->{'name'}.
'___'.$token->[2]->{'value'};
} elsif ($graphmode) {
# --------------------------------------------- All other tags (graphical only)
$outstr.='<&>'.$token->[1];
if (defined($token->[2]->{'index'})) {
$outstr.='<:>'.$token->[2]->{'index'};
if ($token->[1] eq 'obj') {
$obj[$token->[2]->{'index'}]=2;
}
}
$outstr.='<:>'.$token->[2]->{'value'};
}
}
}
} else {
$errtext.='Map not loaded: The file does not exist. ';
}
return($outstr,$errtext,$infotext);
}
# ----------------------------------------------------------- Saves map to disk
sub savemap {
my ($fn,$errtext)=@_;
my $infotext='';
my %alltypes;
my %allvalues;
if (($fn=~/\.sequence(\.tmp)*$/) ||
($fn=~/\.page(\.tmp)*$/)) {
# ------------------------------------------------------------- Deal with input
my @tags=split(/<&>/,$env{'form.output'});
my $outstr='';
my $graphdef=0;
if ($tags[0] eq 'graphdef<:>yes') {
$outstr='<map mode="rat/graphical">'."\n";
$graphdef=1;
} else {
$outstr="<map>\n";
}
foreach (@tags) {
my @parts=split(/<:>/,$_);
if ($parts[0] eq 'objcont') {
my @comp=split(/:/,$parts[$#parts]);
# --------------------------------------------------------------- Logical input
if (($comp[$#comp] eq 'res') || ($comp[$#comp] eq 'zombie')) {
$comp[0]=qtescape($comp[0]);
$comp[1]=qtescape($comp[1]);
if ($comp[2] eq 'true') {
if ($comp[1]!~/^http\:\/\//) {
$comp[1]='http://'.$comp[1];
}
$comp[1].='" external="true';
} else {
if ($comp[1]=~/^http\:\/\//) {
$comp[1]=~s/^http\:\/\/[^\/]*\//\//;
}
}
$outstr.='<resource id="'.$parts[1].'" src="'
.$comp[1].'"';
if (($comp[3] ne '') && ($comp[3] ne 'normal')) {
$outstr.=' type="'.$comp[3].'"';
}
if ($comp[0] ne '') {
$outstr.=' title="'.$comp[0].'"';
}
$outstr.=" />\n";
} elsif ($comp[$#comp] eq 'cond') {
$outstr.='<condition id="'.$parts[1].'"';
if (($comp[1] ne '') && ($comp[1] ne 'normal')) {
$outstr.=' type="'.$comp[1].'"';
}
$outstr.=' value="'.qtescape($comp[0]).'"';
$outstr.=" />\n";
}
} elsif ($parts[0] eq 'objlinks') {
my @comp=split(/:/,$parts[$#parts]);
$outstr.='<link';
$outstr.=' from="'.$comp[0].'"';
$outstr.=' to="'.$comp[1].'"';
if (($comp[2] ne '') && ($comp[2]!=0)) {
$outstr.=' condition="'.$comp[2].'"';
}
$outstr.=' index="'.$parts[1].'"';
$outstr.=" />\n";
} elsif ($parts[0] eq 'objparms') {
undef %alltypes;
undef %allvalues;
foreach (split(/:/,$parts[$#parts])) {
my ($type,$name,$value)=split(/\_\_\_/,$_);
$alltypes{$name}=$type;
$allvalues{$name}=$value;
}
foreach (keys %allvalues) {
if ($allvalues{$_} ne '') {
$outstr.='<param to="'.$parts[1].'" type="'
.$alltypes{$_}.'" name="'.$_
.'" value="'.$allvalues{$_}.'" />'
."\n";
}
}
} elsif (($parts[0] ne '') && ($graphdef)) {
# ------------------------------------------------------------- Graphical input
$outstr.='<'.$parts[0];
if ($#parts==2) {
$outstr.=' index="'.$parts[1].'"';
}
$outstr.=' value="'.qtescape($parts[$#parts]).'" />'."\n";
}
}
$outstr.="</map>\n";
if ($fn=~/^\/*uploaded\/(\w+)\/(\w+)\/(.*)$/) {
$env{'form.output'}=$outstr;
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. ';
}
} else {
if (open(my $fh,">$fn")) {
print $fh $outstr;
$infotext.="Map saved as $fn. ";
} else {
$errtext.='Could not write file '.$fn.'. Map not saved. ';
}
}
} else {
# -------------------------------------------- Cannot write to that file, error
$errtext.='Map not saved: The specified path does not exist. ';
}
return ($errtext,$infotext);
}
1;
__END__
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/back.gif){kind=icon}
Return to map.pm CVS log ![[TXT]](/icons/text.gif){kind=icon}
![[DIR]](/icons/dir.gif){kind=icon}
Up to [LON-CAPA] / rat