source: trunk/LATMOS-Accounts/lib/LATMOS/Accounts/Bases/Sql/Group.pm @ 2296

package LATMOS::Accounts::Bases::Sql::Group;

use 5.010000;
use strict;
use warnings;
use overload '""' => 'stringify';

use base qw(LATMOS::Accounts::Bases::Sql::objects);
use LATMOS::Accounts::Log;
use LATMOS::Accounts::I18N;

our $VERSION = (q$Rev: 1920 $ =~ /^Rev: (\d+) /)[0];

=head1 NAME

LATMOS::Accounts::Bases::Sql::Group - Groups objects support

=cut

sub stringify {
    my ($self) = @_;

    $self->get_field('label')
    || $self->id;
}

sub _object_table { 'group' }

sub _key_field { 'name' }

sub _has_extended_attributes { 1 }

sub _get_attr_schema {
    my ($class, $base) = @_;

    $class->SUPER::_get_attr_schema($base,
        {
            gidNumber  => {
                inline => 1,
                uniq => 1,
                iname => 'gidnumber',
                mandatory => 1,
                label => l('GID'),
            },
            gidnumber  => { inline => 1, uniq => 1, hide => 1, },
            cn         => { inline => 1, ro => 1, iname => 'name', },
            memberUID  => {
                monitored => 1,
                hide => 1,
                reference => 'user',
                multiple => 1,
                delayed => 1,
                ro => sub {
                    $_[0] &&
                    (($_[0]->_get_c_field('sutype') ||'') =~ /^(jobtype|contrattype)$/
                     || $_[0]->_get_c_field('autoMemberFilter')
                     || $_[0]->_get_c_field('autoFromSutype'))
                    ? 1 : 0
                },
                get => sub {
                    my ($self) = @_;
                    my $sth = $self->base->db->prepare_cached(
                        q{
                        select value from group_attributes
                        join "group" on "group".ikey = group_attributes.okey
                        join "user" on "user".name = group_attributes.value
                        where "group".name = ? and attr = ?
                        } .
                        ($self->base->{wexported} ? '' : 'and "user".exported = true')
                    );
                    $sth->execute($self->object->id, 'memberUID');
                    my @res;
                    while (my $res = $sth->fetchrow_hashref) {
                        push(@res, $res->{value});
                    }
                    return \@res;
                },
                set => sub {
                    my ($self, $data) = @_;
                    $self->object->_set_group_members($data);
                },
                label => l('Member'),
            },
            member     => {
                monitored => 1,
                reference => 'user',
                multiple => 1,
                delayed => 1,
                iname => 'memberUID',
                can_values => sub { $base->list_objects('user') },
                ro => sub {
                    $_[0] &&
                    (($_[0]->_get_c_field('sutype') ||'') =~ /^(jobtype|contrattype)$/
                     || $_[0]->_get_c_field('autoMemberFilter')
                     || $_[0]->_get_c_field('autoFromSutype'))
                    ? 1 : 0
                },
                get => sub {
                    my ($self) = @_;
                    $self->object->_get_c_field('memberUID');
                },
                set => sub {
                    my ($self, $data) = @_;
                    $self->object->_set_group_members($data);
                },
                label => l('Member'),
            },
            sAMAccountName => { iname => 'name', ro => 1 },
            groupname  => { ro => 1 },
            managedBy  => {
                monitored => 1,
                reference => 'user',
                can_values => sub {
                    my %uniq = map { $_ => 1 } grep { $_ }
                    (($_[1] ? $_[1]->get_attributes('managedBy') : ()),
                    $base->search_objects('user', 'active=*'));
                    sort keys %uniq;
                },
                label => l('Manager'),
                post => sub {
                    my ($self, $value) = @_;
                    $self->object->_update_employment_manager;
                },
            },
            managedAlsoBy  => {
                monitored => 1,
                reference => 'user',
                multiple => 1,
                delayed => 1,
                can_values => sub {
                    my %uniq = map { $_ => 1 } grep { $_ }
                    ($_[1] ? $_[1]->get_attributes('managedBy') : ()),
                    $base->search_objects('user', 'active=*');
                    sort keys %uniq;
                },
                label => l('Secondary Manager'),
            },
            sutype => {
                reference => 'sutype',
                monitored => 1,
                label => l('Structure'),
                multiple => 1,
            },
            autoMemberFilter => {
                multiple => 1,
                set => sub {
                    my ($self, $data) = @_;
                    $self->object->set_fields($self->name, $data) or return;
                    $self->object->populate_dyn_group;
                    return 1;
                },
                label => l('Automatics filters'),
            },
            autoExclude => {
                multiple => 1,
                reference => 'user',
                label => l('User excluded'),
            },
            autoInclude => {
                multiple => 1,
                reference => 'user',
                label => l('User included'),
            },
            autoFromSutype => {
                reference => 'sutype',
                multiple => 1,
                set => sub {
                    my ($self, $data) = @_;
                    $self->object->set_fields($self->name, $data) or return;
                    $self->object->populate_dyn_group;
                    return 1;
                },
                label => l('From group type'),
            },
            label => {
                label => l('Label'),
            },
            expire => {
                label => l('Expire'),
            },
            description => {
                label => l('Description'),
            },
            comment => {
                label => l('Comment'),
            },
            memberCount => {
                managed => 1,
                ro => 1,
                get => sub {
                    my ($self) = @_;
                    scalar(@{$self->object->_get_c_field('memberUID') || []});
                },
                label => l('Member count'),
            },
        }
    )
}

