version 1.683.2.6, 2006/01/07 00:28:34
|
version 1.692, 2006/01/10 16:06:07
|
Line 289 sub transfer_profile_to_env {
|
Line 289 sub transfer_profile_to_env {
|
|
|
sub appenv { |
sub appenv { |
my %newenv=@_; |
my %newenv=@_; |
foreach (keys %newenv) { |
foreach my $key (keys(%newenv)) { |
if (($newenv{$_}=~/^user\.role/) || ($newenv{$_}=~/^user\.priv/)) { |
if (($newenv{$key}=~/^user\.role/) || ($newenv{$key}=~/^user\.priv/)) { |
&logthis("<font color=\"blue\">WARNING: ". |
&logthis("<font color=\"blue\">WARNING: ". |
"Attempt to modify environment ".$_." to ".$newenv{$_} |
"Attempt to modify environment ".$key." to ".$newenv{$key} |
.'</font>'); |
.'</font>'); |
delete($newenv{$_}); |
delete($newenv{$key}); |
} else { |
} else { |
$env{$_}=$newenv{$_}; |
$env{$key}=$newenv{$key}; |
} |
} |
} |
} |
|
|
Line 380 sub delenv {
|
Line 380 sub delenv {
|
close($fh); |
close($fh); |
return 'error: '.$!; |
return 'error: '.$!; |
} |
} |
foreach (@oldenv) { |
foreach my $cur_key (@oldenv) { |
if ($_=~/^$delthis/) { |
if ($cur_key=~/^$delthis/) { |
my ($key,undef) = split('=',$_,2); |
my ($key,undef) = split('=',$cur_key,2); |
delete($env{$key}); |
delete($env{$key}); |
} else { |
} else { |
print $fh $_; |
print $fh $cur_key; |
} |
} |
} |
} |
close($fh); |
close($fh); |
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 3729 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 4824 sub EXT {
|
} elsif ($realm eq 'resource') { |
} elsif ($realm eq 'resource') { |
|
|
my $section; |
my $section; |
|
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 4832 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=&sort_course_groups($env{'request.course.groups'},$courseid); |
|
if (@groups > 0) { |
|
@groups = sort(@groups); |
|
} |
} 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=&sort_course_groups($grouplist,$courseid); |
|
} |
} |
} |
|
|
my $seclevel=$courseid.'.['.$section.'].'.$spacequalifierrest; |
my $seclevel=$courseid.'.['.$section.'].'.$spacequalifierrest; |
Line 4853 sub EXT {
|
Line 4873 sub EXT {
|
my $userreply=&resdata($uname,$udom,'user', |
my $userreply=&resdata($uname,$udom,'user', |
($courselevelr,$courselevelm, |
($courselevelr,$courselevelm, |
$courselevel)); |
$courselevel)); |
|
|
if (defined($userreply)) { return $userreply; } |
if (defined($userreply)) { return $userreply; } |
|
|
# ------------------------------------------------ second, check some of course |
# ------------------------------------------------ second, check some of course |
|
my $coursereply; |
|
if (@groups > 0) { |
|
$coursereply = &check_group_parms($courseid,\@groups,$symbparm, |
|
$mapparm,$spacequalifierrest); |
|
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 4933 sub EXT {
|
Line 4958 sub EXT {
|
return ''; |
return ''; |
} |
} |
|
|
|
sub check_group_parms { |
|
my ($courseid,$groups,$symbparm,$mapparm,$what) = @_; |
|
my @groupitems = (); |
|
my $resultitem; |
|
my @levels = ($symbparm,$mapparm,$what); |
|
foreach my $group (@{$groups}) { |
|
foreach my $level (@levels) { |
|
my $item = $courseid.'.['.$group.'].'.$level; |
|
push(@groupitems,$item); |
|
} |
|
} |
|
my $coursereply = &resdata($env{'course.'.$courseid.'.num'}, |
|
$env{'course.'.$courseid.'.domain'}, |
|
'course',@groupitems); |
|
return $coursereply; |
|
} |
|
|
|
sub sort_course_groups { # Sort groups based on defined rankings. Default is sort(). |
|
my ($grouplist,$courseid) = @_; |
|
my @groups = split/:/,$grouplist; |
|
if (@groups > 1) { |
|
@groups = sort(@groups); |
|
} |
|
return @groups; |
|
} |
|
|
sub packages_tab_default { |
sub packages_tab_default { |
my ($uri,$varname)=@_; |
my ($uri,$varname)=@_; |
my (undef,$part,$name)=split(/\./,$varname); |
my (undef,$part,$name)=split(/\./,$varname); |
Line 6234 BEGIN {
|
Line 6285 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 { |