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