# The LearningOnline Network with CAPA
# accessor routines used to provide information about course groups 
#
# Copyright Michigan State University Board of Trustees
#
# This file is part of the LearningOnline Network with CAPA (LON-CAPA).
#
# LON-CAPA is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# LON-CAPA is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with LON-CAPA; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
#
# /home/httpd/html/adm/gpl.txt
#
# http://www.lon-capa.org/
#

package Apache::longroup;

use strict;
use Apache::lonnet;

###############################################
=pod

=item coursegroups

Retrieve information about groups in a course,

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 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 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
can be sent to &get_group_settings() to be parsed.

Side effects:
None.

=cut

###############################################

sub coursegroups {
    my ($cdom,$cnum,$group,$namespace) = @_;
    if (!defined($cdom) || !defined($cnum)) {
        my $cid =  $env{'request.course.id'};

        return if (!defined($cid));

        $cdom = $env{'course.'.$cid.'.domain'};
        $cnum = $env{'course.'.$cid.'.num'};
    }
    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 %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, 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, 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

###############################################

sub get_group_settings {
    my ($groupinfo)=@_;
    my $parser=HTML::TokeParser->new(\$groupinfo);
    my $token;
    my $tool = '';
    my $role = '';
    my %content=();
    while ($token=$parser->get_token) {
        if ($token->[0] eq 'S')  {
            my $entry=$token->[1];
            if ($entry eq 'functions' || $entry eq 'autosec') {
                %{$content{$entry}} = ();
                $tool = $entry;
            } elsif ($entry eq 'role') {
                if ($tool eq 'autosec') {
                    $role = $token->[2]{id};
                    @{$content{$tool}{$role}} = ();
                }
            } else {
                my $value=$parser->get_text('/'.$entry);
                if ($entry eq 'name') {
                    if ($tool eq 'functions') {
                        my $function = $token->[2]{id};
                        $content{$tool}{$function} = $value;
                    }
                } elsif ($entry eq 'groupname') {
                    $content{$entry}=&unescape($value);
                } elsif (($entry eq 'roles') || ($entry eq 'types') ||
                         ($entry eq 'sectionpick') || ($entry eq 'defpriv')) {
                    push(@{$content{$entry}},$value);
                } elsif ($entry eq 'section') {
                    if ($tool eq 'autosec'  && $role ne '') {
                        push(@{$content{$tool}{$role}},$value);
                    }
                } else {
                    $content{$entry}=$value;
                }
            }
        } elsif ($token->[0] eq 'E') {
            if ($token->[1] eq 'functions' || $token->[1] eq 'autosec') {
                $tool = '';
            } elsif ($token->[1] eq 'role') {
                $role = '';
            }
        }
    }
    return %content;
}

###############################################

sub check_group_access {
    my ($group) = @_;
    my $access = 1;
    my $now = time;
    my ($start,$end) = split(/\./,$env{'user.role.gr/'.$env{'request.course,id'}.'/'.$group});
    if (($end!=0) && ($end<$now)) { $access = 0; }
    if (($start!=0) && ($start>$now)) { $access=0; }
    return $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
3. Url of role
4. Role
5. End date of role
6. Start date of role

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
groups in the course.

If role is being expired, will also expire any group memberships that
are specified for auto-group population for the specific role and
section (including section 'none' and 'all' sections), unless a
different role/section also included in auto-group population
for the course is included amongst the user's unexpired roles
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.
Uses default group privileges and default start and end group access
times. 

Output
None

Side effects:
May result in calls to Apache::lonnet::modify_group_roles()
and Apache::lonnet::modify_coursegroup_membership() to add
or expire group membership(s) for a user. 

=cut

sub group_changes {
    my ($udom,$uname,$url,$role,$origend,$origstart) = @_;
    my $now = time;
    my $chgtype;
    if ($origend > 0 && $origend <= $now) {
        $chgtype = 'drop';
    } else {
        $chgtype = 'add';
    }
    my ($cid,$cdom,$cnum,$sec);
    if ($url =~ m-^(/[^/]+/[^/]+)/([^/]+)$-) {
        $cid = $1;
        $sec = $2;
    } else {
        $cid = $url;
    }
    my $courseid = $cid;
    $courseid =~ s|^/||;
    $courseid =~ s|/|_|;
    my %crshash=&Apache::lonnet::coursedescription($cid);
    $cdom = $crshash{'domain'};
    $cnum = $crshash{'num'};
    if (defined($cdom) && defined($cnum)) {
        my %settings;
        my @changegroups = ();
        my %dropgroup = ();
        my %dropstart = ();
        my %addgroup = ();
        my %curr_groups = &coursegroups($cdom,$cnum);
        if (%curr_groups) {
            foreach my $group (keys(%curr_groups)) {
                %{$settings{$group}}=&get_group_settings($curr_groups{$group});
                if ($chgtype eq 'add') {
                    if (!($settings{$group}{autoadd} eq 'on')) {
                        next;
                    }
                } else {
                    if (!($settings{$group}{autodrop} eq 'on')) {
                        next;
                    }
                }
                my @autosec = ();
                if (ref($settings{$group}{'autosec'}{$role}) eq 'ARRAY') {
                    @autosec = @{$settings{$group}{'autosec'}{$role}};
                }
                if ($sec eq '') {
                    $sec = 'none';
                }
                if ((grep(/^$sec$/,@autosec)) || (grep(/^all$/,@autosec))) {
                    push(@changegroups,$group);
                }
            }
        }
       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 {
                my $group_privs = '';
                foreach my $group (@changegroups) {
                    if ($chgtype eq 'add') {
                        if (ref($settings{$group}{'defpriv'}) eq 'ARRAY') {
                            $group_privs =
                                  join(':',@{$settings{$group}{'defpriv'}});
                        }
                    }
                    my $key = $cid.'/'.$group.'_gr';
                    if (defined($roleshash{$key})) {
                        if ($roleshash{$key}=~ /^gr\/([^_]*)_(\d+)_([\-\d]+)$/) {
                            my $grpstart = $3;
                            my $grpend = $2;
                            $currpriv{$group} = $1;
                            if ($chgtype eq 'drop') {
                                if ($grpstart == -1) { next; } # deleted
                                if ($grpend == 0 || $grpend > $now) {
                                    if (!defined($dropgroup{$group})) {
                                        $dropstart{$group} = $grpstart;
                                        if ($grpstart > $now) {
                                            $dropstart{$group} = $now;
                                        }
                                        $dropgroup{$group} = $now.':'.
                                                            $dropstart{$group}.
                                                         ':'.$currpriv{$group};
                                    }
                                }
                            } elsif ($chgtype eq 'add') {
                                if (($grpstart == -1) || ($grpend > 0 &&
                                     ($grpend < $settings{$group}{'enddate'} ||
                                      $settings{$group}{'enddate'} == 0)) ||
                                     ($grpstart > $settings{$group}{'startdate'})) {
                                    if (!defined($addgroup{$group})) {
                                        $addgroup{$group} =
                                            $settings{$group}{'enddate'}.':'.
                                            $settings{$group}{'startdate'}.':'.
                                            $group_privs;
                                    }
                                }
                            }
                        }
                    } elsif ($chgtype eq 'add') {
                        $addgroup{$group} = $settings{$group}{'enddate'}.':'.
                                            $settings{$group}{'startdate'}.':'.
                                            $group_privs;
                    }
                }
                if ($chgtype eq 'add') {
                    foreach my $add (keys(%addgroup)) {
                        if (&Apache::lonnet::modify_group_roles($cdom,$cnum,
                                                  $add,$uname.':'.$udom,
                                                  $settings{$add}{'enddate'},
                                                  $settings{$add}{'startdate'},
                                                  $group_privs) eq 'ok') {
                            my %usersettings;
                            $usersettings{$add.':'.$uname.':'.$udom} =
                                                               $addgroup{$add};
                            my $roster_result =
                               &Apache::lonnet::modify_coursegroup_membership(
                                                   $cdom,$cnum,\%usersettings);
                        }
                    }
                } elsif ($chgtype eq 'drop') {
                    foreach my $drop (keys(%dropgroup)) {
                        my $nodrop = 0;
                        if ($settings{$drop}{'autoadd'} eq 'on') {
                            foreach my $urole (keys(%{$settings{$drop}{'autosec'}})) {
                                if ($nodrop) {
                                    last;
                                } else {
                                    my @autosec = ();
                                    if (ref($settings{$drop}{'autosec'}{$urole}) eq 'ARRAY') {
                                        @autosec = @{$settings{$drop}{'autosec'}{$urole}};
                                    }
                                    foreach my $usec (@autosec) {
                                        if ($usec eq 'all') {
                                            foreach my $ukey (keys(%roleshash)) {
                                                if ($ukey =~ /^\Q$cid\E(\/?\w*)_($urole)$/) {
                                                    if ($sec ne $1) {
                                                        if ($roleshash{$ukey} =~ /_?(\d*)_?([\-\d]*)$/) {
                                                            my $roleend = $1;
                                                            if ((!$roleend) ||
                                                                ($roleend > $now)) {
                                                                $nodrop = 1;
                                                                last;
                                                            }
                                                        }
                                                    }
                                                }
                                            }
                                        } else {
                                            my $ukey = $cid.'/'.$usec.'_'.$urole;
                                            if ($usec eq 'none') {
                                                if ($sec eq '') {
                                                    next;
                                                }
                                            } else {
                                                if ($usec eq $sec) {
                                                    next;
                                                }
                                            }
                                            if (exists($roleshash{$ukey})) {
                                                if ($roleshash{$ukey} =~
                                                       /_?(\d*)_?([\-\d]*)$/) {
                                                    my $roleend = $1;
                                                    if ((!$roleend) ||
                                                        ($roleend > $now)) {
                                                        $nodrop = 1;
                                                        last;
                                                    }
                                                }
                                            }
                                        }
                                    }
                                }
                            }
                        }
                        if (!$nodrop) {
                            if (&Apache::lonnet::modify_group_roles($cdom,
                                                         $cnum,$drop,
                                                         $uname.':'.$udom,$now,
                                                         $dropstart{$drop},
                                                         $currpriv{$drop}) 
                                                                     eq 'ok') {
                                my %usersettings;
                                $usersettings{$drop.':'.$uname.':'.$udom} =
                                                             $dropgroup{$drop};
                                my $roster_result =
                                &Apache::lonnet::modify_coursegroup_membership(
                                                   $cdom,$cnum,\%usersettings);
                            }
                        }
                    }
                }
            }
        }
    }
    return;
}

###############################################

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;