![]() ![]() | ![]() |
- lots of \w -> probper regexp replacements
1: # The LearningOnline Network with CAPA 2: # routines for modyfing .sequence and .page files 3: # 4: # $Id: map.pm,v 1.3 2006/12/05 02:55:55 albertel Exp $ 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.'; 478: } elsif ($instr eq '-1') { 479: $errtext.=&mt('Map not loaded: The file [_1] does not exist.',$fn); 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"; 693: if ($fn=~m{^/*uploaded/($LONCAPA::domain_re)/($LONCAPA::courseid_re)/(.*)$}) { 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__