Annotation of rat/map.pm, revision 1.1
1.1 ! albertel 1: # The LearningOnline Network with CAPA
! 2: # routines for modyfing .sequence and .page files
! 3: #
! 4: # $Id: loncommon.pm,v 1.444 2006/08/11 22:00:07 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) {
! 479: my $parser = HTML::TokeParser->new(\$instr);
! 480: my $token;
! 481: my $graphmode=0;
! 482:
! 483: $fn=~/\.(\w+)$/;
! 484: $outstr="mode<:>$1";
! 485:
! 486: while ($token = $parser->get_token) {
! 487: if ($token->[0] eq 'S') {
! 488: if ($token->[1] eq 'map') {
! 489: $graphmode=($token->[2]->{'mode'} eq 'rat/graphical');
! 490: } elsif ($token->[1] eq 'resource') {
! 491: # -------------------------------------------------------------------- Resource
! 492: $outstr.='<&>objcont';
! 493: if (defined($token->[2]->{'id'})) {
! 494: $outstr.='<:>'.$token->[2]->{'id'};
! 495: if ($obj[$token->[2]->{'id'}]==1) {
! 496: $errtext.='Error: multiple use of ID '.
! 497: $token->[2]->{'id'}.'. ';
! 498: }
! 499: $obj[$token->[2]->{'id'}]=1;
! 500: } else {
! 501: my $i=1;
! 502: while (($i<=$#obj) && ($obj[$i]!=0)) { $i++; }
! 503: $outstr.='<:>'.$i;
! 504: $obj[$i]=1;
! 505: }
! 506: $outstr.='<:>';
! 507: $outstr.=qtunescape($token->[2]->{'title'}).":";
! 508: $outstr.=qtunescape($token->[2]->{'src'}).":";
! 509: if ($token->[2]->{'external'} eq 'true') {
! 510: $outstr.='true:';
! 511: } else {
! 512: $outstr.='false:';
! 513: }
! 514: if (defined($token->[2]->{'type'})) {
! 515: $outstr.=$token->[2]->{'type'}.':';
! 516: } else {
! 517: $outstr.='normal:';
! 518: }
! 519: if ($token->[2]->{'type'} ne 'zombie') {
! 520: $outstr.='res';
! 521: } else {
! 522: $outstr.='zombie';
! 523: }
! 524: } elsif ($token->[1] eq 'condition') {
! 525: # ------------------------------------------------------------------- Condition
! 526: $outstr.='<&>objcont';
! 527: if (defined($token->[2]->{'id'})) {
! 528: $outstr.='<:>'.$token->[2]->{'id'};
! 529: if ($obj[$token->[2]->{'id'}]==1) {
! 530: $errtext.='Error: multiple use of ID '.
! 531: $token->[2]->{'id'}.'. ';
! 532: }
! 533: $obj[$token->[2]->{'id'}]=1;
! 534: } else {
! 535: my $i=1;
! 536: while (($i<=$#obj) && ($obj[$i]!=0)) { $i++; }
! 537: $outstr.='<:>'.$i;
! 538: $obj[$i]=1;
! 539: }
! 540: $outstr.='<:>';
! 541: $outstr.=qtunescape($token->[2]->{'value'}).':';
! 542: if (defined($token->[2]->{'type'})) {
! 543: $outstr.=$token->[2]->{'type'}.':';
! 544: } else {
! 545: $outstr.='normal:';
! 546: }
! 547: $outstr.='cond';
! 548: } elsif ($token->[1] eq 'link') {
! 549: # ----------------------------------------------------------------------- Links
! 550: $outstr.='<&>objlinks';
! 551:
! 552: if (defined($token->[2]->{'index'})) {
! 553: if ($links[$token->[2]->{'index'}]) {
! 554: $errtext.='Error: multiple use of link index '.
! 555: $token->[2]->{'index'}.'. ';
! 556: }
! 557: $outstr.='<:>'.$token->[2]->{'index'};
! 558: $links[$token->[2]->{'index'}]=1;
! 559: } else {
! 560: my $i=1;
! 561: while (($i<=$#links) && ($links[$i]==1)) { $i++; }
! 562: $outstr.='<:>'.$i;
! 563: $links[$i]=1;
! 564: }
! 565:
! 566: $outstr.='<:>'.$token->[2]->{'from'}.
! 567: ':'.$token->[2]->{'to'};
! 568: if (defined($token->[2]->{'condition'})) {
! 569: $outstr.=':'.$token->[2]->{'condition'};
! 570: } else {
! 571: $outstr.=':0';
! 572: }
! 573: # ------------------------------------------------------------------- Parameter
! 574: } elsif ($token->[1] eq 'param') {
! 575: $outstr.='<&>objparms<:>'.$token->[2]->{'to'}.'<:>'.
! 576: $token->[2]->{'type'}.'___'.$token->[2]->{'name'}.
! 577: '___'.$token->[2]->{'value'};
! 578: } elsif ($graphmode) {
! 579: # --------------------------------------------- All other tags (graphical only)
! 580: $outstr.='<&>'.$token->[1];
! 581: if (defined($token->[2]->{'index'})) {
! 582: $outstr.='<:>'.$token->[2]->{'index'};
! 583: if ($token->[1] eq 'obj') {
! 584: $obj[$token->[2]->{'index'}]=2;
! 585: }
! 586: }
! 587: $outstr.='<:>'.$token->[2]->{'value'};
! 588: }
! 589: }
! 590: }
! 591:
! 592: } else {
! 593: $errtext.='Map not loaded: The file does not exist. ';
! 594: }
! 595: return($outstr,$errtext,$infotext);
! 596: }
! 597:
! 598:
! 599: # ----------------------------------------------------------- Saves map to disk
! 600:
! 601: sub savemap {
! 602: my ($fn,$errtext)=@_;
! 603: my $infotext='';
! 604: my %alltypes;
! 605: my %allvalues;
! 606: if (($fn=~/\.sequence(\.tmp)*$/) ||
! 607: ($fn=~/\.page(\.tmp)*$/)) {
! 608:
! 609: # ------------------------------------------------------------- Deal with input
! 610: my @tags=split(/<&>/,$env{'form.output'});
! 611: my $outstr='';
! 612: my $graphdef=0;
! 613: if ($tags[0] eq 'graphdef<:>yes') {
! 614: $outstr='<map mode="rat/graphical">'."\n";
! 615: $graphdef=1;
! 616: } else {
! 617: $outstr="<map>\n";
! 618: }
! 619: foreach (@tags) {
! 620: my @parts=split(/<:>/,$_);
! 621: if ($parts[0] eq 'objcont') {
! 622: my @comp=split(/:/,$parts[$#parts]);
! 623: # --------------------------------------------------------------- Logical input
! 624: if (($comp[$#comp] eq 'res') || ($comp[$#comp] eq 'zombie')) {
! 625: $comp[0]=qtescape($comp[0]);
! 626: $comp[1]=qtescape($comp[1]);
! 627: if ($comp[2] eq 'true') {
! 628: if ($comp[1]!~/^http\:\/\//) {
! 629: $comp[1]='http://'.$comp[1];
! 630: }
! 631: $comp[1].='" external="true';
! 632: } else {
! 633: if ($comp[1]=~/^http\:\/\//) {
! 634: $comp[1]=~s/^http\:\/\/[^\/]*\//\//;
! 635: }
! 636: }
! 637: $outstr.='<resource id="'.$parts[1].'" src="'
! 638: .$comp[1].'"';
! 639:
! 640: if (($comp[3] ne '') && ($comp[3] ne 'normal')) {
! 641: $outstr.=' type="'.$comp[3].'"';
! 642: }
! 643: if ($comp[0] ne '') {
! 644: $outstr.=' title="'.$comp[0].'"';
! 645: }
! 646: $outstr.=" />\n";
! 647: } elsif ($comp[$#comp] eq 'cond') {
! 648: $outstr.='<condition id="'.$parts[1].'"';
! 649: if (($comp[1] ne '') && ($comp[1] ne 'normal')) {
! 650: $outstr.=' type="'.$comp[1].'"';
! 651: }
! 652: $outstr.=' value="'.qtescape($comp[0]).'"';
! 653: $outstr.=" />\n";
! 654: }
! 655: } elsif ($parts[0] eq 'objlinks') {
! 656: my @comp=split(/:/,$parts[$#parts]);
! 657: $outstr.='<link';
! 658: $outstr.=' from="'.$comp[0].'"';
! 659: $outstr.=' to="'.$comp[1].'"';
! 660: if (($comp[2] ne '') && ($comp[2]!=0)) {
! 661: $outstr.=' condition="'.$comp[2].'"';
! 662: }
! 663: $outstr.=' index="'.$parts[1].'"';
! 664: $outstr.=" />\n";
! 665: } elsif ($parts[0] eq 'objparms') {
! 666: undef %alltypes;
! 667: undef %allvalues;
! 668: foreach (split(/:/,$parts[$#parts])) {
! 669: my ($type,$name,$value)=split(/\_\_\_/,$_);
! 670: $alltypes{$name}=$type;
! 671: $allvalues{$name}=$value;
! 672: }
! 673: foreach (keys %allvalues) {
! 674: if ($allvalues{$_} ne '') {
! 675: $outstr.='<param to="'.$parts[1].'" type="'
! 676: .$alltypes{$_}.'" name="'.$_
! 677: .'" value="'.$allvalues{$_}.'" />'
! 678: ."\n";
! 679: }
! 680: }
! 681: } elsif (($parts[0] ne '') && ($graphdef)) {
! 682: # ------------------------------------------------------------- Graphical input
! 683: $outstr.='<'.$parts[0];
! 684: if ($#parts==2) {
! 685: $outstr.=' index="'.$parts[1].'"';
! 686: }
! 687: $outstr.=' value="'.qtescape($parts[$#parts]).'" />'."\n";
! 688: }
! 689: }
! 690: $outstr.="</map>\n";
! 691: if ($fn=~/^\/*uploaded\/(\w+)\/(\w+)\/(.*)$/) {
! 692: $env{'form.output'}=$outstr;
! 693: my $result=&Apache::lonnet::finishuserfileupload($2,$1,
! 694: 'output',$3);
! 695: if ($result != m|^/uploaded/|) {
! 696: $errtext.='Map not saved: A network error occured when trying to save the map. ';
! 697: }
! 698: } else {
! 699: if (open(my $fh,">$fn")) {
! 700: print $fh $outstr;
! 701: $infotext.="Map saved as $fn. ";
! 702: } else {
! 703: $errtext.='Could not write file '.$fn.'. Map not saved. ';
! 704: }
! 705: }
! 706: } else {
! 707: # -------------------------------------------- Cannot write to that file, error
! 708: $errtext.='Map not saved: The specified path does not exist. ';
! 709: }
! 710: return ($errtext,$infotext);
! 711: }
! 712:
! 713: 1;
! 714: __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