version 1.753, 2006/06/22 13:16:09
|
version 1.759, 2006/06/30 00:26:49
|
Line 281 sub critical {
|
Line 281 sub critical {
|
return $answer; |
return $answer; |
} |
} |
|
|
|
# ------------------------------------------- check if return value is an error |
|
|
|
sub error { |
|
my ($result) = @_; |
|
if ($result =~ /^(con_lost|no_such_host|error: (\d+) (.*))/) { |
|
if ($2 == 2) { return undef; } |
|
return $1; |
|
} |
|
return undef; |
|
} |
|
|
# ------------------------------------------- Transfer profile into environment |
# ------------------------------------------- Transfer profile into environment |
|
|
sub transfer_profile_to_env { |
sub transfer_profile_to_env { |
Line 1874 sub get_course_adv_roles {
|
Line 1885 sub get_course_adv_roles {
|
(!$nothide{$username.':'.$domain})) { next; } |
(!$nothide{$username.':'.$domain})) { next; } |
if ($role eq 'cr') { next; } |
if ($role eq 'cr') { next; } |
my $key=&plaintext($role); |
my $key=&plaintext($role); |
if ($role =~ /^cr/) { |
|
$key=(split('/',$role))[3]; |
|
} |
|
if ($section) { $key.=' (Sec/Grp '.$section.')'; } |
if ($section) { $key.=' (Sec/Grp '.$section.')'; } |
if ($returnhash{$key}) { |
if ($returnhash{$key}) { |
$returnhash{$key}.=','.$username.':'.$domain; |
$returnhash{$key}.=','.$username.':'.$domain; |
Line 2922 sub del {
|
Line 2930 sub del {
|
# -------------------------------------------------------------- dump interface |
# -------------------------------------------------------------- dump interface |
|
|
sub dump { |
sub dump { |
my ($namespace,$udomain,$uname,$regexp,$range)=@_; |
my ($namespace,$udomain,$uname,$regexp,$range)=@_; |
if (!$udomain) { $udomain=$env{'user.domain'}; } |
if (!$udomain) { $udomain=$env{'user.domain'}; } |
if (!$uname) { $uname=$env{'user.name'}; } |
if (!$uname) { $uname=$env{'user.name'}; } |
my $uhome=&homeserver($uname,$udomain); |
my $uhome=&homeserver($uname,$udomain); |
if ($regexp) { |
if ($regexp) { |
$regexp=&escape($regexp); |
$regexp=&escape($regexp); |
} else { |
} else { |
$regexp='.'; |
$regexp='.'; |
} |
} |
my $rep=reply("dump:$udomain:$uname:$namespace:$regexp:$range",$uhome); |
my $rep=&reply("dump:$udomain:$uname:$namespace:$regexp:$range",$uhome); |
my @pairs=split(/\&/,$rep); |
my @pairs=split(/\&/,$rep); |
my %returnhash=(); |
my %returnhash=(); |
foreach (@pairs) { |
foreach my $item (@pairs) { |
my ($key,$value)=split(/=/,$_,2); |
my ($key,$value)=split(/=/,$item,2); |
$returnhash{unescape($key)}=&thaw_unescape($value); |
$key = &unescape($key); |
} |
next if ($key =~ /^error: 2 /); |
return %returnhash; |
$returnhash{$key}=&thaw_unescape($value); |
|
} |
|
return %returnhash; |
} |
} |
|
|
# --------------------------------------------------------- dumpstore interface |
# --------------------------------------------------------- dumpstore interface |
Line 4100 sub devalidate_getgroups_cache {
|
Line 4110 sub devalidate_getgroups_cache {
|
|
|
sub plaintext { |
sub plaintext { |
my ($short,$type,$cid) = @_; |
my ($short,$type,$cid) = @_; |
|
if ($short =~ /^cr/) { |
|
return (split('/',$short))[-1]; |
|
} |
if (!defined($cid)) { |
if (!defined($cid)) { |
$cid = $env{'request.course.id'}; |
$cid = $env{'request.course.id'}; |
} |
} |
Line 4569 sub is_locked {
|
Line 4582 sub is_locked {
|
} |
} |
} |
} |
|
|
|
sub declutter_portfile { |
|
my ($file) = @_; |
|
&logthis("got $file"); |
|
$file =~ s-^(/portfolio/|portfolio/)-/-; |
|
&logthis("ret $file"); |
|
return $file; |
|
} |
|
|
# ------------------------------------------------------------- Mark as Read Only |
# ------------------------------------------------------------- Mark as Read Only |
|
|
sub mark_as_readonly { |
sub mark_as_readonly { |
Line 4577 sub mark_as_readonly {
|
Line 4598 sub mark_as_readonly {
|
my ($tmp)=keys(%current_permissions); |
my ($tmp)=keys(%current_permissions); |
if ($tmp=~/^error:/) { undef(%current_permissions); } |
if ($tmp=~/^error:/) { undef(%current_permissions); } |
foreach my $file (@{$files}) { |
foreach my $file (@{$files}) { |
|
$file = &declutter_portfile($file); |
push(@{$current_permissions{$file}},$what); |
push(@{$current_permissions{$file}},$what); |
} |
} |
&put('file_permissions',\%current_permissions,$domain,$user); |
&put('file_permissions',\%current_permissions,$domain,$user); |
Line 4693 sub get_access_controls {
|
Line 4715 sub get_access_controls {
|
return %access; |
return %access; |
} |
} |
|
|
sub parse_access_controls { |
|
my ($access_item) = @_; |
|
my %content; |
|
my $role_id; |
|
my $user; |
|
my $usercount; |
|
my $token; |
|
my $parser=HTML::TokeParser->new(\$access_item); |
|
while ($token=$parser->get_token) { |
|
if ($token->[0] eq 'S') { |
|
my $entry=$token->[1]; |
|
if ($entry eq 'scope') { |
|
my $type = $token->[2]{'type'}; |
|
if (($type eq 'course') || ($type eq 'group')) { |
|
$content{'roles'} = {}; |
|
} |
|
} elsif ($entry eq 'roles') { |
|
$role_id = $token->[2]{id}; |
|
$content{$entry}{$role_id}} = { |
|
role => [], |
|
access => [], |
|
section => [], |
|
group => [], |
|
}; |
|
} elsif ($entry eq 'users') { |
|
$content{'users'} = {}; |
|
$usercount = 0; |
|
} elsif ($entry eq 'user') { |
|
$user = ''; |
|
} else { |
|
my $value=$parser->get_text('/'.$entry); |
|
if ($entry eq 'uname') { |
|
$user = $value; |
|
} elsif ($entry eq 'udom') { |
|
$user .= ':'.$value; |
|
$content{'users'}{$user} = $usercount; |
|
} elsif ($entry eq 'role' || |
|
$entry eq 'access' || |
|
$entry eq 'section' || |
|
$entry eq 'group') { |
|
if ($role_id ne '') { |
|
push(@{$content{'roles'}{$role_id}{$entry}},$value); |
|
} |
|
} elsif ($entry eq 'dom') { |
|
push(@{$content{$entry}},$value); |
|
} else { |
|
$content{$entry}=$value; |
|
} |
|
} |
|
} elsif ($token->[0] eq 'E') { |
|
if ($token->[1] eq 'user') { |
|
$user = ''; |
|
$usercount ++; |
|
} elsif ($token->[1] eq 'roles') { |
|
$role_id = ''; |
|
} |
|
} |
|
} |
|
return %content; |
|
} |
|
|
|
sub modify_access_controls { |
sub modify_access_controls { |
my ($file_name,$changes,$domain,$user)=@_; |
my ($file_name,$changes,$domain,$user)=@_; |
my ($outcome,$deloutcome); |
my ($outcome,$deloutcome); |
Line 4859 sub get_marked_as_readonly {
|
Line 4820 sub get_marked_as_readonly {
|
if (ref($value) eq "ARRAY"){ |
if (ref($value) eq "ARRAY"){ |
foreach my $stored_what (@{$value}) { |
foreach my $stored_what (@{$value}) { |
my $cmp2=$stored_what; |
my $cmp2=$stored_what; |
if (ref($stored_what eq 'ARRAY')) { |
if (ref($stored_what) eq 'ARRAY') { |
$cmp2=join('',@{$stored_what}); |
$cmp2=join('',@{$stored_what}); |
} |
} |
if ($cmp1 eq $cmp2) { |
if ($cmp1 eq $cmp2) { |
Line 4911 sub unmark_as_readonly {
|
Line 4872 sub unmark_as_readonly {
|
# unmarks $file_name (if $file_name is defined), or all files locked by $what |
# unmarks $file_name (if $file_name is defined), or all files locked by $what |
# for portfolio submissions, $what contains [$symb,$crsid] |
# for portfolio submissions, $what contains [$symb,$crsid] |
my ($domain,$user,$what,$file_name,$group) = @_; |
my ($domain,$user,$what,$file_name,$group) = @_; |
|
$file_name = &declutter_portfile($file_name); |
my $symb_crs = $what; |
my $symb_crs = $what; |
if (ref($what)) { $symb_crs=join('',@$what); } |
if (ref($what)) { $symb_crs=join('',@$what); } |
my %current_permissions = &dump('file_permissions',$domain,$user,$group); |
my %current_permissions = &dump('file_permissions',$domain,$user,$group); |
Line 4918 sub unmark_as_readonly {
|
Line 4880 sub unmark_as_readonly {
|
if ($tmp=~/^error:/) { undef(%current_permissions); } |
if ($tmp=~/^error:/) { undef(%current_permissions); } |
my @readonly_files = &get_marked_as_readonly($domain,$user,$what,$group); |
my @readonly_files = &get_marked_as_readonly($domain,$user,$what,$group); |
foreach my $file (@readonly_files) { |
foreach my $file (@readonly_files) { |
if (defined($file_name) && ($file_name ne $file)) { next; } |
my $clean_file = &declutter_portfile($file); |
|
if (defined($file_name) && ($file_name ne $clean_file)) { next; } |
my $current_locks = $current_permissions{$file}; |
my $current_locks = $current_permissions{$file}; |
my @new_locks; |
my @new_locks; |
my @del_keys; |
my @del_keys; |