--- loncom/auth/lonroles.pm 2008/03/12 02:47:34 1.186 +++ loncom/auth/lonroles.pm 2008/09/03 04:28:22 1.206 @@ -1,7 +1,7 @@ # The LearningOnline Network with CAPA # User Roles Screen # -# $Id: lonroles.pm,v 1.186 2008/03/12 02:47:34 raeburn Exp $ +# $Id: lonroles.pm,v 1.206 2008/09/03 04:28:22 raeburn Exp $ # # Copyright Michigan State University Board of Trustees # @@ -43,6 +43,7 @@ use Apache::lonpageflip(); use Apache::lonnavdisplay(); use GDBM_File; use LONCAPA qw(:DEFAULT :match); +use HTML::Entities; sub redirect_user { @@ -106,6 +107,10 @@ sub handler { # ================================================================== Roles Init if ($env{'form.selectrole'}) { + + my $locknum=&Apache::lonnet::get_locks(); + if ($locknum) { return 409; } + if ($env{'form.newrole'}) { $env{'form.'.$env{'form.newrole'}}=1; } @@ -138,26 +143,54 @@ 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)$-)) { - if (($dcroles{$domain}) && (&is_author_homeserver($user,$domain))) { - &check_privs($domain,$user,$then,$now,'ca'); - } else { + if (($domain eq $env{'user.domain'}) && ($user eq $env{'user.name'})) { delete($env{$envkey}); + $env{'form.au./'.$domain.'/'} = 1; + my ($server_status,$home) = &check_author_homeserver($user,$domain); + if ($server_status eq 'switchserver') { + my $trolecode = 'au./'.$domain.'/'; + my $switchserver = '/adm/switchserver?otherserver='.$home.'&role='.$trolecode; + $r->internal_redirect($switchserver); + } + last; + } + if (my ($castart,$caend) = ($env{'user.role.ca./'.$domain.'/'.$user} =~ /^(\d*)\.(\d*)$/)) { + if (((($castart) && ($castart < $now)) || !$castart) && + ((!$caend) || (($caend) && ($caend > $now)))) { + my ($server_status,$home) = &check_author_homeserver($user,$domain); + if ($server_status eq 'switchserver') { + my $trolecode = 'ca./'.$domain.'/'.$user; + my $switchserver = '/adm/switchserver?otherserver='.$home.'&role='.$trolecode; + $r->internal_redirect($switchserver); + } + last; + } + } + # 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; } - last; - } -# Is this a new ad-hoc CA-role? - if (my ($domain) = - ($envkey =~ m-^form\.adhocca\./($match_domain)$-)) { if ($dcroles{$domain}) { - my $user=$env{'form.adhoccauname.'.$domain}; - if (!$user) { $user=$env{'form.adhoccaunamerecent.'.$domain} }; - if (($user) && ($user=~/$match_username/) && (&is_author_homeserver($user,$domain))) { - &check_privs($domain,$user,$then,$now,'ca'); - $env{'form.ca./'.$domain.'/'.$user}=1; - } + 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; } @@ -219,8 +252,11 @@ sub handler { $cdom,$cnum, $env{'user.domain'}, $env{'user.name'}, - 'Assigned from '.$ENV{'REMOTE_ADDR'}.' at '.localtime().' for '. - $trolecode); + &mt('Assigned from [_1] at [_2] for [_3]' + ,$ENV{'REMOTE_ADDR'} + ,&Apache::lonlocal::locallocaltime() + ,$trolecode) + ); unless ($assignresult eq 'ok') { $assignresult=~s/^error\:\s*//; $message=&mt($assignresult). @@ -326,6 +362,10 @@ ENDENTERKEY } elsif ($env{'request.course.id'}) { if ($env{'form.destinationurl'}) { my $dest = $env{'form.destinationurl'}; + if ($env{'form.destsymb'} ne '') { + my $esc_symb = &HTML::Entities::encode($env{'form.destsymb'},'"<>&'); + $dest .= '?symb='.$esc_symb; + } &redirect_user($r,&mt('Entering [_1]', $env{'course.'.$courseid.'.description'}), $dest,$msg, @@ -340,7 +380,7 @@ ENDENTERKEY ) { my $startpage = &courseloadpage($courseid); unless ($startpage eq 'firstres') { - $msg = &mt('Entering [_1] ....', + $msg = &mt('Entering [_1] ...', $env{'course.'.$courseid.'.description'}); &redirect_user($r,&mt('New in course'), '/adm/whatsnew?refpage=start',$msg, @@ -447,16 +487,16 @@ ENDHEADER # -------------------------------------------------------- Generate Page Output # --------------------------------------------------------------- Error Header? if ($error) { - $r->print("

