[LON-CAPA-cvs] cvs: loncom /auth lonroles.pm /lonnet/perl lonnet.pm
raeburn
raeburn@source.lon-capa.org
Thu, 11 Jun 2009 19:02:32 -0000
This is a MIME encoded message
--raeburn1244746952
Content-Type: text/plain
raeburn Thu Jun 11 19:02:32 2009 EDT
Modified files:
/loncom/auth lonroles.pm
/loncom/lonnet/perl lonnet.pm
Log:
- Usability improvements.
- Reduce need for user to complete logout/login cycle to be able to select roles with 'will' role status (roles with future access which existed at time of last log-in, and are "active"):
- Display of roles screen causes privs to propagate to %env in the background and become selectable.
- &gather_roles() routine created (ongoing simplification of monolithic handler() routine).
- &Apache::lonnet::roles_status() takes new arg ($refresh).
- New environment variable: user.refresh.time - records when last check was made for 'will' type role.
--raeburn1244746952
Content-Type: text/plain
Content-Disposition: attachment; filename="raeburn-20090611190232.txt"
Index: loncom/auth/lonroles.pm
diff -u loncom/auth/lonroles.pm:1.225 loncom/auth/lonroles.pm:1.226
--- loncom/auth/lonroles.pm:1.225 Fri May 22 17:57:03 2009
+++ loncom/auth/lonroles.pm Thu Jun 11 19:02:27 2009
@@ -1,7 +1,7 @@
# The LearningOnline Network with CAPA
# User Roles Screen
#
-# $Id: lonroles.pm,v 1.225 2009/05/22 17:57:03 bisitz Exp $
+# $Id: lonroles.pm,v 1.226 2009/06/11 19:02:27 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -202,6 +202,10 @@
my $now=time;
my $then=$env{'user.login.time'};
+ my $refresh=$env{'user.refresh.time'};
+ if (!$refresh) {
+ $refresh = $then;
+ }
my $envkey;
my %dcroles = ();
my $numdc = &check_fordc(\%dcroles,$then);
@@ -304,7 +308,7 @@
foreach $envkey (keys %env) {
next if ($envkey!~/^user\.role\./);
my ($where,$trolecode,$role,$tstatus,$tend,$tstart);
- &Apache::lonnet::role_status($envkey,$then,$now,\$role,\$where,
+ &Apache::lonnet::role_status($envkey,$then,$refresh,$now,\$role,\$where,
\$trolecode,\$tstatus,\$tstart,\$tend);
if ($env{'form.'.$trolecode}) {
if ($tstatus eq 'is') {
@@ -676,173 +680,14 @@
$r->print('<input type="hidden" name="selectrole" value="1" />');
$r->print('<input type="hidden" name="newrole" value="" />');
}
- my (%roletext,%sortrole,%roleclass);
- my $countactive=0;
- my $countfuture=0;
- my $countwill=0;
- my $inrole=0;
- my $possiblerole='';
- my %futureroles;
- my %roles_nextlogin;
- my %timezones;
- foreach $envkey (sort keys %env) {
- my $button = 1;
- my $switchserver='';
- my ($roletext,$roletext_end);
- my $sortkey;
- if ($envkey=~/^user\.role\./) {
- my ($role,$where,$trolecode,$tstart,$tend,$tremark,$tstatus,$tpstart,$tpend);
- &Apache::lonnet::role_status($envkey,$then,$now,\$role,\$where,
- \$trolecode,\$tstatus,\$tstart,\$tend);
- next if (!defined($role) || $role eq '' || $role =~ /^gr/);
- my $timezone = &role_timezone($where,\%timezones);
- $tremark='';
- $tpstart=' ';
- $tpend=' ';
- if ($tstart) {
- $tpstart=&Apache::lonlocal::locallocaltime($tstart,$timezone);
- }
- if ($tend) {
- $tpend=&Apache::lonlocal::locallocaltime($tend,$timezone);
- }
- if ($env{'request.role'} eq $trolecode) {
- $tstatus='selected';
- }
- my $tbg;
- if (($tstatus eq 'is')
- || ($tstatus eq 'selected')
- || ($tstatus eq 'will')
- || ($tstatus eq 'future')
- || ($env{'form.showall'})) {
- if ($tstatus eq 'is') {
- $tbg='LC_roles_is';
- $possiblerole=$trolecode;
- $countactive++;
- } elsif ($tstatus eq 'future') {
- $tbg='LC_roles_future';
- $button=0;
- $futureroles{$trolecode} = $tstart.':'.$tend;
- $countfuture ++;
- } elsif ($tstatus eq 'will') {
- $tbg='LC_roles_will';
- $tremark.=&mt('Active at next login.').' ';
- $roles_nextlogin{$trolecode} = $tstart.':'.$tend;
- $countwill ++;
- } elsif ($tstatus eq 'expired') {
- $tbg='LC_roles_expired';
- $button=0;
- } elsif ($tstatus eq 'will_not') {
- $tbg='LC_roles_will_not';
- $tremark.=&mt('Expired after logout.').' ';
- } elsif ($tstatus eq 'selected') {
- $tbg='LC_roles_selected';
- $inrole=1;
- $countactive++;
- $tremark.=&mt('Currently selected.').' ';
- }
- my $trole;
- if ($role =~ /^cr\//) {
- my ($rdummy,$rdomain,$rauthor,$rrole)=split(/\//,$role);
- if ($tremark) { $tremark.='<br />'; }
- $tremark.=&mt('Defined by [_1] at [_2].',$rauthor,$rdomain);
- }
- $trole=Apache::lonnet::plaintext($role);
- my $ttype;
- my $twhere;
- my ($tdom,$trest,$tsection)=
- split(/\//,Apache::lonnet::declutter($where));
- # First, Co-Authorship roles
- if (($role eq 'ca') || ($role eq 'aa')) {
- my $home = &Apache::lonnet::homeserver($trest,$tdom);
- my $allowed=0;
- my @ids=&Apache::lonnet::current_machine_ids();
- foreach my $id (@ids) { if ($id eq $home) { $allowed=1; } }
- if (!$allowed) {
- $button=0;
- $switchserver='otherserver='.$home.'&role='.$trolecode;
- }
- #next if ($home eq 'no_host');
- $home = &Apache::lonnet::hostname($home);
- $ttype='Construction Space';
- $twhere=&mt('User').': '.$trest.'<br />'.&mt('Domain').
- ': '.$tdom.'<br />'.
- ' '.&mt('Server').': '.$home;
- $env{'course.'.$tdom.'_'.$trest.'.description'}='ca';
- $tremark.=&Apache::lonhtmlcommon::authorbombs('/res/'.$tdom.'/'.$trest.'/');
- $sortkey=$role."$trest:$tdom";
- } elsif ($role eq 'au') {
- # Authors
- my $home = &Apache::lonnet::homeserver
- ($env{'user.name'},$env{'user.domain'});
- my $allowed=0;
- my @ids=&Apache::lonnet::current_machine_ids();
- foreach my $id (@ids) { if ($id eq $home) { $allowed=1; } }
- if (!$allowed) {
- $button=0;
- $switchserver='otherserver='.$home.'&role='.$trolecode;
- }
- #next if ($home eq 'no_host');
- $home = &Apache::lonnet::hostname($home);
- $ttype='Construction Space';
- $twhere=&mt('Domain').': '.$tdom.'<br />'.&mt('Server').
- ': '.$home;
- $env{'course.'.$tdom.'_'.$trest.'.description'}='ca';
- $tremark.=&Apache::lonhtmlcommon::authorbombs('/res/'.$tdom.'/'.$env{'user.name'}.'/');
- $sortkey=$role;
- } elsif ($trest) {
- my $tcourseid=$tdom.'_'.$trest;
- $ttype = &Apache::loncommon::course_type($tcourseid);
- $trole = &Apache::lonnet::plaintext($role,$ttype);
- if ($env{'course.'.$tcourseid.'.description'}) {
- $twhere=$env{'course.'.$tcourseid.'.description'};
- $sortkey=$role."\0".$tdom."\0".$twhere."\0".$envkey;
- unless ($twhere eq &mt('Currently not available')) {
- $twhere.=' <span class="LC_fontsize_small">'.
- &Apache::loncommon::syllabuswrapper(&mt('Syllabus'),$trest,$tdom).
- '</span>';
- }
- } else {
- my %newhash=&Apache::lonnet::coursedescription($tcourseid);
- if (%newhash) {
- $sortkey=$role."\0".$tdom."\0".$newhash{'description'}.
- "\0".$envkey;
- $twhere=$newhash{'description'}.
- ' <span class="LC_fontsize_small">'.
- &Apache::loncommon::syllabuswrapper(&mt('Syllabus'),$trest,$tdom).
- '</span>';
- $ttype = $newhash{'type'};
- $trole = &Apache::lonnet::plaintext($role,$ttype);
- } else {
- $twhere=&mt('Currently not available');
- $env{'course.'.$tcourseid.'.description'}=$twhere;
- $sortkey=$role."\0".$tdom."\0".$twhere."\0".$envkey;
- $ttype = 'Unavailable';
- }
- }
- if ($tsection) {
- $twhere.='<br />'.&mt('Section').': '.$tsection;
- }
- if ($role ne 'st') { $twhere.="<br />".&mt('Domain').":".$tdom; }
- } elsif ($tdom) {
- $ttype='Domain';
- $twhere=$tdom;
- $sortkey=$role.$twhere;
- } else {
- $ttype='System';
- $twhere=&mt('system wide');
- $sortkey=$role.$twhere;
- }
- ($roletext,$roletext_end) =
- &build_roletext($trolecode,$tdom,$trest,$tstatus,$tryagain,
- $advanced,$tremark,$tbg,$trole,$twhere,$tpstart,
- $tpend,$nochoose,$button,$switchserver,$reinit);
- $roletext{$envkey}=[$roletext,$roletext_end];
- if (!$sortkey) {$sortkey=$twhere."\0".$envkey;}
- $sortrole{$sortkey}=$envkey;
- $roleclass{$envkey}=$ttype;
- }
- }
- }
+
+ my (%roletext,%sortrole,%roleclass,%futureroles,%timezones);
+ my ($countactive,$countfuture,$inrole,$possiblerole) =
+ &gather_roles($then,$refresh,$now,$reinit,$nochoose,\%roletext,\%sortrole,\%roleclass,
+ \%futureroles,\%timezones);
+
+ $refresh = $now;
+ &Apache::lonnet::appenv({'user.refresh.time' => $refresh});
if ($env{'user.adv'}) {
$r->print(
'<p><label>'.&mt('Show all roles').': <input type="checkbox" name="showall"');
@@ -988,6 +833,165 @@
return OK;
}
+sub gather_roles {
+ my ($then,$refresh,$now,$reinit,$nochoose,$roletext,$sortrole,$roleclass,$futureroles,$timezones) = @_;
+ my ($countactive,$countfuture,$inrole,$possiblerole) = (0,0,0,'');
+ my $advanced = $env{'user.adv'};
+ my $tryagain = $env{'form.tryagain'};
+ foreach my $envkey (sort(keys(%env))) {
+ my $button = 1;
+ my $switchserver='';
+ my ($role_text,$role_text_end,$sortkey);
+ if ($envkey=~/^user\.role\./) {
+ my ($role,$where,$trolecode,$tstart,$tend,$tremark,$tstatus,$tpstart,$tpend);
+ &Apache::lonnet::role_status($envkey,$then,$refresh,$now,\$role,\$where,
+ \$trolecode,\$tstatus,\$tstart,\$tend);
+ next if (!defined($role) || $role eq '' || $role =~ /^gr/);
+ my $timezone = &role_timezone($where,$timezones);
+ $tremark='';
+ $tpstart=' ';
+ $tpend=' ';
+ if ($tstart) {
+ $tpstart=&Apache::lonlocal::locallocaltime($tstart,$timezone);
+ }
+ if ($tend) {
+ $tpend=&Apache::lonlocal::locallocaltime($tend,$timezone);
+ }
+ if ($env{'request.role'} eq $trolecode) {
+ $tstatus='selected';
+ }
+ my $tbg;
+ if (($tstatus eq 'is')
+ || ($tstatus eq 'selected')
+ || ($tstatus eq 'future')
+ || ($env{'form.showall'})) {
+ if ($tstatus eq 'is') {
+ $tbg='LC_roles_is';
+ $possiblerole=$trolecode;
+ $countactive++;
+ } elsif ($tstatus eq 'future') {
+ $tbg='LC_roles_future';
+ $button=0;
+ $futureroles->{$trolecode} = $tstart.':'.$tend;
+ $countfuture ++;
+ } elsif ($tstatus eq 'expired') {
+ $tbg='LC_roles_expired';
+ $button=0;
+ } elsif ($tstatus eq 'will_not') {
+ $tbg='LC_roles_will_not';
+ $tremark.=&mt('Expired after logout.').' ';
+ } elsif ($tstatus eq 'selected') {
+ $tbg='LC_roles_selected';
+ $inrole=1;
+ $countactive++;
+ $tremark.=&mt('Currently selected.').' ';
+ }
+ my $trole;
+ if ($role =~ /^cr\//) {
+ my ($rdummy,$rdomain,$rauthor,$rrole)=split(/\//,$role);
+ if ($tremark) { $tremark.='<br />'; }
+ $tremark.=&mt('Defined by [_1] at [_2].',$rauthor,$rdomain);
+ }
+ $trole=Apache::lonnet::plaintext($role);
+ my $ttype;
+ my $twhere;
+ my ($tdom,$trest,$tsection)=
+ split(/\//,Apache::lonnet::declutter($where));
+ # First, Co-Authorship roles
+ if (($role eq 'ca') || ($role eq 'aa')) {
+ my $home = &Apache::lonnet::homeserver($trest,$tdom);
+ my $allowed=0;
+ my @ids=&Apache::lonnet::current_machine_ids();
+ foreach my $id (@ids) { if ($id eq $home) { $allowed=1; } }
+ if (!$allowed) {
+ $button=0;
+ $switchserver='otherserver='.$home.'&role='.$trolecode;
+ }
+ #next if ($home eq 'no_host');
+ $home = &Apache::lonnet::hostname($home);
+ $ttype='Construction Space';
+ $twhere=&mt('User').': '.$trest.'<br />'.&mt('Domain').
+ ': '.$tdom.'<br />'.
+ ' '.&mt('Server').': '.$home;
+ $env{'course.'.$tdom.'_'.$trest.'.description'}='ca';
+ $tremark.=&Apache::lonhtmlcommon::authorbombs('/res/'.$tdom.'/'.$trest.'/');
+ $sortkey=$role."$trest:$tdom";
+ } elsif ($role eq 'au') {
+ # Authors
+ my $home = &Apache::lonnet::homeserver
+ ($env{'user.name'},$env{'user.domain'});
+ my $allowed=0;
+ my @ids=&Apache::lonnet::current_machine_ids();
+ foreach my $id (@ids) { if ($id eq $home) { $allowed=1; } }
+ if (!$allowed) {
+ $button=0;
+ $switchserver='otherserver='.$home.'&role='.$trolecode;
+ }
+ #next if ($home eq 'no_host');
+ $home = &Apache::lonnet::hostname($home);
+ $ttype='Construction Space';
+ $twhere=&mt('Domain').': '.$tdom.'<br />'.&mt('Server').
+ ': '.$home;
+ $env{'course.'.$tdom.'_'.$trest.'.description'}='ca';
+ $tremark.=&Apache::lonhtmlcommon::authorbombs('/res/'.$tdom.'/'.$env{'user.name'}.'/');
+ $sortkey=$role;
+ } elsif ($trest) {
+ my $tcourseid=$tdom.'_'.$trest;
+ $ttype = &Apache::loncommon::course_type($tcourseid);
+ $trole = &Apache::lonnet::plaintext($role,$ttype);
+ if ($env{'course.'.$tcourseid.'.description'}) {
+ $twhere=$env{'course.'.$tcourseid.'.description'};
+ $sortkey=$role."\0".$tdom."\0".$twhere."\0".$envkey;
+ unless ($twhere eq &mt('Currently not available')) {
+ $twhere.=' <span class="LC_fontsize_small">'.
+ &Apache::loncommon::syllabuswrapper(&mt('Syllabus'),$trest,$tdom).
+ '</span>';
+ }
+ } else {
+ my %newhash=&Apache::lonnet::coursedescription($tcourseid);
+ if (%newhash) {
+ $sortkey=$role."\0".$tdom."\0".$newhash{'description'}.
+ "\0".$envkey;
+ $twhere=$newhash{'description'}.
+ ' <span class="LC_fontsize_small">'.
+ &Apache::loncommon::syllabuswrapper(&mt('Syllabus'),$trest,$tdom).
+ '</span>';
+ $ttype = $newhash{'type'};
+ $trole = &Apache::lonnet::plaintext($role,$ttype);
+ } else {
+ $twhere=&mt('Currently not available');
+ $env{'course.'.$tcourseid.'.description'}=$twhere;
+ $sortkey=$role."\0".$tdom."\0".$twhere."\0".$envkey;
+ $ttype = 'Unavailable';
+ }
+ }
+ if ($tsection) {
+ $twhere.='<br />'.&mt('Section').': '.$tsection;
+ }
+ if ($role ne 'st') { $twhere.="<br />".&mt('Domain').":".$tdom; }
+ } elsif ($tdom) {
+ $ttype='Domain';
+ $twhere=$tdom;
+ $sortkey=$role.$twhere;
+ } else {
+ $ttype='System';
+ $twhere=&mt('system wide');
+ $sortkey=$role.$twhere;
+ }
+ ($role_text,$role_text_end) =
+ &build_roletext($trolecode,$tdom,$trest,$tstatus,$tryagain,
+ $advanced,$tremark,$tbg,$trole,$twhere,$tpstart,
+ $tpend,$nochoose,$button,$switchserver,$reinit);
+ $roletext->{$envkey}=[$role_text,$role_text_end];
+ if (!$sortkey) {$sortkey=$twhere."\0".$envkey;}
+ $sortrole->{$sortkey}=$envkey;
+ $roleclass->{$envkey}=$ttype;
+ }
+ }
+ }
+ return ($countactive,$countfuture,$inrole,$possiblerole);
+}
+
sub role_timezone {
my ($where,$timezones) = @_;
my $timezone;
Index: loncom/lonnet/perl/lonnet.pm
diff -u loncom/lonnet/perl/lonnet.pm:1.1001 loncom/lonnet/perl/lonnet.pm:1.1002
--- loncom/lonnet/perl/lonnet.pm:1.1001 Sat May 16 01:19:36 2009
+++ loncom/lonnet/perl/lonnet.pm Thu Jun 11 19:02:32 2009
@@ -1,7 +1,7 @@
# The LearningOnline Network
# TCP networking package
#
-# $Id: lonnet.pm,v 1.1001 2009/05/16 01:19:36 raeburn Exp $
+# $Id: lonnet.pm,v 1.1002 2009/06/11 19:02:32 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -3930,7 +3930,7 @@
}
sub role_status {
- my ($rolekey,$then,$now,$role,$where,$trolecode,$tstatus,$tstart,$tend) = @_;
+ my ($rolekey,$then,$refresh,$now,$role,$where,$trolecode,$tstatus,$tstart,$tend) = @_;
my @pwhere = ();
if (exists($env{$rolekey}) && $env{$rolekey} ne '') {
(undef,undef,$$role,@pwhere)=split(/\./,$rolekey);
@@ -3941,7 +3941,41 @@
$$tstatus='is';
if ($$tstart && $$tstart>$then) {
$$tstatus='future';
- if ($$tstart<$now) { $$tstatus='will'; }
+ if ($$tstart && $$tstart>$refresh) {
+ if ($$tstart<$now) {
+ if (($$where ne '') && ($$role ne '')) {
+ my (%allroles,%allgroups,$group_privs);
+ my %userroles = (
+ 'user.role.'.$$role.'.'.$$where => $$tstart.'.'.$$tend
+ );
+ my $spec=$$role.'.'.$$where;
+ my ($tdummy,$tdomain,$trest)=split(/\//,$$where);
+ if ($$role eq 'gr') {
+ my %rolehash = &get('roles',[$$where.'_'.$$role],$env{'user.domain'},
+ $env{'user.name'})=@_;
+ my ($trole) = split('_',$role,1);
+ (undef,my $group_privs) = split(/\//,$trole);
+ $group_privs = &unescape($group_privs);
+ }
+ if ($$role =~ /^cr\//) {
+ &custom_roleprivs(\%allroles,$$role,$tdomain,$trest,$spec,$$where);
+ } elsif ($$role eq 'gr') {
+ my %rolehash = &get('roles',[$$where.'_'.$$role],$env{'user.domain'},
+ $env{'user.name'});
+ my $trole = split('_',$rolehash{$$where.'_'.$$role},1);
+ (undef,my $group_privs) = split(/\//,$trole);
+ $group_privs = &unescape($group_privs);
+ &group_roleprivs(\%allgroups,$$where,$group_privs,$$tend,$$tstart);
+ } else {
+ &standard_roleprivs(\%allroles,$$role,$tdomain,$spec,$trest,$$where);
+ }
+ my ($author,$adv)= &set_userprivs(\%userroles,\%allroles,\%allgroups);
+ &appenv(\%userroles,[$$role,'cm']);
+ &log($env{'user.domain'},$env{'user.name'},$env{'user.home'},"Role ".$role);
+ $$tstatus = 'is';
+ }
+ }
+ }
}
if ($$tend) {
if ($$tend<$then) {
@@ -3955,11 +3989,11 @@
}
sub check_adhoc_privs {
- my ($cdom,$cnum,$then,$now,$checkrole) = @_;
+ my ($cdom,$cnum,$then,$refresh,$now,$checkrole) = @_;
my $cckey = 'user.role.'.$checkrole.'./'.$cdom.'/'.$cnum;
if ($env{$cckey}) {
my ($role,$where,$trolecode,$tstart,$tend,$tremark,$tstatus,$tpstart,$tpend);
- &role_status($cckey,$then,$now,\$role,\$where,\$trolecode,\$tstatus,\$tstart,\$tend);
+ &role_status($cckey,$then,$refresh,$now,\$role,\$where,\$trolecode,\$tstatus,\$tstart,\$tend);
unless (($tstatus eq 'is') || ($tstatus eq 'will_not')) {
&set_adhoc_privileges($cdom,$cnum,$checkrole);
}
--raeburn1244746952--