--- loncom/lonnet/perl/lonnet.pm 2002/10/01 07:09:05 1.287 +++ loncom/lonnet/perl/lonnet.pm 2002/10/07 13:50:36 1.292 @@ -1,7 +1,7 @@ # The LearningOnline Network # TCP networking package # -# $Id: lonnet.pm,v 1.287 2002/10/01 07:09:05 albertel Exp $ +# $Id: lonnet.pm,v 1.292 2002/10/07 13:50:36 www Exp $ # # Copyright Michigan State University Board of Trustees # @@ -644,6 +644,30 @@ sub chatsend { &escape($newentry)),$chome); } +# ------------------------------------------ Find current version of a resource + +sub getversion { + my $fname=&clutter(shift); + unless ($fname=~/^\/res\//) { return -1; } + return ¤tversion(&filelocation('',$fname)); +} + +sub currentversion { + my $fname=shift; + my $author=$fname; + $author=~s/\/home\/httpd\/html\/res\/([^\/]*)\/([^\/]*).*/$1\/$2/; + my ($udom,$uname)=split(/\//,$author); + my $home=homeserver($uname,$udom); + if ($home eq 'no_host') { + return -1; + } + my $answer=reply("currentversion:$fname",$home); + if (($answer eq 'con_lost') || ($answer eq 'rejected')) { + return -1; + } + return $answer; +} + # ----------------------------- Subscribe to a resource, return URL if possible sub subscribe { @@ -652,7 +676,7 @@ sub subscribe { $author=~s/\/home\/httpd\/html\/res\/([^\/]*)\/([^\/]*).*/$1\/$2/; my ($udom,$uname)=split(/\//,$author); my $home=homeserver($uname,$udom); - if (($home eq 'no_host') || ($home eq $perlvar{'lonHostID'})) { + if ($home eq 'no_host') { return 'not_found'; } my $answer=reply("sub:$fname",$home); @@ -683,6 +707,11 @@ sub repcopy { } elsif ($remoteurl eq 'directory') { return OK; } else { + my $author=$filename; + $author=~s/\/home\/httpd\/html\/res\/([^\/]*)\/([^\/]*).*/$1\/$2/; + my ($udom,$uname)=split(/\//,$author); + my $home=homeserver($uname,$udom); + unless ($home eq $perlvar{'lonHostID'}) { my @parts=split(/\//,$filename); my $path="/$parts[1]/$parts[2]/$parts[3]/$parts[4]"; if ($path ne "$perlvar{'lonDocRoot'}/res") { @@ -718,6 +747,7 @@ sub repcopy { rename($transname,$filename); return OK; } + } } } @@ -1986,14 +2016,15 @@ sub is_on_map { my @uriparts=split(/\//,$uri); my $filename=$uriparts[$#uriparts]; my $pathname=$uri; - $pathname=~s/\/$filename$//; + $pathname=~s|/\Q$filename\E$||; + #Trying to find the conditional for the file my $match=($ENV{'acc.res.'.$ENV{'request.course.id'}.'.'.$pathname}=~ - /\&$filename\:([\d\|]+)\&/); + /\&\Q$filename\E\:([\d\|]+)\&/); if ($match) { - return (1,$1); - } else { - return (0,0); - } + return (1,$1); + } else { + return (0,0); + } } # ----------------------------------------------------------------- Define Role @@ -2592,7 +2623,7 @@ sub courseresdata { return $courseresdatacache{$hashid}->{$item}; } } - return ''; + return undef; } # --------------------------------------------------------- Value of a Variable @@ -2763,9 +2794,9 @@ sub EXT { $filename=$ENV{'request.filename'}; } my $metadata=&metadata($filename,$spacequalifierrest); - if ($metadata) { return $metadata; } + if (defined($metadata)) { return $metadata; } $metadata=&metadata($filename,'parameter_'.$spacequalifierrest); - if ($metadata) { return $metadata; } + if (defined($metadata)) { return $metadata; } # ------------------------------------------------------------------ Cascade up unless ($space eq '0') { @@ -2773,11 +2804,11 @@ sub EXT { if ($id) { my $partgeneral=&EXT('resource.'.$part.'.'.$qualifierrest, $symbparm,$udom,$uname); - if ($partgeneral) { return $partgeneral; } + if (defined($partgeneral)) { return $partgeneral; } } else { my $resourcegeneral=&EXT('resource.0.'.$qualifierrest, $symbparm,$udom,$uname); - if ($resourcegeneral) { return $resourcegeneral; } + if (defined($resourcegeneral)) { return $resourcegeneral; } } } @@ -2806,6 +2837,11 @@ sub metadata { my ($uri,$what,$liburi,$prefix,$depthcount)=@_; $uri=&declutter($uri); + # if it is a non metadata possible uri return quickly + if (($uri eq '') || ($uri =~ m|^/*adm/|) || ($uri =~ m|/$|) || + ($uri =~ m|/.meta$|)) { + return ''; + } my $filename=$uri; $uri=~s/\.meta$//; #