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