LON-CAPA Access Control

"); + $r->print("

".&mt('LON-CAPA Access Control')."

"); $r->print("
");
 	if ($priv ne '') {
-	    $r->print("Access  : ".&Apache::lonnet::plaintext($priv)."\n");
+            $r->print(&mt('Access  : ').&Apache::lonnet::plaintext($priv)."\n");
 	}
 	if ($fn ne '') {
-	    $r->print("Resource: ".&Apache::lonenc::check_encrypt($fn)."\n");
+            $r->print(&mt('Resource: ').&Apache::lonenc::check_encrypt($fn)."\n");
 	}
 	if ($msg ne '') {
-	    $r->print("Action  : $msg\n");
+            $r->print(&mt('Action  : ').$msg."\n");
 	}
 	$r->print("
"); my $url=$fn; @@ -492,17 +532,14 @@ ENDHEADER $r->print(''); $r->print(''); } - if ($env{'user.adv'}) { - $r->print( - '
'); - } - my (%roletext,%sortrole,%roleclass); my $countactive=0; + my $countfuture=0; + my $countwill=0; my $inrole=0; my $possiblerole=''; + my %futureroles; + my %roles_nextlogin; foreach $envkey (sort keys %env) { my $button = 1; my $switchserver=''; @@ -539,29 +576,32 @@ ENDHEADER } elsif ($tstatus eq 'future') { $tbg='#FFFF77'; $button=0; + $futureroles{$trolecode} = $tstart.':'.$tend; + $countfuture ++; } elsif ($tstatus eq 'will') { $tbg='#FFAA77'; - $tremark.=&mt('Active at next login. '); + $tremark.=&mt('Active at next login.').' '; + $roles_nextlogin{$trolecode} = $tstart.':'.$tend; + $countwill ++; } elsif ($tstatus eq 'expired') { $tbg='#FF7777'; $tfont='#330000'; $button=0; } elsif ($tstatus eq 'will_not') { $tbg='#AAFF77'; - $tremark.=&mt('Expired after logout. '); + $tremark.=&mt('Expired after logout.').' '; } elsif ($tstatus eq 'selected') { $tbg='#11CC55'; $tfont='#002200'; $inrole=1; $countactive++; - $tremark.=&mt('Currently selected. '); + $tremark.=&mt('Currently selected.').' '; } my $trole; if ($role =~ /^cr\//) { my ($rdummy,$rdomain,$rauthor,$rrole)=split(/\//,$role); if ($tremark) { $tremark.='
'; } - $tremark.=&mt('Defined by ').$rauthor. - &mt(' at ').$rdomain.'.'; + $tremark.=&mt('Defined by [_1] at [_2].',$rauthor,$rdomain); } $trole=Apache::lonnet::plaintext($role); my $ttype; @@ -657,6 +697,19 @@ ENDHEADER } } } + if ($env{'user.adv'}) { + $r->print( + '
'); + } else { + if ($countactive > 0) { + my $domdesc = &Apache::lonnet::domain($env{'user.domain'},'description'); + my $esc_dom = &HTML::Entities::encode($env{'user.domain'},'"<>&'); + $r->print('

'.&mt('[_1]Visit the [_2]Course Catalog[_3] to view all [_4] LON-CAPA courses.','','','',$domdesc).'
'.&mt('If a course is [_1]not[_2] in your list of current courses below, you may be able to enroll if self-enrollment is permitted.','','').'

'); + } + } + # No active roles if ($countactive==0) { if ($inrole) { @@ -664,39 +717,60 @@ ENDHEADER } else { $r->print('

'.&mt('Currently no active roles or courses').'

'); } - $r->print(''.&Apache::loncommon::end_page()); + &findcourse_advice($r); + $r->print(''); + if ($countfuture) { + $r->print(&mt('The following [quant,_1,role,roles] will become active in the future:',$countfuture)); + my $doheaders = &roletable_headers($r,\%roleclass,\%sortrole, + $nochoose); + &print_rolerows($r,$doheaders,\%roleclass,\%sortrole,\%dcroles, + \%roletext); + my $tremark=''; + my $tfont='#003300'; + if ($env{'request.role'} eq 'cm') { + $r->print(''); + $tremark=&mt('Currently selected.').' '; + $tfont='#002200'; + } else { + $r->print(''); + } + $r->print(''.&mt('No role specified'). + ''.$tremark. + ' '."\n"); + + $r->print(''); + } + $r->print(&Apache::loncommon::end_page()); return OK; # Is there only one choice? - } elsif (($countactive==1) && ($env{'request.role'} eq 'cm')) { - $r->print('

'.&mt('Please stand by.').'

'. - ''. + } elsif ($countactive==1) { + my $needs_switchserver; + if ($env{'user.author'}) { + $needs_switchserver = &check_needs_switchserver($possiblerole); + } + if ((!$needs_switchserver) && ($env{'request.role'} eq 'cm')) { + $r->print('

'.&mt('Please stand by.').'

'. + ''. ''); - $r->print("\n"); - $r->rflush(); - $r->print(''); - $r->print(&Apache::loncommon::end_page()); - return OK; + $r->print("\n"); + $r->rflush(); + $r->print(''); + $r->print(&Apache::loncommon::end_page()); + return OK; + } + if ($needs_switchserver) { + $r->print("

".&mt('Server Switch Required')."

\n". + &mt('Construction Space access is only available from '. + 'the home server of the corresponding Author.').'
'. + &mt("Click the 'Switch Server' link to go there.").'
'); + } } # More than one possible role # ----------------------------------------------------------------------- Table - unless ((!&Apache::lonmenu::show_course()) || ($nochoose)) { + unless ((!&Apache::lonmenu::show_course()) || ($nochoose) || ($countactive==1)) { $r->print("

".&mt('Select a Course to Enter')."

\n"); } - $r->print('
'); - unless ($nochoose) { $r->print(''); } - $r->print(''."\n"); - my $doheaders=-1; - foreach my $type ('Domain','Construction Space','Course','Unavailable','System') { - my $haverole=0; - foreach my $which (sort {uc($a) cmp uc($b)} (keys(%sortrole))) { - if ($roleclass{$sortrole{$which}} =~ /^\Q$type\E/) { - $haverole=1; - } - } - if ($haverole) { $doheaders++; } - } - + my $doheaders = &roletable_headers($r,\%roleclass,\%sortrole,$nochoose); if ($env{'environment.recentroles'}) { my %recent_roles = &Apache::lonhtmlcommon::get_recent('roles',$env{'environment.recentrolesn'}); @@ -706,8 +780,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\:/) { @@ -717,59 +790,40 @@ ENDHEADER } if ($output) { $r->print(""); + &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()); } - foreach my $type ('Construction Space','Domain','Course','Unavailable','System') { - my $output; - foreach my $which (sort {uc($a) cmp uc($b)} (keys(%sortrole))) { - if ($roleclass{$sortrole{$which}} =~ /^\Q$type\E/) { - $output.=$roletext{$sortrole{$which}}; - if ($sortrole{$which} =~ m-dc\./($match_domain)/-) { - if ($dcroles{$1}) { - $output .= &allcourses_row($1,''). - &allcoauthors_row($1,''); - } - } - } - } - if ($output) { - if ($doheaders > 0) { - $r->print("". - ""); + &print_rolerows($r,$doheaders,\%roleclass,\%sortrole,\%dcroles,\%roletext); + if ($countactive > 1) { + my $tremark=''; + my $tfont='#003300'; + if ($env{'request.role'} eq 'cm') { + $r->print(''); + $tremark=&mt('Currently selected.').' '; + $tfont='#002200'; + } else { + $r->print(''); + } + unless ($nochoose) { + if ($env{'request.role'} ne 'cm') { + $r->print(''); + } else { + $r->print(''); } - $r->print($output); - } - } - my $tremark=''; - my $tfont='#003300'; - if ($env{'request.role'} eq 'cm') { - $r->print(''); - $tremark=&mt('Currently selected. '); - $tfont='#002200'; - } else { - $r->print(''); - } - unless ($nochoose) { - if ($env{'request.role'} ne 'cm') { - $r->print(''); - } else { - $r->print(''); - } - } - $r->print(''."\n"); - + } + $r->print(''."\n"); + } $r->print('
 '.&mt('User Role').''.&mt('Extent'). - ''.&mt('Start').''.&mt('End').'
". - &mt('Recent Roles')."
".&mt($type)."
 
 '.&mt('No role specified'). - ''.$tremark. - ' 
'.&mt('No role specified'). + ''.$tremark. + ' 
'); unless ($nochoose) { $r->print("\n"); @@ -781,14 +835,101 @@ ENDHEADER } $r->print(&Apache::lonnet::getannounce()); if ($advanced) { - $r->print('

This is LON-CAPA '. - $r->dir_config('lonVersion').'
'. - ''.&mt('Logout').'

'); + my $esc_dom = &HTML::Entities::encode($env{'user.domain'},'"<>&'); + $r->print('

' + .&mt('This is LON-CAPA [_1]',$r->dir_config('lonVersion')) + .'
' + .''.&mt('Logout').'  ' + .'' + .&mt('Course Catalog') + .'

'); } $r->print(&Apache::loncommon::end_page()); return OK; } +sub roletable_headers { + my ($r,$roleclass,$sortrole,$nochoose) = @_; + my $doheaders; + if ((ref($sortrole) eq 'HASH') && (ref($roleclass) eq 'HASH')) { + $r->print('
'); + if (!$nochoose) { $r->print(''); } + $r->print(''."\n"); + $doheaders=-1; + my @roletypes = &roletypes(); + foreach my $type (@roletypes) { + my $haverole=0; + foreach my $which (sort {uc($a) cmp uc($b)} (keys(%{$sortrole}))) { + if ($roleclass->{$sortrole->{$which}} =~ /^\Q$type\E/) { + $haverole=1; + } + } + if ($haverole) { $doheaders++; } + } + } + return $doheaders; +} + +sub roletypes { + my @types = ('Domain','Construction Space','Course','Unavailable','System'); + return @types; +} + +sub print_rolerows { + my ($r,$doheaders,$roleclass,$sortrole,$dcroles,$roletext) = @_; + if ((ref($roleclass) eq 'HASH') && (ref($sortrole) eq 'HASH')) { + my @types = &roletypes(); + foreach my $type (@types) { + my $output; + foreach my $which (sort {uc($a) cmp uc($b)} (keys(%{$sortrole}))) { + if ($roleclass->{$sortrole->{$which}} =~ /^\Q$type\E/) { + if (ref($roletext) eq 'HASH') { + $output.=$roletext->{$sortrole->{$which}}; + if ($sortrole->{$which} =~ m-dc\./($match_domain)/-) { + if (ref($dcroles) eq 'HASH') { + if ($dcroles->{$1}) { + $output .= &adhoc_roles_row($1,''); + } + } + } + } + } + } + if ($output) { + if ($doheaders > 0) { + $r->print("". + ""); + } + $r->print($output); + } + } + } +} + +sub findcourse_advice { + my ($r) = @_; + my $domdesc = &Apache::lonnet::domain($env{'user.domain'},'description'); + my $esc_dom = &HTML::Entities::encode($env{'user.domain'},'"<>&'); + if (&Apache::lonnet::auto_run(undef,$env{'user.domain'})) { + $r->print(&mt('If you were expecting to see an active role listed for a particular course in the [_1] domain, it may be missing for one of the following reasons:',$domdesc).' +'); + } else { + $r->print(&mt('If you were expecting to see an active role listed for a particular course, that course may not have been created yet.').'
'); + } + $r->print('

'.&mt('The [_1]Course Catalog[_2] provides information about all [_3] classes for which LON-CAPA courses have been created.','','',$domdesc).'
'); + $r->print(&mt('You can search the course catalog for courses which permit self-enrollment, if you would like to enroll in a course.').'

'); + return; +} + sub privileges_info { my ($which) = @_; my $output; @@ -824,7 +965,7 @@ sub privileges_info { $ttype='System'; $twhere='/'; } - $output .= "\n

".$ttype.': '.$twhere.'

'."\n'. - ' '. + ''."\n"; return $output; }
 '.&mt('User Role').''.&mt('Extent') + .''.&mt('Start').''.&mt('End') + .'
". + &mt($type)."
'; - my $selectlink = &courselink($dcdom,$rowtype); + ' '."\n"; - return $output; -} - -sub allcoauthors_row { - my ($dcdom,$rowtype) = @_; - my $output = ''. - ' '."\n"; + &mt('[_1]: [_2]',$ccrole,$selectcclink). + '
' + .&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). - '
'; 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). - '
  '. + &mt('[_1]: [_2]',$carole,$selectcalink). + '