--- loncom/lonnet/perl/lonnet.pm 2017/01/02 19:44:20 1.1332
+++ loncom/lonnet/perl/lonnet.pm 2017/01/28 23:26:51 1.1336
@@ -1,7 +1,7 @@
# The LearningOnline Network
# TCP networking package
#
-# $Id: lonnet.pm,v 1.1332 2017/01/02 19:44:20 raeburn Exp $
+# $Id: lonnet.pm,v 1.1336 2017/01/28 23:26:51 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -4116,7 +4116,7 @@ sub flushcourselogs {
}
}
#
-# Reverse lookup of domain roles (dc, ad, li, sc, dh, au)
+# Reverse lookup of domain roles (dc, ad, li, sc, dh, da, au)
#
my %domrolebuffer = ();
foreach my $entry (keys(%domainrolehash)) {
@@ -4263,7 +4263,7 @@ sub userrolelog {
{$trole.':'.$username.':'.$domain.':'.$env{'user.name'}.':'.$env{'user.domain'}.':'}
=$tend.':'.$tstart;
}
- if ($trole =~ /^(dc|ad|li|au|dg|sc|dh)/ ) {
+ if ($trole =~ /^(dc|ad|li|au|dg|sc|dh|da)/ ) {
my (undef,$rudom,$runame,$rsec)=split(/\//,$area);
$domainrolehash
{$trole.':'.$username.':'.$domain.':'.$runame.':'.$rudom.':'.$rsec}
@@ -4490,53 +4490,91 @@ sub get_my_roles {
return %returnhash;
}
+sub get_all_adhocroles {
+ my ($dom) = @_;
+ my @roles_by_num = ();
+ my %domdefaults = &get_domain_defaults($dom);
+ my (%description,%access_in_dom,%access_info);
+ if (ref($domdefaults{'adhocroles'}) eq 'HASH') {
+ my $count = 0;
+ my %domcurrent = %{$domdefaults{'adhocroles'}};
+ my %ordered;
+ foreach my $role (sort(keys(%domcurrent))) {
+ my ($order,$desc,$access_in_dom);
+ if (ref($domcurrent{$role}) eq 'HASH') {
+ $order = $domcurrent{$role}{'order'};
+ $desc = $domcurrent{$role}{'desc'};
+ $access_in_dom{$role} = $domcurrent{$role}{'access'};
+ $access_info{$role} = $domcurrent{$role}{$access_in_dom{$role}};
+ }
+ if ($order eq '') {
+ $order = $count;
+ }
+ $ordered{$order} = $role;
+ if ($desc ne '') {
+ $description{$role} = $desc;
+ } else {
+ $description{$role}= $role;
+ }
+ $count++;
+ }
+ foreach my $item (sort {$a <=> $b } (keys(%ordered))) {
+ push(@roles_by_num,$ordered{$item});
+ }
+ }
+ return (\@roles_by_num,\%description,\%access_in_dom,\%access_info);
+}
+
sub get_my_adhocroles {
- my ($cid) = @_;
- my (@possroles,%description);
- if ($cid =~ /^($match_domain)_($match_courseid)$/) {
- my $cdom = $1;
- my $cnum = $2;
- if ($env{"user.role.dh./$cdom/"}) {
+ my ($cid,$checkreg) = @_;
+ my ($cdom,$cnum,%info,@possroles,$description,$roles_by_num);
+ if ($env{'request.course.id'} eq $cid) {
+ $cdom = $env{'course.'.$cid.'.domain'};
+ $cnum = $env{'course.'.$cid.'.num'};
+ $info{'internal.coursecode'} = $env{'course.'.$cid.'.internal.coursecode'};
+ } elsif ($cid =~ /^($match_domain)_($match_courseid)$/) {
+ $cdom = $1;
+ $cnum = $2;
+ %info = &Apache::lonnet::get('environment',['internal.coursecode'],
+ $cdom,$cnum);
+ }
+ if (($info{'internal.coursecode'} ne '') && ($checkreg)) {
+ my $user = $env{'user.name'}.':'.$env{'user.domain'};
+ my %rosterhash = &get('classlist',[$user],$cdom,$cnum);
+ if ($rosterhash{$user} ne '') {
+ my $type = (split(/:/,$rosterhash{$user}))[5];
+ return ([],{}) if ($type eq 'auto');
+ }
+ }
+ if (($cdom ne '') && ($cnum ne '')) {
+ if (($env{"user.role.dh./$cdom/"}) || ($env{"user.role.da./$cdom/"})) {
my $then=$env{'user.login.time'};
my $update=$env{'user.update.time'};
- my $liverole = 1;
- my ($tstart,$tend)=split(/\./,$env{'user.role.dh./'.$cdom});
- my $limit = $update;
- if ($env{'request.role'} eq 'dh./'.$cdom.'/') {
- $limit = $then;
- }
- if ($tstart && $tstart>$limit) { $liverole = 0; }
- if ($tend && $tend <$limit) { $liverole = 0; }
- if ($liverole) {
+ if (!$update) {
+ $update = $then;
+ }
+ my @liveroles;
+ foreach my $role ('dh','da') {
+ if ($env{"user.role.$role./$cdom/"}) {
+ my ($tstart,$tend)=split(/\./,$env{"user.role.$role./$cdom/"});
+ my $limit = $update;
+ if ($env{'request.role'} eq "$role./$cdom/") {
+ $limit = $then;
+ }
+ my $activerole = 1;
+ if ($tstart && $tstart>$limit) { $activerole = 0; }
+ if ($tend && $tend <$limit) { $activerole = 0; }
+ if ($activerole) {
+ push(@liveroles,$role);
+ }
+ }
+ }
+ if (@liveroles) {
if (&homeserver($cnum,$cdom) ne 'no_host') {
- my %domdefaults = &get_domain_defaults($cdom);
- if (ref($domdefaults{'adhocroles'}) eq 'HASH') {
- my $count = 0;
- my %domcurrent = %{$domdefaults{'adhocroles'}};
- my (%ordered,%access_in_dom);
- foreach my $role (sort(keys(%domcurrent))) {
- my ($order,$desc,$access_in_dom);
- if (ref($domcurrent{$role}) eq 'HASH') {
- $order = $domcurrent{$role}{'order'};
- $desc = $domcurrent{$role}{'desc'};
- $access_in_dom{$role} = $domcurrent{$role}{'access'};
- }
- if ($order eq '') {
- $order = $count;
- }
- $ordered{$order} = $role;
- if ($desc ne '') {
- $description{$role} = $desc;
- } else {
- $description{$role}= $role;
- }
- $count++;
- }
- my @roles_by_num = ();
- foreach my $item (sort {$a <=> $b } (keys(%ordered))) {
- push(@roles_by_num,$ordered{$item});
- }
- if (@roles_by_num) {
+ my ($accessref,$accessinfo,%access_in_dom);
+ ($roles_by_num,$description,$accessref,$accessinfo) = &get_all_adhocroles($cdom);
+ if (ref($roles_by_num) eq 'ARRAY') {
+ if (@{$roles_by_num}) {
my %settings;
if ($env{'request.course.id'} eq $cid) {
foreach my $envkey (keys(%env)) {
@@ -4556,7 +4594,10 @@ sub get_my_adhocroles {
@statuses = split(/,/,$env{'environment.inststatus'});
}
my $user = $env{'user.name'}.':'.$env{'user.domain'};
- foreach my $role (@roles_by_num) {
+ if (ref($accessref) eq 'HASH') {
+ %access_in_dom = %{$accessref};
+ }
+ foreach my $role (@{$roles_by_num}) {
my ($curraccess,@okstatus,@personnel);
if ($setincrs{$role}) {
($curraccess,my $rest) = split(/=/,$settings{'internal.adhoc.'.$role});
@@ -4567,13 +4608,15 @@ sub get_my_adhocroles {
}
} else {
$curraccess = $access_in_dom{$role};
- if ($curraccess eq 'status') {
- if (ref($domcurrent{$role}{$curraccess}) eq 'ARRAY') {
- @okstatus = @{$domcurrent{$role}{$curraccess}};
- }
- } elsif (($curraccess eq 'exc') || ($curraccess eq 'inc')) {
- if (ref($domcurrent{$role}{$curraccess}) eq 'ARRAY') {
- @personnel = @{$domcurrent{$role}{$curraccess}};
+ if (ref($accessinfo) eq 'HASH') {
+ if ($curraccess eq 'status') {
+ if (ref($accessinfo->{$role}) eq 'ARRAY') {
+ @okstatus = @{$accessinfo->{$role}};
+ }
+ } elsif (($curraccess eq 'exc') || ($curraccess eq 'inc')) {
+ if (ref($accessinfo->{$role}) eq 'ARRAY') {
+ @personnel = @{$accessinfo->{$role}};
+ }
}
}
}
@@ -4581,6 +4624,18 @@ sub get_my_adhocroles {
next;
} elsif ($curraccess eq 'all') {
push(@possroles,$role);
+ } elsif ($curraccess eq 'dh') {
+ if (grep(/^dh$/,@liveroles)) {
+ push(@possroles,$role);
+ } else {
+ next;
+ }
+ } elsif ($curraccess eq 'da') {
+ if (grep(/^da$/,@liveroles)) {
+ push(@possroles,$role);
+ } else {
+ next;
+ }
} elsif ($curraccess eq 'status') {
if (@okstatus) {
if (!@statuses) {
@@ -4612,7 +4667,16 @@ sub get_my_adhocroles {
}
}
}
- return (\@possroles,\%description);
+ unless (ref($description) eq 'HASH') {
+ if (ref($roles_by_num) eq 'ARRAY') {
+ my %desc;
+ map { $desc{$_} = $_; } (@{$roles_by_num});
+ $description = \%desc;
+ } else {
+ $description = {};
+ }
+ }
+ return (\@possroles,$description);
}
# ----------------------------------------------------- Frontpage Announcements
@@ -9086,7 +9150,8 @@ sub assignrole {
&courserolelog($role,$uname,$udom,$url,$origstart,$origend,$delflag,
$selfenroll,$context);
} elsif (($role eq 'li') || ($role eq 'dg') || ($role eq 'sc') ||
- ($role eq 'au') || ($role eq 'dc') || ($role eq 'dh')) {
+ ($role eq 'au') || ($role eq 'dc') || ($role eq 'dh') ||
+ ($role eq 'da')) {
&domainrolelog($role,$uname,$udom,$url,$origstart,$origend,$delflag,
$context);
} elsif (($role eq 'ca') || ($role eq 'aa')) {