--- loncom/interface/longroup.pm 2006/06/26 22:20:57 1.5
+++ 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).
@@ -28,6 +30,8 @@ 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,16 +77,25 @@ sub coursegroups {
$cdom = $env{'course.'.$cid.'.domain'};
$cnum = $env{'course.'.$cid.'.num'};
}
- my %curr_groups = &Apache::lonnet::get_coursegroups($cdom,$cnum,$group);
- if (my $tmp = &Apache::lonnet::error(%curr_groups)) {
- undef(%curr_groups);
- &Apache::lonnet::logthis('Error retrieving groups: '.$tmp.' in '.$cnum.':'.$cdom);
+ 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);
+ }
+ if (defined($groups{'group_allfolders'."\0".'locked_folder'})) {
+ delete($groups{'group_allfolders'."\0".'locked_folder'});
}
- return %curr_groups;
+ return %groups;
}
###############################################
+=pod
+
=item get_group_settings
Uses TokeParser to extract group information from the
@@ -92,11 +109,11 @@ Hash containing group information as key
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.
@@ -186,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
@@ -199,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
@@ -214,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) {
@@ -229,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'};
@@ -269,10 +290,7 @@ sub group_changes {
if (@changegroups > 0) {
my %currpriv;
my %roleshash = &Apache::lonnet::dump('roles',$udom,$uname,$cid);
- if (my $tmp = &Apache::lonnet::error(%roleshash)) {
- &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') {
@@ -326,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};
@@ -395,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} =
@@ -415,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;