version 1.287, 2002/10/01 07:09:05
|
version 1.292, 2002/10/07 13:50:36
|
Line 644 sub chatsend {
|
Line 644 sub chatsend {
|
&escape($newentry)),$chome); |
&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 |
# ----------------------------- Subscribe to a resource, return URL if possible |
|
|
sub subscribe { |
sub subscribe { |
Line 652 sub subscribe {
|
Line 676 sub subscribe {
|
$author=~s/\/home\/httpd\/html\/res\/([^\/]*)\/([^\/]*).*/$1\/$2/; |
$author=~s/\/home\/httpd\/html\/res\/([^\/]*)\/([^\/]*).*/$1\/$2/; |
my ($udom,$uname)=split(/\//,$author); |
my ($udom,$uname)=split(/\//,$author); |
my $home=homeserver($uname,$udom); |
my $home=homeserver($uname,$udom); |
if (($home eq 'no_host') || ($home eq $perlvar{'lonHostID'})) { |
if ($home eq 'no_host') { |
return 'not_found'; |
return 'not_found'; |
} |
} |
my $answer=reply("sub:$fname",$home); |
my $answer=reply("sub:$fname",$home); |
Line 683 sub repcopy {
|
Line 707 sub repcopy {
|
} elsif ($remoteurl eq 'directory') { |
} elsif ($remoteurl eq 'directory') { |
return OK; |
return OK; |
} else { |
} 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 @parts=split(/\//,$filename); |
my $path="/$parts[1]/$parts[2]/$parts[3]/$parts[4]"; |
my $path="/$parts[1]/$parts[2]/$parts[3]/$parts[4]"; |
if ($path ne "$perlvar{'lonDocRoot'}/res") { |
if ($path ne "$perlvar{'lonDocRoot'}/res") { |
Line 718 sub repcopy {
|
Line 747 sub repcopy {
|
rename($transname,$filename); |
rename($transname,$filename); |
return OK; |
return OK; |
} |
} |
|
} |
} |
} |
} |
} |
|
|
Line 1986 sub is_on_map {
|
Line 2016 sub is_on_map {
|
my @uriparts=split(/\//,$uri); |
my @uriparts=split(/\//,$uri); |
my $filename=$uriparts[$#uriparts]; |
my $filename=$uriparts[$#uriparts]; |
my $pathname=$uri; |
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}=~ |
my $match=($ENV{'acc.res.'.$ENV{'request.course.id'}.'.'.$pathname}=~ |
/\&$filename\:([\d\|]+)\&/); |
/\&\Q$filename\E\:([\d\|]+)\&/); |
if ($match) { |
if ($match) { |
return (1,$1); |
return (1,$1); |
} else { |
} else { |
return (0,0); |
return (0,0); |
} |
} |
} |
} |
|
|
# ----------------------------------------------------------------- Define Role |
# ----------------------------------------------------------------- Define Role |
Line 2592 sub courseresdata {
|
Line 2623 sub courseresdata {
|
return $courseresdatacache{$hashid}->{$item}; |
return $courseresdatacache{$hashid}->{$item}; |
} |
} |
} |
} |
return ''; |
return undef; |
} |
} |
|
|
# --------------------------------------------------------- Value of a Variable |
# --------------------------------------------------------- Value of a Variable |
Line 2763 sub EXT {
|
Line 2794 sub EXT {
|
$filename=$ENV{'request.filename'}; |
$filename=$ENV{'request.filename'}; |
} |
} |
my $metadata=&metadata($filename,$spacequalifierrest); |
my $metadata=&metadata($filename,$spacequalifierrest); |
if ($metadata) { return $metadata; } |
if (defined($metadata)) { return $metadata; } |
$metadata=&metadata($filename,'parameter_'.$spacequalifierrest); |
$metadata=&metadata($filename,'parameter_'.$spacequalifierrest); |
if ($metadata) { return $metadata; } |
if (defined($metadata)) { return $metadata; } |
|
|
# ------------------------------------------------------------------ Cascade up |
# ------------------------------------------------------------------ Cascade up |
unless ($space eq '0') { |
unless ($space eq '0') { |
Line 2773 sub EXT {
|
Line 2804 sub EXT {
|
if ($id) { |
if ($id) { |
my $partgeneral=&EXT('resource.'.$part.'.'.$qualifierrest, |
my $partgeneral=&EXT('resource.'.$part.'.'.$qualifierrest, |
$symbparm,$udom,$uname); |
$symbparm,$udom,$uname); |
if ($partgeneral) { return $partgeneral; } |
if (defined($partgeneral)) { return $partgeneral; } |
} else { |
} else { |
my $resourcegeneral=&EXT('resource.0.'.$qualifierrest, |
my $resourcegeneral=&EXT('resource.0.'.$qualifierrest, |
$symbparm,$udom,$uname); |
$symbparm,$udom,$uname); |
if ($resourcegeneral) { return $resourcegeneral; } |
if (defined($resourcegeneral)) { return $resourcegeneral; } |
} |
} |
} |
} |
|
|
Line 2806 sub metadata {
|
Line 2837 sub metadata {
|
my ($uri,$what,$liburi,$prefix,$depthcount)=@_; |
my ($uri,$what,$liburi,$prefix,$depthcount)=@_; |
|
|
$uri=&declutter($uri); |
$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; |
my $filename=$uri; |
$uri=~s/\.meta$//; |
$uri=~s/\.meta$//; |
# |
# |