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