--- loncom/interface/longroup.pm 2006/05/18 13:49:10 1.2
+++ loncom/interface/longroup.pm 2023/06/20 14:03:52 1.32
@@ -1,6 +1,8 @@
# The LearningOnline Network with CAPA
# accessor routines used to provide information about course groups
#
+# $Id: longroup.pm,v 1.32 2023/06/20 14:03:52 raeburn Exp $
+#
# Copyright Michigan State University Board of Trustees
#
# This file is part of the LearningOnline Network with CAPA (LON-CAPA).
@@ -23,11 +25,13 @@
#
# http://www.lon-capa.org/
#
-
+
package Apache::longroup;
-
+
use strict;
use Apache::lonnet;
+use Apache::lonlocal;
+use LONCAPA;
###############################################
=pod
@@ -40,14 +44,17 @@ Input:
1. Optional course domain
2. Optional course number
3. Optional group name
+4. Optional namespace
Course domain and number will be taken from user's
environment if not supplied. Optional group name will
-be passed to lonnet::get_coursegroups() as a regexp to
-use in the call to the dump function.
-
+be passed to lonnet function as a regexp to
+use in the call to the dump function. Optional namespace
+will determine whether information is retrieved about current
+groups (default) or deleted groups (namespace = deleted_groups).
+
Output
-Returns hash of groups in the course (subject to the
+Returns hash of groups in a course (subject to the
optional group name filter). In the hash, the keys are
group names, and their corresponding values
are scalars containing group information in XML. This
@@ -55,12 +62,13 @@ can be sent to &get_group_settings() to
Side effects:
None.
+
=cut
###############################################
sub coursegroups {
- my ($cdom,$cnum,$group) = @_;
+ my ($cdom,$cnum,$group,$namespace) = @_;
if (!defined($cdom) || !defined($cnum)) {
my $cid = $env{'request.course.id'};
@@ -69,44 +77,50 @@ sub coursegroups {
$cdom = $env{'course.'.$cid.'.domain'};
$cnum = $env{'course.'.$cid.'.num'};
}
- my %curr_groups = &Apache::lonnet::get_coursegroups($cdom,$cnum,$group);
- my ($tmp) = keys(%curr_groups);
- if ($tmp=~/^(con_lost|no_such_host|error: [^2] )/) {
- undef(%curr_groups);
- &logthis('Error retrieving groups: '.$tmp.' in '.$cnum.':'.$cdom);
- } elsif ($tmp=~/^error: 2 /) {
- undef(%curr_groups);
+ if (!defined($namespace)) {
+ $namespace = 'coursegroups';
+ }
+ my %groups = &Apache::lonnet::get_coursegroups($cdom,$cnum,$group,
+ $namespace);
+ if (my $tmp = &Apache::lonnet::error(%groups)) {
+ undef(%groups);
+ &Apache::lonnet::logthis('Error retrieving groups: '.$tmp.' in '.$cnum.':'.$cdom.' - '.$namespace);
}
- return %curr_groups;
+ if (defined($groups{'group_allfolders'."\0".'locked_folder'})) {
+ delete($groups{'group_allfolders'."\0".'locked_folder'});
+ }
+ return %groups;
}
###############################################
+=pod
+
=item get_group_settings
-
+
Uses TokeParser to extract group information from the
XML used to describe course groups.
-
+
Input:
Scalar containing XML - as retrieved from &coursegroups().
-
+
Output:
Hash containing group information as key=values for (a), and
hash of hashes for (b)
-
+
Keys (in two categories):
-(a) groupname, creator, creation, modified, startdate,enddate.
+(a) groupname, creator, creation, modified, startdate, enddate, quota.
Corresponding values are name of the group, creator of the group
(username:domain), UNIX time for date group was created, and
-settings were last modified, and default start and end access
-times for group members.
-
+settings were last modified, file quota, and default start and end
+access times for group members.
+
(b) functions returned in hash of hashes.
Outer hash key is functions.
Inner hash keys are chat,discussion,email,files,homepage,roster.
Corresponding values are either on or off, depending on
whether this type of functionality is available for the group.
-
+
=cut
###############################################
@@ -155,7 +169,6 @@ sub get_group_settings {
} elsif ($token->[1] eq 'role') {
$role = '';
}
-
}
}
return %content;
@@ -176,13 +189,13 @@ sub check_group_access {
###############################################
=pod
-
+
=item group_changes
Add or drop group memberships in a course as a result of
changes in a user's roles/sections. Called by
&Apache::lonnet:assignrole()
-
+
Input:
1. User's domain
2. User's username
@@ -190,6 +203,8 @@ Input:
4. Role
5. End date of role
6. Start date of role
+7. Selfenroll
+8. Context
Checks to see if role for which assignment is being made is in a course.
If so, gathers information about auto-group population settings for
@@ -203,9 +218,13 @@ for the course is included amongst the u
and would trigger membership in teh same group(s)
If role is being added, will add any group memberships specified
-for auto-group population, unless use is already a group member.
+for auto-group population, unless user is already a group member.
Uses default group privileges and default start and end group access
-times.
+times.
+
+Flag for selfenroll (value of 1), and context (auto, updatenow,
+automated, course, domain etc.) can be used to log the reason for
+the role change.
Output
None
@@ -218,7 +237,8 @@ or expire group membership(s) for a user
=cut
sub group_changes {
- my ($udom,$uname,$url,$role,$origend,$origstart) = @_;
+ my ($udom,$uname,$url,$role,$origend,$origstart,$selfenroll,$context,
+ $othdomby,$requester) = @_;
my $now = time;
my $chgtype;
if ($origend > 0 && $origend <= $now) {
@@ -233,9 +253,6 @@ sub group_changes {
} else {
$cid = $url;
}
- my $courseid = $cid;
- $courseid =~ s|^/||;
- $courseid =~ s|/|_|;
my %crshash=&Apache::lonnet::coursedescription($cid);
$cdom = $crshash{'domain'};
$cnum = $crshash{'num'};
@@ -273,11 +290,7 @@ sub group_changes {
if (@changegroups > 0) {
my %currpriv;
my %roleshash = &Apache::lonnet::dump('roles',$udom,$uname,$cid);
- my ($tmp) = keys(%roleshash);
- if ($tmp=~/^error:/) {
- &Apache::lonnet::logthis('Error retrieving roles: '.$tmp.
- ' for '.$uname.':'.$udom);
- } else {
+ if (keys(%roleshash) > 0) {
my $group_privs = '';
foreach my $group (@changegroups) {
if ($chgtype eq 'add') {
@@ -331,7 +344,8 @@ sub group_changes {
$add,$uname.':'.$udom,
$settings{$add}{'enddate'},
$settings{$add}{'startdate'},
- $group_privs) eq 'ok') {
+ $group_privs,$selfenroll,$context,
+ $othdomby,$requester) eq 'ok') {
my %usersettings;
$usersettings{$add.':'.$uname.':'.$udom} =
$addgroup{$add};
@@ -400,7 +414,9 @@ sub group_changes {
$cnum,$drop,
$uname.':'.$udom,$now,
$dropstart{$drop},
- $currpriv{$drop})
+ $currpriv{$drop},
+ $selfenroll,$context,
+ $othdomby,$requester)
eq 'ok') {
my %usersettings;
$usersettings{$drop.':'.$uname.':'.$udom} =
@@ -420,5 +436,380 @@ sub group_changes {
###############################################
+sub get_fixed_privs {
+ my $fixedprivs = {
+ email => {sgm => 1},
+ discussion => {vgb => 1},
+ chat => {pgc => 1},
+ files => {rgf => 1},
+ roster => {vgm => 1},
+ homepage => {vgh => 1},
+ };
+ return $fixedprivs;
+}
+
+###############################################
+
+sub get_tool_privs {
+ my ($gpterm) = @_;
+ my $toolprivs = {
+ email => {
+ sgm => 'Send '.$gpterm.' message',
+ sgb => 'Broadcast message',
+ },
+ discussion => {
+ cgb => 'Create boards',
+ pgd => 'Post',
+ egp => 'Edit own posts',
+ dgp => 'Hide/Delete any post',
+ vgb => 'View boards',
+ },
+ chat => {
+ pgc => 'Chat Room',
+ },
+ files => {
+ rgf => 'Retrieve',
+ ugf => 'Upload',
+ mgf => 'Modify',
+ dgf => 'Delete',
+ agf => 'Control Access',
+ },
+ roster => {
+ vgm => 'Basic Display',
+ vmd => 'Detailed Display',
+ },
+ homepage => {
+ vgh => 'View page',
+ mgh => 'Modify page',
+ },
+ };
+ return $toolprivs;
+}
+
+###############################################
+
+
+sub group_memberlist {
+ my ($cdom,$cnum,$groupname,$fixedprivs,$available) = @_;
+ my %membership = &Apache::lonnet::get_group_membership($cdom,$cnum,
+ $groupname);
+ my %current = ();
+ my $hastools = 0;
+ my $addtools = 0;
+ my %member_nums = (
+ 'previous' => 0,
+ 'future' => 0,
+ 'active' => 0,
+ );
+ my $now = time;
+ if (keys(%membership) > 0) {
+ my %allnames = ();
+ foreach my $key (sort(keys(%membership))) {
+ if ($key =~ /^\Q$groupname\E:([^:]+):([^:]+)$/) {
+ my $uname = $1;
+ my $udom = $2;
+ my $user = $uname.':'.$udom;
+ my($end,$start,@userprivs) = split(/:/,$membership{$key});
+ unless ($start == -1) {
+ $allnames{$udom}{$uname} = 1;
+ $current{$user} = {
+ uname => $uname,
+ udom => $udom,
+ start => &Apache::lonlocal::locallocaltime($start),
+ currtools => [],
+ newtools => [],
+ privs => \@userprivs,
+ };
+
+ if ($end == 0) {
+ $current{$user}{end} = 'No end date';
+ } else {
+ $current{$user}{end} =
+ &Apache::lonlocal::locallocaltime($end);
+ }
+ my $now = time;
+ if (($end > 0) && ($end < $now)) {
+ $current{$user}{changestate} = 'reenable';
+ $current{$user}{'status'} = 'previous';
+ $member_nums{'previous'} ++;
+ } elsif (($start > $now)) {
+ $current{$user}{changestate} = 'activate';
+ $current{$user}{'status'} = 'future';
+ $member_nums{'future'} ++;
+ } else {
+ $current{$user}{changestate} = 'expire';
+ $current{$user}{'status'} = 'active';
+ $member_nums{'active'} ++;
+ }
+ if ((@userprivs > 0) && (ref($fixedprivs) eq 'HASH')) {
+ foreach my $tool (sort(keys(%{$fixedprivs}))) {
+ foreach my $priv (keys(%{$$fixedprivs{$tool}})) {
+ if (grep/^$priv$/,@userprivs) {
+ push(@{$current{$user}{currtools}},$tool);
+ last;
+ }
+ }
+ }
+ $hastools = 1;
+ }
+ if ((ref($available) eq 'ARRAY') && (@{$available} > 0)) {
+ if (@{$current{$user}{currtools}} > 0) {
+ if ("@{$available}" ne "@{$current{$user}{currtools}}") {
+ foreach my $tool (@{$available}) {
+ unless (grep/^$tool$/,@{$current{$user}{currtools}}) {
+ push(@{$current{$user}{newtools}},$tool); }
+ }
+ }
+ } else {
+ @{$current{$user}{newtools}} = @{$available};
+
+ }
+ if (@{$current{$user}{newtools}} > 0) {
+ $addtools = 1;
+ }
+ }
+ }
+ }
+ }
+ if (keys(%current) > 0) {
+ my %idhash;
+ foreach my $udom (keys(%allnames)) {
+ %{$idhash{$udom}} = &Apache::lonnet::idrget($udom,
+ keys(%{$allnames{$udom}}));
+ foreach my $uname (keys(%{$idhash{$udom}})) {
+ $current{$uname.':'.$udom}{'id'} = $idhash{$udom}{$uname};
+ }
+ foreach my $uname (keys(%{$allnames{$udom}})) {
+ $current{$uname.':'.$udom}{'fullname'} =
+ &Apache::loncommon::plainname($uname,$udom,
+ 'lastname');
+ }
+ }
+ }
+ }
+ return (\%current,\%member_nums,$hastools,$addtools);
+}
+
+###############################################
+
+sub sum_quotas {
+ my ($courseid) = @_;
+ my $totalquotas = 0;
+ my ($cdom,$cnum);
+ if (!defined($courseid)) {
+ if (defined($env{'request.course.id'})) {
+ $courseid = $env{'request.course.id'};
+ $cdom = $env{'course.'.$courseid.'.domain'};
+ $cnum = $env{'course.'.$courseid.'.num'};
+ } else {
+ return '';
+ }
+ } else {
+ ($cdom,$cnum) = split(/_/,$courseid);
+ }
+ if ($cdom && $cnum) {
+ my %curr_groups = &coursegroups($cdom,$cnum);
+ if (%curr_groups) {
+ foreach my $group (keys(%curr_groups)) {
+ my %settings=&get_group_settings($curr_groups{$group});
+ my $quota = $settings{'quota'};
+ if ($quota eq '') {
+ $quota = 0;
+ }
+ $totalquotas += $quota;
+ }
+ } else {
+ return 0;
+ }
+ } else {
+ return '';
+ }
+ return $totalquotas;
+}
+
+###############################################
+
+sub get_bbfolder_url {
+ my ($cdom,$cnum,$group) = @_;
+ my %curr_groups = &coursegroups($cdom,$cnum,$group);
+ my $grpbbmap;
+ if (%curr_groups) {
+ my $crspath = '/uploaded/'.$cdom.'/'.$cnum.'/';
+ $grpbbmap = $crspath.'group_boards_'.$group.'.sequence';
+ }
+ return $grpbbmap;
+}
+
+###############################################
+
+sub get_group_bbinfo {
+ my ($cdom,$cnum,$group,$boardurl) = @_;
+ my @groupboards = ();
+ my %boardshash = ();
+ my $navmap = Apache::lonnavmaps::navmap->new();
+ if (defined($navmap)) {
+ my $grpbbmap = &get_bbfolder_url($cdom,$cnum,$group);
+ if ($grpbbmap) {
+ my $bbfolderres = $navmap->getResourceByUrl($grpbbmap);
+ if ($bbfolderres) {
+ my @boards = $navmap->retrieveResources($bbfolderres,undef,0,0);
+ foreach my $res (@boards) {
+ my $url = $res->src();
+ if ($url =~ m|^(/adm/\Q$cdom\E/\Q$cnum\E/\d+/bulletinboard)|) {
+ if ($boardurl) {
+ if ($boardurl =~ /^\Q$1\E/) {
+ push(@groupboards,$res->symb());
+ $boardshash{$res->symb()} = {
+ title => $res->title(),
+ url => $res->src(),
+ };
+ last;
+ }
+ } else {
+ push(@groupboards,$res->symb());
+ $boardshash{$res->symb()} = {
+ title => $res->title(),
+ url => $res->src(),
+ };
+ }
+ }
+ }
+ }
+ }
+ undef($navmap);
+ } else {
+ &Apache::lonnet::logthis('Retrieval of group boards failed - could not create navmap object for group: '.$group.' in course: '.$cdom.':'.$cnum);
+ }
+ return (\@groupboards,\%boardshash);
+}
+
+###############################################
+
+sub get_group_link {
+ my ($cdom,$cnum,$group,$navmap,$view_permission,$refarg) = @_;
+ if (ref($navmap)) {
+ my $map = "uploaded/$cdom/$cnum/group_folder_"."$group.sequence";
+ my $mapres = $navmap->getResourceByUrl("/$map");
+ my $hidden;
+ if (ref($mapres)) {
+ if ((!$view_permission) && ($mapres->randomout())) {
+ $hidden = 1;
+ }
+ }
+ my $url = "adm/$cdom/$cnum/$group/smppg";
+ my $idx = '1';
+ my $symb = $map.'___'.$idx.'___'.$url;
+ my $res = $navmap->getBySymb($symb);
+ $url = "/$url";
+ $map = "/$map";
+ my $link;
+ if (ref($res)) {
+ if ((!$view_permission) && ($res->randomout())) {
+ $hidden = 1;
+ } else {
+ $hidden = 0;
+ if ($refarg) {
+ $link = $url.'?'.$refarg;
+ } else {
+ $link = $res->link();
+ $link .= (($link=~/\?/)?'&':'?').'symb='.$res->shown_symb();
+ }
+ }
+ } elsif (&Apache::lonnet::is_on_map($url)) {
+ unless ($hidden) {
+ $link = $url;
+ if ($refarg) {
+ $link = $url.'?'.$refarg;
+ }
+ }
+ }
+ if (wantarray) {
+ return ($link,$hidden);
+ } else {
+ return $link;
+ }
+ }
+ return;
+}
+
+###############################################
+
+sub display_group_links {
+ my ($r,$target,$group,$context,$refarg,$numtoolsref,$hidehdr,%groupinfo) = @_;
+ my @available = ();
+ my %menu = ();
+ %{$menu{'email'}} = (
+ text => 'Group Message',
+ href => '/adm/email?compose=group&group='.$group.
+ $refarg,
+ );
+ %{$menu{'discussion'}} = (
+ text => 'Discussion Boards',
+ href => '/adm/groupboards?group='.$group.$refarg,
+ );
+ %{$menu{'chat'}} = (
+ text => 'Group Chat Room',
+ href => "javascript:group_chat('$group')",
+ );
+ %{$menu{'files'}} = (
+ text => 'Group Portfolio',
+ href => '/adm/coursegrp_portfolio?group='.$group.
+ $refarg,
+ );
+ %{$menu{'roster'}} = (
+ text => 'Membership Roster',
+ href => '/adm/grouproster?group='.$group.$refarg,
+ );
+ foreach my $tool (sort(keys(%menu))) {
+ if ($groupinfo{functions}{$tool} eq 'on') {
+ push(@available,$tool);
+ }
+ }
+ my $output = '';
+ if (ref($numtoolsref) eq 'SCALAR') {
+ $$numtoolsref = scalar(@available);
+ }
+ if (@available > 0) {
+ if ($target eq 'tex') {
+ $output = '';
+ } else {
+ $output = &Apache::loncommon::start_data_table();
+ }
+ foreach my $tool (@available) {
+ if ($target eq 'tex') {
+ $output .= '| '.&mt($menu{$tool}{text}).' |
';
+ } else {
+ $output .= &Apache::loncommon::start_data_table_row()
+ .''
+ .&mt($menu{$tool}{text}).' | '
+ .&Apache::loncommon::end_data_table_row();
+ }
+ }
+ if ($target eq 'tex') {
+ $output .= '
';
+ } else {
+ $output .= &Apache::loncommon::end_data_table();
+ }
+ if ($target eq 'tex') {
+ $output = &Apache::lonxml::xmlparse($r,'tex',&mt('Available functions').'
'.$output);
+ } else {
+ unless ($hidehdr) {
+ $output = ''.&mt('Available Group Tools').'
'.$output;
+ }
+ }
+ } else {
+ if ($context eq 'edit') {
+ $output = &mt('No group functionality.');
+ } else {
+ $output = &mt('No group functionality (e.g., e-mail, discussion, chat room or file upload) is currently available to you in this group: [_1].',
+ ''.&unescape($groupinfo{'description'}).'');
+ }
+ if ($target eq 'tex') {
+ $output = &Apache::lonxml::xmlparse($r,'tex',$output);
+ }
+ }
+ return $output;
+}
+
1;