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