--- loncom/auth/lonroles.pm 2008/05/14 23:52:52 1.191
+++ loncom/auth/lonroles.pm 2008/05/19 17:55:38 1.193
@@ -1,7 +1,7 @@
# The LearningOnline Network with CAPA
# User Roles Screen
#
-# $Id: lonroles.pm,v 1.191 2008/05/14 23:52:52 raeburn Exp $
+# $Id: lonroles.pm,v 1.193 2008/05/19 17:55:38 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -154,42 +154,34 @@ sub handler {
}
last;
}
-# Is this a recent ad-hoc CA-role?
+# Is this an ad-hoc CA-role?
if (my ($domain,$user) =
($envkey =~ m-^form\.ca\./($match_domain)/($match_username)$-)) {
- # See if still allowed
+ # Check if author blocked ca-access
my %blocked=&Apache::lonnet::get('environment',['domcoord.author'],$domain,$user);
if ($blocked{'domcoord.author'} eq 'blocked') {
delete($env{$envkey});
$env{'user.error.msg'}=':::1:User '.$user.' in domain '.$domain.' blocked domain coordinator access';
last;
}
- if (($dcroles{$domain}) && (&is_author_homeserver($user,$domain))) {
- &check_privs($domain,$user,$then,$now,'ca');
+ if ($dcroles{$domain}) {
+ my ($server_status,$home) = &check_author_homeserver($user,$domain);
+ if (($server_status eq 'ok') || ($server_status eq 'switchserver')) {
+ &check_privs($domain,$user,$then,$now,'ca');
+ if ($server_status eq 'switchserver') {
+ my $trolecode = 'ca./'.$domain.'/'.$user;
+ my $switchserver = '/adm/switchserver?'
+ .'otherserver='.$home.'&role='.$trolecode;
+ $r->internal_redirect($switchserver);
+ }
+ } else {
+ delete($env{$envkey});
+ }
} else {
delete($env{$envkey});
}
last;
}
-# Is this a new ad-hoc CA-role?
- if (my ($domain) =
- ($envkey =~ m-^form\.adhocca\./($match_domain)$-)) {
- my $user=$env{'form.adhoccauname.'.$domain};
- if (!$user) { $user=$env{'form.adhoccaunamerecent.'.$domain} };
- # See if that is even allowed
- my %blocked=&Apache::lonnet::get('environment',['domcoord.author'],$domain,$user);
- if ($blocked{'domcoord.author'} eq 'blocked') {
- $env{'user.error.msg'}=':::1:User '.$user.' in domain '.$domain.' blocked domain coordinator access';
- last;
- }
- if ($dcroles{$domain}) {
- if (($user) && ($user=~/$match_username/) && (&is_author_homeserver($user,$domain))) {
- &check_privs($domain,$user,$then,$now,'ca');
- $env{'form.ca./'.$domain.'/'.$user}=1;
- }
- }
- last;
- }
}
}
@@ -719,7 +711,7 @@ ENDHEADER
$r->print('
');
}
$r->print(' | '.&mt('No role specified').
- ' | '.$tremark.
+ ' | '.$tremark.
' |
'."\n");
$r->print('');
@@ -752,8 +744,7 @@ ENDHEADER
$output.=$roletext{'user.role.'.$_};
if ($_ =~ m-dc\./($match_domain)/-
&& $dcroles{$1}) {
- $output .= &allcourses_row($1,'recent').
- &allcoauthors_row($1,'recent');
+ $output .= &adhoc_roles_row($1,'recent');
}
} elsif ($numdc > 0) {
unless ($_ =~/^error\:/) {
@@ -763,16 +754,16 @@ ENDHEADER
}
if ($output) {
$r->print("".
- &mt('Recent Roles')." | ");
+ &mt('Recent Roles')."
");
$r->print($output);
- $r->print("");
$doheaders ++;
}
}
if ($numdc > 0) {
$r->print(&coursepick_jscript());
- $r->print(&Apache::loncommon::coursebrowser_javascript());
+ $r->print(&Apache::loncommon::coursebrowser_javascript().
+ &Apache::loncommon::authorbrowser_javascript());
}
&print_rolerows($r,$doheaders,\%roleclass,\%sortrole,\%dcroles,\%roletext);
my $tremark='';
@@ -787,13 +778,13 @@ ENDHEADER
unless ($nochoose) {
if ($env{'request.role'} ne 'cm') {
$r->print(' | ');
+ &mt('Select').'" name="cm" />');
} else {
$r->print(' | ');
}
}
$r->print(''.&mt('No role specified').
- ' | '.$tremark.
+ ' | '.$tremark.
' | '."\n");
$r->print('');
@@ -857,8 +848,7 @@ sub print_rolerows {
if ($sortrole->{$which} =~ m-dc\./($match_domain)/-) {
if (ref($dcroles) eq 'HASH') {
if ($dcroles->{$1}) {
- $output .= &allcourses_row($1,'').
- &allcoauthors_row($1,'');
+ $output .= &adhoc_roles_row($1,'');
}
}
}
@@ -997,17 +987,17 @@ sub build_roletext {
} elsif ($tstatus eq 'is') {
$roletext.=' | ';
+ $trolecode."','".$buttonname.'\');" />';
} elsif ($tryagain) {
$roletext.=
' | ';
+ $trolecode."','".$buttonname.'\');" />';
} elsif ($advanced) {
$roletext.=
' | ';
+ $trolecode."','".$buttonname.'\');" />';
} else {
$roletext.=' | ';
}
@@ -1028,18 +1018,21 @@ sub build_roletext {
return $roletext;
}
-sub is_author_homeserver {
+sub check_author_homeserver {
my ($uname,$udom)=@_;
+ if (($uname eq '') || ($udom eq '')) {
+ return ('fail','');
+ }
my $home = &Apache::lonnet::homeserver($uname,$udom);
+ if (&Apache::lonnet::host_domain($home) ne $udom) {
+ return ('fail',$home);
+ }
my @ids=&Apache::lonnet::current_machine_ids();
- foreach my $id (@ids) {
- if ($id eq $home) {
- if (-e "/home/".$uname."/public_html") {
- return 1;
- }
- }
+ if (grep(/^\Q$home\E$/,@ids)) {
+ return ('ok',$home);
+ } else {
+ return ('switchserver',$home);
}
- return 0;
}
sub check_privs {
@@ -1141,7 +1134,7 @@ sub check_forcc {
}
sub courselink {
- my ($dcdom,$rowtype,$selecttype) = @_;
+ my ($dcdom,$rowtype) = @_;
my $courseform=&Apache::loncommon::selectcourse_link
('rolechoice','dccourse'.$rowtype.'_'.$dcdom,
'dcdomain'.$rowtype.'_'.$dcdom,'coursedesc'.$rowtype.'_'.
@@ -1193,6 +1186,13 @@ END
return $verify_script;
}
+sub coauthorlink {
+ my ($dcdom,$rowtype) = @_;
+ my $coauthorform=&Apache::loncommon::selectauthor_link('rolechoice',$dcdom);
+ my $hiddenitems = '';
+ return $coauthorform.$hiddenitems;
+}
+
sub display_cc_role {
my $rolekey = shift;
my $roletext;
@@ -1225,28 +1225,22 @@ sub display_cc_role {
return ($roletext);
}
-sub allcourses_row {
+sub adhoc_roles_row {
my ($dcdom,$rowtype) = @_;
my $output = ''.
- ' ';
- my $selectlink = &courselink($dcdom,$rowtype);
+ ' | '
+ .&mt('[_1]Ad hoc[_2] roles in domain [_3] --',
+ '','',$dcdom).' | ';
+ my $selectcclink = &courselink($dcdom,$rowtype);
my $ccrole = &Apache::lonnet::plaintext('cc');
- $output.= ''.
- &mt('[_1]: [_2] from domain [_3]',$ccrole,$selectlink,$dcdom).
- '
| '."\n";
- return $output;
-}
-
-sub allcoauthors_row {
- my ($dcdom,$rowtype) = @_;
- my $output = ''.
- ' ';
my $carole = &Apache::lonnet::plaintext('ca');
- my $inputlink='';
- my $gobutton='';
+ my $selectcalink = &coauthorlink($dcdom,$rowtype);
$output.= ''.
- &mt('[_1]: [_2] in domain [_3] [_4]',$carole,$inputlink,$dcdom,$gobutton).
- '
| | '."\n";
+ &mt('[_1]: [_2]',$ccrole,$selectcclink).
+ '
| '.
+ &mt('[_1]: [_2]',$carole,$selectcalink).
+ '
|
|
'.
+ ' |
'."\n";
return $output;
}