# The LearningOnline Network with CAPA # routines for modyfing .sequence and .page files # # $Id: map.pm,v 1.15 2014/06/14 19:05:00 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 strict; use HTML::TokeParser; use HTML::Entities(); 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,$unsorted)=@_; my @links; my @theseres; my ($outtext,$errtext)=&loadmap($fn,''); 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); 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; } } if ($unsorted) { return @theseres; } # ---------------------------- attempt to flatten the map into a 'sorted' order 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; 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,$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) { if ($residx) { if ($i == $residx) { undef($zombies[$i]); return $i; } } else { 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,$residx)=split(/\=/,$_); $name=&unescape($name); $url=&unescape($url); if ($url) { my $idx=&getresidx($url,$residx); $insertorder[$#insertorder+1]=$idx; my $ext='false'; if ($url=~/^https?\:\/\//) { $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=~/https?\&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; } } } # Make sure this has at least start and finish if ($#order==-1) { $resources[&getresidx()]='::false'; $order[0]=$#resources; } # Put in a start resource my ($name,$url,$ext)=split(/\:/,$resources[$order[0]]); $resources[$order[0]]=$name.':'.$url.':'.$ext.':start:res'; 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,$useorig,$dotimeupdate) = @_; my $fn=$realfn; # unless this is forced to work from the original file, use a temporary file # instead unless ($useorig) { $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,'',$dotimeupdate)); } # ------------------------------------------ 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 occurred while trying to load the map.'; } elsif ($instr eq '-1') { # Map doesn't exist } 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,$dotimeupdate)=@_; 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=''."\n"; $graphdef=1; } else { $outstr="\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[0] = &HTML::Entities::encode($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.='' ."\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.="\n"; if ($fn=~m{^/*uploaded/($LONCAPA::domain_re)/($LONCAPA::courseid_re)/(.*)$}) { $env{'form.output'}=$outstr; my $result=&Apache::lonnet::finishuserfileupload($2,$1, 'output',$3); if ($result != m|^/uploaded/|) { $errtext.='Map not saved: A network error occurred 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. '; } } if ($dotimeupdate) { unless ($errtext) { if ($env{'request.course.id'}) { my $now = time; &Apache::lonnet::put('environment',{'internal.contentchange' => $now}, $env{'course.'.$env{'request.course.id'}.'.domain'}, $env{'course.'.$env{'request.course.id'}.'.num'}); &Apache::lonnet::appenv( {'course.'.$env{'request.course.id'}.'.internal.contentchange' => $now}); &Apache::lonnet::do_cache_new('crschange',$env{'request.course.id'},$now,600); } } } } else { # -------------------------------------------- Cannot write to that file, error $errtext.='Map not saved: The specified path does not exist. '; } return ($errtext,$infotext); } 1; __END__