version 1.683.2.12, 2006/01/13 19:22:29
|
version 1.690, 2006/01/07 00:25:23
|
Line 1280 sub clean_filename {
|
Line 1280 sub clean_filename {
|
} |
} |
|
|
# --------------- Take an uploaded file and put it into the userfiles directory |
# --------------- Take an uploaded file and put it into the userfiles directory |
# input: name of form element, coursedoc=1 means this is for the course |
# input: $formname - the contents of the file are in $env{"form.$formname"} |
# output: url of file in userspace |
# the desired filenam is in $env{"form.$formname"} |
|
# $coursedoc - if true up to the current course |
|
# if false |
|
# $subdir - directory in userfile to store the file into |
|
# $parser, $allfiles, $codebase - unknown |
|
# |
|
# output: url of file in userspace, or error: <message> |
|
# or /adm/notfound.html if failure to upload occurse |
|
|
|
|
sub userfileupload { |
sub userfileupload { |
Line 3405 sub is_on_map {
|
Line 3412 sub is_on_map {
|
my $filename=$uriparts[$#uriparts]; |
my $filename=$uriparts[$#uriparts]; |
my $pathname=$uri; |
my $pathname=$uri; |
$pathname=~s|/\Q$filename\E$||; |
$pathname=~s|/\Q$filename\E$||; |
$pathname=~s/^adm\/wrapper\///; |
$pathname=~s/^adm\/wrapper\///; |
$pathname=~s/^adm\/coursedocs\/showdoc\///; |
|
#Trying to find the conditional for the file |
#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}=~ |
/\&\Q$filename\E\:([\d\|]+)\&/); |
/\&\Q$filename\E\:([\d\|]+)\&/); |
Line 3730 sub modify_group_roles {
|
Line 3736 sub modify_group_roles {
|
my $role = 'gr/'.&escape($userprivs); |
my $role = 'gr/'.&escape($userprivs); |
my ($uname,$udom) = split(/:/,$user); |
my ($uname,$udom) = split(/:/,$user); |
my $result = &assignrole($udom,$uname,$url,$role,$end,$start); |
my $result = &assignrole($udom,$uname,$url,$role,$end,$start); |
|
if ($result eq 'ok') { |
|
&devalidate_getgroups_cache($udom,$uname,$cdom,$cnum); |
|
} |
|
|
return $result; |
return $result; |
} |
} |
|
|
Line 4813 sub EXT {
|
Line 4823 sub EXT {
|
return $env{'course.'.$courseid.'.'.$spacequalifierrest}; |
return $env{'course.'.$courseid.'.'.$spacequalifierrest}; |
} elsif ($realm eq 'resource') { |
} elsif ($realm eq 'resource') { |
|
|
my $section; |
my ($section,$group); |
|
my @groups = (); |
if (defined($courseid) && $courseid eq $env{'request.course.id'}) { |
if (defined($courseid) && $courseid eq $env{'request.course.id'}) { |
if (!$symbparm) { $symbparm=&symbread(); } |
if (!$symbparm) { $symbparm=&symbread(); } |
} |
} |
Line 4833 sub EXT {
|
Line 4844 sub EXT {
|
if (($env{'user.name'} eq $uname) && |
if (($env{'user.name'} eq $uname) && |
($env{'user.domain'} eq $udom)) { |
($env{'user.domain'} eq $udom)) { |
$section=$env{'request.course.sec'}; |
$section=$env{'request.course.sec'}; |
|
@groups=split(/:/,$env{'request.course.groups'}); |
|
if (@groups > 0) { |
|
@groups = sort(@groups); |
|
$group = $groups[0]; |
|
} |
} else { |
} else { |
if (! defined($usection)) { |
if (! defined($usection)) { |
$section=&getsection($udom,$uname,$courseid); |
$section=&getsection($udom,$uname,$courseid); |
} else { |
} else { |
$section = $usection; |
$section = $usection; |
} |
} |
|
my $grouplist = &get_users_groups($udom,$uname,$courseid); |
|
if ($grouplist) { |
|
@groups = split(/:/,$grouplist); |
|
@groups = sort(@groups); |
|
$group = $groups[0]; |
|
} |
} |
} |
|
|
|
my $grplevel=$courseid.'.['.$group.'].'.$spacequalifierrest; |
|
my $grplevelr=$courseid.'.['.$group.'].'.$symbparm; |
|
my $grplevelm=$courseid.'.['.$group.'].'.$mapparm; |
|
|
my $seclevel=$courseid.'.['.$section.'].'.$spacequalifierrest; |
my $seclevel=$courseid.'.['.$section.'].'.$spacequalifierrest; |
my $seclevelr=$courseid.'.['.$section.'].'.$symbparm; |
my $seclevelr=$courseid.'.['.$section.'].'.$symbparm; |
my $seclevelm=$courseid.'.['.$section.'].'.$mapparm; |
my $seclevelm=$courseid.'.['.$section.'].'.$mapparm; |
Line 4858 sub EXT {
|
Line 4884 sub EXT {
|
if (defined($userreply)) { return $userreply; } |
if (defined($userreply)) { return $userreply; } |
|
|
# ------------------------------------------------ second, check some of course |
# ------------------------------------------------ second, check some of course |
|
my $coursereply; |
|
if (defined($group)) { |
|
$coursereply = &resdata($env{'course.'.$courseid.'.num'}, |
|
$env{'course.'.$courseid.'.domain'}, |
|
'course', |
|
($grplevelr,$grplevelm,$grplevel, |
|
$courselevelr)); |
|
if (defined($coursereply)) { return $coursereply; } |
|
} |
|
|
my $coursereply=&resdata($env{'course.'.$courseid.'.num'}, |
$coursereply=&resdata($env{'course.'.$courseid.'.num'}, |
$env{'course.'.$courseid.'.domain'}, |
$env{'course.'.$courseid.'.domain'}, |
'course', |
'course', |
($seclevelr,$seclevelm,$seclevel, |
($seclevelr,$seclevelm,$seclevel, |
Line 4930 sub EXT {
|
Line 4965 sub EXT {
|
if ($space eq 'time') { |
if ($space eq 'time') { |
return time; |
return time; |
} |
} |
} elsif ($realm eq 'server') { |
|
# ----------------------------------------------------------------- system.time |
|
if ($space eq 'name') { |
|
return $ENV{'SERVER_NAME'}; |
|
} |
|
} |
} |
return ''; |
return ''; |
} |
} |
Line 5166 sub metadata {
|
Line 5196 sub metadata {
|
$metaentry{':keys'}=join(',',keys %metathesekeys); |
$metaentry{':keys'}=join(',',keys %metathesekeys); |
&metadata_generate_part0(\%metathesekeys,\%metaentry,$uri); |
&metadata_generate_part0(\%metathesekeys,\%metaentry,$uri); |
$metaentry{':allpossiblekeys'}=join(',',keys %metathesekeys); |
$metaentry{':allpossiblekeys'}=join(',',keys %metathesekeys); |
&do_cache_new('meta',$uri,\%metaentry,60*60); |
&do_cache_new('meta',$uri,\%metaentry,60*60*24); |
# this is the end of "was not already recently cached |
# this is the end of "was not already recently cached |
} |
} |
return $metaentry{':'.$what}; |
return $metaentry{':'.$what}; |
Line 5299 sub symbverify {
|
Line 5329 sub symbverify {
|
my $thisfn=$thisurl; |
my $thisfn=$thisurl; |
# wrapper not part of symbs |
# wrapper not part of symbs |
$thisfn=~s/^\/adm\/wrapper//; |
$thisfn=~s/^\/adm\/wrapper//; |
$thisfn=~s/^\/adm\/coursedocs\/showdoc\///; |
|
$thisfn=&declutter($thisfn); |
$thisfn=&declutter($thisfn); |
# direct jump to resource in page or to a sequence - will construct own symbs |
# direct jump to resource in page or to a sequence - will construct own symbs |
if ($thisfn=~/\.(page|sequence)$/) { return 1; } |
if ($thisfn=~/\.(page|sequence)$/) { return 1; } |
Line 5354 sub symbclean {
|
Line 5383 sub symbclean {
|
# remove wrapper |
# remove wrapper |
|
|
$symb=~s/(\_\_\_\d+\_\_\_)adm\/wrapper\/(res\/)*/$1/; |
$symb=~s/(\_\_\_\d+\_\_\_)adm\/wrapper\/(res\/)*/$1/; |
$symb=~s/(\_\_\_\d+\_\_\_)adm\/coursedocs\/showdoc\/(res\/)*/$1/; |
|
return $symb; |
return $symb; |
} |
} |
|
|
Line 6005 sub filelocation {
|
Line 6033 sub filelocation {
|
my ($dir,$file) = @_; |
my ($dir,$file) = @_; |
my $location; |
my $location; |
$file=~ s/^\s*(\S+)\s*$/$1/; ## strip off leading and trailing spaces |
$file=~ s/^\s*(\S+)\s*$/$1/; ## strip off leading and trailing spaces |
|
|
if ($file =~ m-^/adm/-) { |
|
$file=~s-^/adm/wrapper/-/-; |
|
$file=~s-^/adm/coursedocs/showdoc/-/-; |
|
} |
|
if ($file=~m:^/~:) { # is a contruction space reference |
if ($file=~m:^/~:) { # is a contruction space reference |
$location = $file; |
$location = $file; |
$location =~ s:/~(.*?)/(.*):/home/$1/public_html/$2:; |
$location =~ s:/~(.*?)/(.*):/home/$1/public_html/$2:; |
Line 6049 sub hreflocation {
|
Line 6072 sub hreflocation {
|
my ($dir,$file)=@_; |
my ($dir,$file)=@_; |
unless (($file=~m-^http://-i) || ($file=~m-^/-)) { |
unless (($file=~m-^http://-i) || ($file=~m-^/-)) { |
$file=filelocation($dir,$file); |
$file=filelocation($dir,$file); |
} elsif ($file=~m-^/adm/-) { |
|
$file=~s-^/adm/wrapper/-/-; |
|
$file=~s-^/adm/coursedocs/showdoc/-/-; |
|
} |
} |
if ($file=~m-^\Q$perlvar{'lonDocRoot'}\E-) { |
if ($file=~m-^\Q$perlvar{'lonDocRoot'}\E-) { |
$file=~s-^\Q$perlvar{'lonDocRoot'}\E--; |
$file=~s-^\Q$perlvar{'lonDocRoot'}\E--; |
Line 6095 sub declutter {
|
Line 6115 sub declutter {
|
if ($thisfn=~m|^/enc/|) { $thisfn=&Apache::lonenc::unencrypted($thisfn); } |
if ($thisfn=~m|^/enc/|) { $thisfn=&Apache::lonenc::unencrypted($thisfn); } |
$thisfn=~s/^\Q$perlvar{'lonDocRoot'}\E//; |
$thisfn=~s/^\Q$perlvar{'lonDocRoot'}\E//; |
$thisfn=~s/^\///; |
$thisfn=~s/^\///; |
$thisfn=~s|^adm/wrapper/||; |
|
$thisfn=~s|^adm/coursedocs/showdoc/||; |
|
$thisfn=~s/^res\///; |
$thisfn=~s/^res\///; |
$thisfn=~s/\?.+$//; |
$thisfn=~s/\?.+$//; |
return $thisfn; |
return $thisfn; |
Line 6109 sub clutter {
|
Line 6127 sub clutter {
|
unless ($thisfn=~/^\/(uploaded|editupload|adm|userfiles|ext|raw|priv|public)\//) { |
unless ($thisfn=~/^\/(uploaded|editupload|adm|userfiles|ext|raw|priv|public)\//) { |
$thisfn='/res'.$thisfn; |
$thisfn='/res'.$thisfn; |
} |
} |
if ($thisfn !~m|/adm|) { |
|
if ($thisfn =~ m|/ext/|) { |
|
$thisfn='/adm/wrapper'.$thisfn; |
|
} else { |
|
my ($ext) = ($thisfn =~ /\.(\w+)$/); |
|
my $embstyle=&Apache::loncommon::fileembstyle($ext); |
|
if ($embstyle eq 'ssi' |
|
|| ($embstyle eq 'hdn') |
|
|| ($embstyle eq 'rat') |
|
|| ($embstyle eq 'prv') |
|
|| ($embstyle eq 'ign')) { |
|
#do nothing with these |
|
} elsif (($embstyle eq 'img') |
|
|| ($embstyle eq 'emb') |
|
|| ($embstyle eq 'wrp')) { |
|
$thisfn='/adm/wrapper'.$thisfn; |
|
} elsif ($embstyle eq 'unk' |
|
&& $thisfn!~/\.(sequence|page)$/) { |
|
$thisfn='/adm/coursedocs/showdoc'.$thisfn; |
|
} else { |
|
#&logthis("Got a blank emb style"); |
|
} |
|
} |
|
} |
|
return $thisfn; |
return $thisfn; |
} |
} |
|
|
Line 6276 BEGIN {
|
Line 6270 BEGIN {
|
} |
} |
close($config); |
close($config); |
# FIXME: dev server don't want this, production servers _do_ want this |
# FIXME: dev server don't want this, production servers _do_ want this |
&get_iphost(); |
#&get_iphost(); |
} |
} |
|
|
sub get_iphost { |
sub get_iphost { |