sub _set_group_members {
    my ($self, $members) = @_;
    my %member;
    my $res = 0;
    foreach (@{ $self->_get_c_field('memberUID') || [] }) {
        $member{$_}{c} = 1;
    }
    foreach (ref $members ? @{ $members || []} : $members) {
        $_ or next; # avoid undef
        $member{$_}{n} = 1;
    }

    foreach (keys %member) {
        $member{$_}{c} && $member{$_}{n} and next; # no change !
        my $user = $self->base->get_object('user', $_) or next;
        if ($member{$_}{n}) {
            my $sth = $self->db->prepare_cached(
                q{insert into group_attributes_users (value, attr, okey) values (?,?,?)}
            );
            $res += $sth->execute($_, 'memberUID', $self->_get_ikey);
        } elsif ($member{$_}{c}) {
            if (($user->get_c_field('department') || '') eq $self->id) {
                $self->base->log(LA_WARN,
                    "Don't removing user %s from group %s: is it's department",
                    $user->id, $self->id);
                next;
            }
            my $sth = $self->db->prepare_cached(
                q{delete from group_attributes_users where value = ? and attr = ? and okey = ?}
            );
            $res += $sth->execute($_, 'memberUID', $self->_get_ikey);
        } # else {} # can't happend
    }
    return $res;
}

=head2 populate_dyn_group

Synchronise group's members according filter set into C<autoMemberFilter> attribute.

=cut

sub populate_dyn_group {
    my ($self) = @_;

    if (
           !$self->get_field('autoMemberFilter')
        && !$self->get_field('autoFromSutype')) {
        return 0;
    }
    $self->base->log(LA_DEBUG,
        "Populating group %s from autoMemberFilter/autoFromSutype attribute",
        $self->id
    );

    my @Userlist = $self->_filterToUser;

    my $res = $self->_set_group_members( \@Userlist );

    $res;
}

sub _update_employment_manager {
    my ($self) = @_;

    my $listEmp = $self->base->db->prepare(q{
        select name from employment join employment_attributes
            on employment.ikey = employment_attributes.okey
        where firstday < now() and (lastday > now() or lastday is NULL)
            and employment_attributes.attr = 'department' and employment_attributes.value = ?
        });
    $listEmp->execute($self->id);
    while (my $res = $listEmp->fetchrow_hashref()) {
        $self->base->log(LA_DEBUG, "Checking if employment %s is impacted by managedBy change", $res->{name});
        my $employment = $self->base->get_object('employment', $res->{name}) or next;
        $employment->get_attributes('managerContact') and next;
        my $dpmt  = $employment->_get_attributes('department') or next;
        my $odmpt = $employment->base->get_object('group', $dpmt) or next;
        my $manager = $odmpt->get_attributes('managedBy') or next;
        my $user = $employment->get_attributes('user');
        my $ouser = $employment->base->get_object('user', $user) or next;
        $self->base->log(LA_DEBUG, "Updating manager to $manager for user $user due to dpmt update");
        $ouser->ReportChange(
            'Update', 'Attr manager updated to match Dpmt manager %s (%s)',
            $manager,
            $dpmt,
        );
        $ouser->set_fields('manager', $manager);
    }

    return 1;
}

1;

__END__

=head1 SEE ALSO

L<LATMOS::Accounts::Bases::Sql>

=head1 AUTHOR

Olivier Thauvin, E<lt>olivier.thauvin@latmos.ipsl.frE<gt>

=head1 COPYRIGHT AND LICENSE

Copyright (C) 2008, 2009 CNRS SA/CETP/LATMOS

This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself, either Perl version 5.10.0 or,
at your option, any later version of Perl 5 you may have available.

=cut