--- loncom/interface/longroup.pm 2006/05/18 12:33:14 1.1 +++ loncom/interface/longroup.pm 2006/07/17 15:07:26 1.10 @@ -23,9 +23,9 @@ # # http://www.lon-capa.org/ # - + package Apache::longroup; - + use strict; use Apache::lonnet; @@ -45,7 +45,7 @@ Course domain and number will be taken f 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. - + Output Returns hash of groups in the course (subject to the optional group name filter). In the hash, the keys are @@ -70,12 +70,9 @@ sub coursegroups { $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 (my $tmp = &Apache::lonnet::error(%curr_groups)) { + undef(%curr_groups); + &Apache::lonnet::logthis('Error retrieving groups: '.$tmp.' in '.$cnum.':'.$cdom); } return %curr_groups; } @@ -83,30 +80,30 @@ sub coursegroups { ############################################### =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 +152,6 @@ sub get_group_settings { } elsif ($token->[1] eq 'role') { $role = ''; } - } } return %content; @@ -176,13 +172,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 @@ -273,8 +269,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:/) { + if (my $tmp = &Apache::lonnet::error(%roleshash)) { &Apache::lonnet::logthis('Error retrieving roles: '.$tmp. ' for '.$uname.':'.$udom); } else { @@ -295,7 +290,7 @@ sub group_changes { if ($chgtype eq 'drop') { if ($grpstart == -1) { next; } # deleted if ($grpend == 0 || $grpend > $now) { - unless (defined($dropgroup{$group})) { + if (!defined($dropgroup{$group})) { $dropstart{$group} = $grpstart; if ($grpstart > $now) { $dropstart{$group} = $now; @@ -310,7 +305,7 @@ sub group_changes { ($grpend < $settings{$group}{'enddate'} || $settings{$group}{'enddate'} == 0)) || ($grpstart > $settings{$group}{'startdate'})) { - unless(defined($addgroup{$group})) { + if (!defined($addgroup{$group})) { $addgroup{$group} = $settings{$group}{'enddate'}.':'. $settings{$group}{'startdate'}.':'. @@ -356,7 +351,7 @@ sub group_changes { if ($usec eq 'all') { foreach my $ukey (keys(%roleshash)) { if ($ukey =~ /^\Q$cid\E(\/?\w*)_($urole)$/) { - unless ($sec eq $1) { + if ($sec ne $1) { if ($roleshash{$ukey} =~ /_?(\d*)_?([\-\d]*)$/) { my $roleend = $1; if ((!$roleend) || @@ -419,6 +414,251 @@ 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.' mail', + sgb => 'Broadcast mail', + }, + discussion => { + cgb => 'Create boards', + pgd => 'Post', + egp => 'Edit own posts', + dgp => 'Hide/Delete any post', + vgb => 'View boards', + }, + chat => { + pgc => 'Chat', + }, + 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 $navmap = Apache::lonnavmaps::navmap->new(); + my @groupboards; + my %boardshash; + 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); + return (\@groupboards,\%boardshash); +} + +############################################### 1;