Annotation of rat/map.pm, revision 1.14
1.1 albertel 1: # The LearningOnline Network with CAPA
2: # routines for modyfing .sequence and .page files
3: #
1.14 ! raeburn 4: # $Id: map.pm,v 1.13 2009/02/12 11:35:10 raeburn Exp $
1.1 albertel 5: #
6: # Copyright Michigan State University Board of Trustees
7: #
8: # This file is part of the LearningOnline Network with CAPA (LON-CAPA).
9: #
10: # LON-CAPA is free software; you can redistribute it and/or modify
11: # it under the terms of the GNU General Public License as published by
12: # the Free Software Foundation; either version 2 of the License, or
13: # (at your option) any later version.
14: #
15: # LON-CAPA is distributed in the hope that it will be useful,
16: # but WITHOUT ANY WARRANTY; without even the implied warranty of
17: # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18: # GNU General Public License for more details.
19: #
20: # You should have received a copy of the GNU General Public License
21: # along with LON-CAPA; if not, write to the Free Software
22: # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
23: #
24: # /home/httpd/html/adm/gpl.txt
25: #
26: # http://www.lon-capa.org/
27: #
28:
29: package LONCAPA::map;
1.10 albertel 30: use strict;
1.1 albertel 31: use HTML::TokeParser;
1.5 albertel 32: use HTML::Entities();
1.1 albertel 33: use Apache::lonnet;
34: use Apache::lonlocal;
35: use File::Copy;
36: use LONCAPA;
37:
38: use vars qw(@order @resources @resparms @zombies);
39:
40: # Mapread read maps into global arrays @links and @resources, determines status
41: # sets @order - pointer to resources in right order
42: # sets @resources - array with the resources with correct idx
43: #
44: sub mapread {
45: my ($fn)= @_;
46:
47: my @links;
48:
49: @resources=('');
50: @order=();
51: @resparms=();
52: @zombies=();
53:
54: my ($outtext,$errtext)=&loadmap($fn,'');
55: if ($errtext) { return ($errtext,2); }
56:
57: # -------------------------------------------------------------------- Read map
58: foreach (split(/\<\&\>/,$outtext)) {
59: my ($command,$number,$content)=split(/\<\:\>/,$_);
60: if ($command eq 'objcont') {
61: my ($title,$src,$ext,$type)=split(/\:/,$content);
62: if ($ext eq 'cond') { next; }
63: if ($type ne 'zombie') {
64: $resources[$number]=$content;
65: } else {
66: $zombies[$number]=$content;
67: }
68: }
69: if ($command eq 'objlinks') {
70: $links[$number]=$content;
71: }
72: if ($command eq 'objparms') {
73: if ($resparms[$number]) {
74: $resparms[$number].='&&&'.$content;
75: } else {
76: $resparms[$number]=$content;
77: }
78: }
79: }
80: # ------------------------------------------------------- Is this a linear map?
81: my @starters;
82: my @endings;
83:
84: foreach (@links) {
85: if (defined($_)) {
86: my ($start,$end,$cond)=split(/\:/,$_);
87: if ((defined($starters[$start])) || (defined($endings[$end]))) {
88: return
89: (&mt('Map has branchings. Use advanced editor.'),1);
90: }
91: $starters[$start]=1;
92: $endings[$end]=1;
93: if ($cond) {
94: return
95: (&mt('Map has conditions. Use advanced editor.'),1);
96: }
97: }
98: }
99:
100: for (my $i=1; $i<=$#resources; $i++) {
101: if (defined($resources[$i])) {
102: unless (($starters[$i]) || ($endings[$i])) {
103: return
104: (&mt('Map has unconnected resources. Use advanced editor.'),1);
105: }
106: }
107: }
108: # ---------------------------------------------- Did we just read an empty map?
109: if ($#resources<1) {
110: undef $resources[0];
111: $resources[1]=':::start';
112: $resources[2]=':::finish';
113: }
114: # -------------------------------------------------- This is a linear map, sort
115:
116: my $startidx=0;
117: my $endidx=0;
118: for (my $i=0; $i<=$#resources; $i++) {
119: if (defined($resources[$i])) {
120: my ($title,$url,$ext,$type)=split(/\:/,$resources[$i]);
121: if ($type eq 'start') { $startidx=$i; }
122: if ($type eq 'finish') { $endidx=$i; }
123: }
124: }
125: my $k=0;
126: my $currentidx=$startidx;
127: $order[$k]=$currentidx;
128: for (my $i=0; $i<=$#resources; $i++) {
129: foreach (@links) {
130: my ($start,$end)=split(/\:/,$_);
131: if ($start==$currentidx) {
132: $currentidx=$end;
133: $k++;
134: $order[$k]=$currentidx;
135: last;
136: }
137: }
138: if ($currentidx==$endidx) { last; }
139: }
140: return $errtext;
141: }
142:
143: # ---------------------------------------------- Read a map as well as possible
144: # Also used by the sequence handler
145: # Call lonsequence::attemptread to read from resource space
146: #
147: sub attemptread {
1.9 albertel 148: my ($fn,$unsorted)=@_;
1.1 albertel 149:
150: my @links;
151: my @theseres;
152:
153: my ($outtext,$errtext)=&loadmap($fn,'');
154: if ($errtext) { return @theseres }
155:
156: # -------------------------------------------------------------------- Read map
1.10 albertel 157: my ($start,$finish);
1.1 albertel 158: foreach (split(/\<\&\>/,$outtext)) {
159: my ($command,$number,$content)=split(/\<\:\>/,$_);
160: if ($command eq 'objcont') {
1.10 albertel 161: my ($title,$src,$ext,$type)=split(/\:/,$content);
162: if ($type ne 'zombie' && $ext ne 'cond') {
1.1 albertel 163: $theseres[$number]=$content;
164: }
1.10 albertel 165: if ($type eq 'start') {
166: $start = $number;
167: }
168: if ($type eq 'finish') {
169: $finish = $number;
170: }
1.1 albertel 171: }
172: if ($command eq 'objlinks') {
173: $links[$number]=$content;
174: }
175: }
1.9 albertel 176: if ($unsorted) {
1.10 albertel 177: return @theseres;
1.9 albertel 178: }
1.1 albertel 179:
1.10 albertel 180: # ---------------------------- attempt to flatten the map into a 'sorted' order
1.1 albertel 181:
1.10 albertel 182: my %path_length = ($start => 0);
183: my @todo = @links;
1.1 albertel 184:
1.10 albertel 185: while (@todo) {
186: my $link = shift(@todo);
187: next if (!defined($link));
188: my ($from,$to) = split(':',$link);
189: if (!exists($path_length{$from})) {
190: # don't know how long it takes to get to this link,
191: # save away to retry
192: push(@todo,$link);
193: next;
194: }
195: # already have a length, keep it
196: next if (exists($path_length{$to}));
197: $path_length{$to}=$path_length{$from}+1;
198: }
199: # invert hash so we have the ids in depth order now
200: my @by_depth;
201: while (my ($key,$value) = each(%path_length)) {
202: push(@{$by_depth[$value]},$key);
1.1 albertel 203: }
1.10 albertel 204: # reorder resources
205: my @outres;
206: foreach my $ids_at_depth (@by_depth) {
207: foreach my $id (sort(@{$ids_at_depth})) {
208: # skip the finish resource
209: next if ($id == $finish);
210: push(@outres, $theseres[$id]);
1.1 albertel 211: }
212: }
1.10 albertel 213: # make sure finish is last (in case there are cycles or bypass routes
214: # finish can end up with a rather short possible path)
215: push(@outres, $theseres[$finish]);
1.1 albertel 216: return @outres;
217: }
218:
219: # ------------------------------------- Revive zombie idx or get unused number
220:
221: sub getresidx {
1.7 albertel 222: my ($url,$residx)= @_;
1.1 albertel 223: my $max=1+($#resources>$#zombies?$#resources:$#zombies);
224: unless ($url) { return $max; }
225: for (my $i=0; $i<=$#zombies; $i++) {
226: my ($title,$src,$ext,$type)=split(/\:/,$zombies[$i]);
227: if ($src eq $url) {
1.7 albertel 228: if ($residx) {
229: if ($i == $residx) {
230: undef($zombies[$i]);
231: return $i;
232: }
233: } else {
234: undef($zombies[$i]);
235: return $i;
236: }
1.1 albertel 237: }
238: }
239: return $max;
240: }
241:
242: # --------------------------------------------------------------- Make a zombie
243:
244: sub makezombie {
245: my $idx=shift;
246: my ($name,$url,$ext)=split(/\:/,$resources[$idx]);
247: my $now=time;
248: $zombies[$idx]=$name.
249: ' [('.$now.','.$env{'user.name'}.','.$env{'user.domain'}.')]:'.
250: $url.':'.$ext.':zombie';
251: }
252:
253: # ----------------------------------------------------------- Paste into target
254: # modifies @order, @resources
255:
256: sub pastetarget {
257: my ($after,@which)=@_;
258: my @insertorder=();
259: foreach (@which) {
260: if (defined($_)) {
1.8 albertel 261: my ($name,$url,$residx)=split(/\=/,$_);
1.1 albertel 262: $name=&unescape($name);
263: $url=&unescape($url);
264: if ($url) {
1.8 albertel 265: my $idx=&getresidx($url,$residx);
1.1 albertel 266: $insertorder[$#insertorder+1]=$idx;
267: my $ext='false';
1.12 raeburn 268: if ($url=~/^https?\:\/\//) { $ext='true'; }
1.1 albertel 269: $url=~s/\:/\:/g;
270: $name=~s/\:/\:/g;
271: $resources[$idx]=$name.':'.$url.':'.$ext.':normal:res';
272: }
273: }
274: }
275: my @oldorder=splice(@order,$after);
276: @order=(@order,@insertorder,@oldorder);
277: }
278:
279: # ------------------------------------------------ Get start and finish correct
280: # modifies @resources
281:
282: sub startfinish {
283: # Remove all start and finish
284: foreach (@order) {
285: my ($name,$url,$ext)=split(/\:/,$resources[$_]);
1.12 raeburn 286: if ($url=~/https?\&colon\:\/\//) { $ext='true'; }
1.1 albertel 287: $resources[$_]=$name.':'.$url.':'.$ext.':normal:res';
288: }
289: # Garbage collection
290: my $stillchange=1;
291: while (($#order>1) && ($stillchange)) {
292: $stillchange=0;
293: for (my $i=0;$i<=$#order;$i++) {
294: my ($name,$url,$ext)=split(/\:/,$resources[$order[$i]]);
295: unless ($url) {
296: # Take out empty resource
297: for (my $j=$i+1;$j<=$#order;$j++) {
298: $order[$j-1]=$order[$j];
299: }
300: $#order--;
301: $stillchange=1;
302: last;
303: }
304: }
305: }
306: # Put in a start resource
307: my ($name,$url,$ext)=split(/\:/,$resources[$order[0]]);
308: $resources[$order[0]]=$name.':'.$url.':'.$ext.':start:res';
309: # Make sure this has at least start and finish
310: if ($#order==0) {
311: $resources[&getresidx()]='::false';
312: $order[1]=$#resources;
313: }
314: # Make the last one a finish resource
315: ($name,$url,$ext)=split(/\:/,$resources[$order[$#order]]);
316: $resources[$order[$#order]]=$name.':'.$url.':'.$ext.':finish:res';
317: }
318:
319: # ------------------------------------------------------------------- Store map
320:
321: sub storemap {
1.14 ! raeburn 322: my ($realfn,$useorig,$dotimeupdate) = @_;
1.1 albertel 323: my $fn=$realfn;
324: # unless this is forced to work from the original file, use a temporary file
325: # instead
1.14 ! raeburn 326: unless ($useorig) {
1.1 albertel 327: $fn=$realfn.'.tmp';
328: unless (-e $fn) {
329: copy($realfn,$fn);
330: }
331: }
332: # store data either into tmp or real file
333: &startfinish();
334: my $output='graphdef<:>no';
335: my $k=1;
336: for (my $i=0; $i<=$#order; $i++) {
337: if (defined($resources[$order[$i]])) {
338: $output.='<&>objcont<:>'.$order[$i].'<:>'.$resources[$order[$i]];
339: }
340: if (defined($resparms[$order[$i]])) {
341: foreach (split('&&&',$resparms[$order[$i]])) {
342: if ($_) {
343: $output.='<&>objparms<:>'.$order[$i].'<:>'.$_;
344: }
345: }
346: }
347: if (defined($order[$i+1])) {
348: if (defined($resources[$order[$i+1]])) {
349: $output.='<&>objlinks<:>'.$k.'<:>'.
350: $order[$i].':'.$order[$i+1].':0';
351: $k++;
352: }
353: }
354: }
355: for (my $i=0; $i<=$#zombies; $i++) {
356: if (defined($zombies[$i])) {
357: $output.='<&>objcont<:>'.$i.'<:>'.$zombies[$i];
358: }
359: }
1.13 raeburn 360: $output=~s/http\&colon\;\/\///g;
1.1 albertel 361: $env{'form.output'}=$output;
1.14 ! raeburn 362: return &loadmap($fn,&savemap($fn,'',$dotimeupdate));
1.1 albertel 363: }
364:
365: # ------------------------------------------ Store and get parameters in global
366:
367: sub storeparameter {
368: my ($to,$name,$value,$ptype)=@_;
369: my $newentry='';
370: my $nametype='';
371: foreach (split('&&&',$resparms[$to])) {
372: my ($thistype,$thisname,$thisvalue)=split('___',$_);
373: if ($thisname) {
374: unless ($thisname eq $name) {
375: $newentry.=$_.'&&&';
376: } else {
377: $nametype=$thistype;
378: }
379: }
380: }
381: unless ($ptype) { $ptype=$nametype; }
382: unless ($ptype) { $ptype='string'; }
383: $newentry.=$ptype.'___'.$name.'___'.$value;
384: $resparms[$to]=$newentry;
385: }
386:
387: sub delparameter {
388: my ($to,$name)=@_;
389: my $newentry='';
390: my $nametype='';
391: foreach (split('&&&',$resparms[$to])) {
392: my ($thistype,$thisname,$thisvalue)=split('___',$_);
393: if ($thisname) {
394: unless ($thisname eq $name) {
395: $newentry.=$_.'&&&';
396: }
397: }
398: }
399: $resparms[$to]=$newentry;
400: }
401:
402: sub getparameter {
403: my ($to,$name)=@_;
404: my $value=undef;
405: my $ptype=undef;
406: foreach (split('&&&',$resparms[$to])) {
407: my ($thistype,$thisname,$thisvalue)=split('___',$_);
408: if ($thisname eq $name) {
409: $value=$thisvalue;
410: $ptype=$thistype;
411: }
412: }
413: return ($value,$ptype);
414: }
415:
416: # ------------------------------------------------------------- From RAT to XML
417:
418: sub qtescape {
419: my $str=shift;
420: $str=~s/\:/\:/g;
421: $str=~s/\&\#58\;/\:/g;
422: $str=~s/\&\#39\;/\'/g;
423: $str=~s/\&\#44\;/\,/g;
1.6 albertel 424: $str=~s/\&\#34\;/\"/g;
1.1 albertel 425: return $str;
426: }
427:
428: # ------------------------------------------------------------- From XML to RAT
429:
430: sub qtunescape {
431: my $str=shift;
432: $str=~s/\:/\&colon\;/g;
433: $str=~s/\'/\&\#39\;/g;
434: $str=~s/\,/\&\#44\;/g;
435: $str=~s/\"/\&\#34\;/g;
436: return $str;
437: }
438:
439: # --------------------------------------------------------- Loads map from disk
440:
441: sub loadmap {
442: my ($fn,$errtext,$infotext)=@_;
443: if ($errtext) { return('',$errtext); }
444: my $outstr='';
445: my @obj=();
446: my @links=();
447: my $instr='';
448: if ($fn=~/^\/*uploaded\//) {
449: $instr=&Apache::lonnet::getfile($fn);
450: } elsif (-e $fn) {
451: my @content=();
452: {
453: open(my $fh,"<$fn");
454: @content=<$fh>;
455: }
456: $instr=join('',@content);
457: }
458: if ($instr eq -2) {
1.11 bisitz 459: $errtext.='Map not loaded: An error occurred while trying to load the map.';
1.2 raeburn 460: } elsif ($instr eq '-1') {
1.4 albertel 461: # Map doesn't exist
1.1 albertel 462: } elsif ($instr) {
463: my $parser = HTML::TokeParser->new(\$instr);
464: my $token;
465: my $graphmode=0;
466:
467: $fn=~/\.(\w+)$/;
468: $outstr="mode<:>$1";
469:
470: while ($token = $parser->get_token) {
471: if ($token->[0] eq 'S') {
472: if ($token->[1] eq 'map') {
473: $graphmode=($token->[2]->{'mode'} eq 'rat/graphical');
474: } elsif ($token->[1] eq 'resource') {
475: # -------------------------------------------------------------------- Resource
476: $outstr.='<&>objcont';
477: if (defined($token->[2]->{'id'})) {
478: $outstr.='<:>'.$token->[2]->{'id'};
479: if ($obj[$token->[2]->{'id'}]==1) {
480: $errtext.='Error: multiple use of ID '.
481: $token->[2]->{'id'}.'. ';
482: }
483: $obj[$token->[2]->{'id'}]=1;
484: } else {
485: my $i=1;
486: while (($i<=$#obj) && ($obj[$i]!=0)) { $i++; }
487: $outstr.='<:>'.$i;
488: $obj[$i]=1;
489: }
490: $outstr.='<:>';
491: $outstr.=qtunescape($token->[2]->{'title'}).":";
492: $outstr.=qtunescape($token->[2]->{'src'}).":";
493: if ($token->[2]->{'external'} eq 'true') {
494: $outstr.='true:';
495: } else {
496: $outstr.='false:';
497: }
498: if (defined($token->[2]->{'type'})) {
499: $outstr.=$token->[2]->{'type'}.':';
500: } else {
501: $outstr.='normal:';
502: }
503: if ($token->[2]->{'type'} ne 'zombie') {
504: $outstr.='res';
505: } else {
506: $outstr.='zombie';
507: }
508: } elsif ($token->[1] eq 'condition') {
509: # ------------------------------------------------------------------- Condition
510: $outstr.='<&>objcont';
511: if (defined($token->[2]->{'id'})) {
512: $outstr.='<:>'.$token->[2]->{'id'};
513: if ($obj[$token->[2]->{'id'}]==1) {
514: $errtext.='Error: multiple use of ID '.
515: $token->[2]->{'id'}.'. ';
516: }
517: $obj[$token->[2]->{'id'}]=1;
518: } else {
519: my $i=1;
520: while (($i<=$#obj) && ($obj[$i]!=0)) { $i++; }
521: $outstr.='<:>'.$i;
522: $obj[$i]=1;
523: }
524: $outstr.='<:>';
525: $outstr.=qtunescape($token->[2]->{'value'}).':';
526: if (defined($token->[2]->{'type'})) {
527: $outstr.=$token->[2]->{'type'}.':';
528: } else {
529: $outstr.='normal:';
530: }
531: $outstr.='cond';
532: } elsif ($token->[1] eq 'link') {
533: # ----------------------------------------------------------------------- Links
534: $outstr.='<&>objlinks';
535:
536: if (defined($token->[2]->{'index'})) {
537: if ($links[$token->[2]->{'index'}]) {
538: $errtext.='Error: multiple use of link index '.
539: $token->[2]->{'index'}.'. ';
540: }
541: $outstr.='<:>'.$token->[2]->{'index'};
542: $links[$token->[2]->{'index'}]=1;
543: } else {
544: my $i=1;
545: while (($i<=$#links) && ($links[$i]==1)) { $i++; }
546: $outstr.='<:>'.$i;
547: $links[$i]=1;
548: }
549:
550: $outstr.='<:>'.$token->[2]->{'from'}.
551: ':'.$token->[2]->{'to'};
552: if (defined($token->[2]->{'condition'})) {
553: $outstr.=':'.$token->[2]->{'condition'};
554: } else {
555: $outstr.=':0';
556: }
557: # ------------------------------------------------------------------- Parameter
558: } elsif ($token->[1] eq 'param') {
559: $outstr.='<&>objparms<:>'.$token->[2]->{'to'}.'<:>'.
560: $token->[2]->{'type'}.'___'.$token->[2]->{'name'}.
561: '___'.$token->[2]->{'value'};
562: } elsif ($graphmode) {
563: # --------------------------------------------- All other tags (graphical only)
564: $outstr.='<&>'.$token->[1];
565: if (defined($token->[2]->{'index'})) {
566: $outstr.='<:>'.$token->[2]->{'index'};
567: if ($token->[1] eq 'obj') {
568: $obj[$token->[2]->{'index'}]=2;
569: }
570: }
571: $outstr.='<:>'.$token->[2]->{'value'};
572: }
573: }
574: }
575:
576: } else {
577: $errtext.='Map not loaded: The file does not exist. ';
578: }
579: return($outstr,$errtext,$infotext);
580: }
581:
582:
583: # ----------------------------------------------------------- Saves map to disk
584:
585: sub savemap {
1.14 ! raeburn 586: my ($fn,$errtext,$dotimeupdate)=@_;
1.1 albertel 587: my $infotext='';
588: my %alltypes;
589: my %allvalues;
590: if (($fn=~/\.sequence(\.tmp)*$/) ||
591: ($fn=~/\.page(\.tmp)*$/)) {
592:
593: # ------------------------------------------------------------- Deal with input
594: my @tags=split(/<&>/,$env{'form.output'});
595: my $outstr='';
596: my $graphdef=0;
597: if ($tags[0] eq 'graphdef<:>yes') {
598: $outstr='<map mode="rat/graphical">'."\n";
599: $graphdef=1;
600: } else {
601: $outstr="<map>\n";
602: }
603: foreach (@tags) {
604: my @parts=split(/<:>/,$_);
605: if ($parts[0] eq 'objcont') {
606: my @comp=split(/:/,$parts[$#parts]);
607: # --------------------------------------------------------------- Logical input
608: if (($comp[$#comp] eq 'res') || ($comp[$#comp] eq 'zombie')) {
609: $comp[0]=qtescape($comp[0]);
1.6 albertel 610: $comp[0] = &HTML::Entities::encode($comp[0],'&<>"');
611:
1.1 albertel 612: $comp[1]=qtescape($comp[1]);
613: if ($comp[2] eq 'true') {
614: if ($comp[1]!~/^http\:\/\//) {
615: $comp[1]='http://'.$comp[1];
616: }
617: $comp[1].='" external="true';
618: } else {
1.13 raeburn 619: if ($comp[1]=~/^http\:\/\//) {
620: $comp[1]=~s/^http\:\/\/[^\/]*\//\//;
1.1 albertel 621: }
622: }
623: $outstr.='<resource id="'.$parts[1].'" src="'
624: .$comp[1].'"';
625:
626: if (($comp[3] ne '') && ($comp[3] ne 'normal')) {
627: $outstr.=' type="'.$comp[3].'"';
628: }
629: if ($comp[0] ne '') {
1.6 albertel 630: $outstr.=' title="'.$comp[0].'"';
1.1 albertel 631: }
632: $outstr.=" />\n";
633: } elsif ($comp[$#comp] eq 'cond') {
634: $outstr.='<condition id="'.$parts[1].'"';
635: if (($comp[1] ne '') && ($comp[1] ne 'normal')) {
636: $outstr.=' type="'.$comp[1].'"';
637: }
638: $outstr.=' value="'.qtescape($comp[0]).'"';
639: $outstr.=" />\n";
640: }
641: } elsif ($parts[0] eq 'objlinks') {
642: my @comp=split(/:/,$parts[$#parts]);
643: $outstr.='<link';
644: $outstr.=' from="'.$comp[0].'"';
645: $outstr.=' to="'.$comp[1].'"';
646: if (($comp[2] ne '') && ($comp[2]!=0)) {
647: $outstr.=' condition="'.$comp[2].'"';
648: }
649: $outstr.=' index="'.$parts[1].'"';
650: $outstr.=" />\n";
651: } elsif ($parts[0] eq 'objparms') {
652: undef %alltypes;
653: undef %allvalues;
654: foreach (split(/:/,$parts[$#parts])) {
655: my ($type,$name,$value)=split(/\_\_\_/,$_);
656: $alltypes{$name}=$type;
657: $allvalues{$name}=$value;
658: }
659: foreach (keys %allvalues) {
660: if ($allvalues{$_} ne '') {
661: $outstr.='<param to="'.$parts[1].'" type="'
662: .$alltypes{$_}.'" name="'.$_
663: .'" value="'.$allvalues{$_}.'" />'
664: ."\n";
665: }
666: }
667: } elsif (($parts[0] ne '') && ($graphdef)) {
668: # ------------------------------------------------------------- Graphical input
669: $outstr.='<'.$parts[0];
670: if ($#parts==2) {
671: $outstr.=' index="'.$parts[1].'"';
672: }
673: $outstr.=' value="'.qtescape($parts[$#parts]).'" />'."\n";
674: }
675: }
676: $outstr.="</map>\n";
1.3 albertel 677: if ($fn=~m{^/*uploaded/($LONCAPA::domain_re)/($LONCAPA::courseid_re)/(.*)$}) {
1.1 albertel 678: $env{'form.output'}=$outstr;
679: my $result=&Apache::lonnet::finishuserfileupload($2,$1,
680: 'output',$3);
681: if ($result != m|^/uploaded/|) {
1.11 bisitz 682: $errtext.='Map not saved: A network error occurred when trying to save the map. ';
1.1 albertel 683: }
684: } else {
685: if (open(my $fh,">$fn")) {
686: print $fh $outstr;
687: $infotext.="Map saved as $fn. ";
688: } else {
689: $errtext.='Could not write file '.$fn.'. Map not saved. ';
690: }
691: }
1.14 ! raeburn 692: if ($dotimeupdate) {
! 693: unless ($errtext) {
! 694: if ($env{'request.course.id'}) {
! 695: my $now = time;
! 696: &Apache::lonnet::put('environment',{'internal.contentchange' => $now},
! 697: $env{'course.'.$env{'request.course.id'}.'.domain'},
! 698: $env{'course.'.$env{'request.course.id'}.'.num'});
! 699: &Apache::lonnet::appenv(
! 700: {'course.'.$env{'request.course.id'}.'.internal.contentchange' => $now});
! 701: &Apache::lonnet::do_cache_new('crschange',$env{'request.course.id'},$now,600);
! 702: }
! 703: }
! 704: }
1.1 albertel 705: } else {
706: # -------------------------------------------- Cannot write to that file, error
707: $errtext.='Map not saved: The specified path does not exist. ';
708: }
709: return ($errtext,$infotext);
710: }
711:
712: 1;
713: __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