source: branches/4.0/LATMOS-Accounts/lib/LATMOS/Accounts/Bases/Sql/Group.pm @ 1299

Last change on this file since 1299 was 1299, checked in by nanardon, 9 years ago

backport fix

  • Property svn:keywords set to Id Rev
File size: 6.9 KB
RevLine 
[29]1package LATMOS::Accounts::Bases::Sql::Group;
[21]2
3use 5.010000;
4use strict;
5use warnings;
6
[29]7use base qw(LATMOS::Accounts::Bases::Sql::objects);
[751]8use LATMOS::Accounts::Log;
[21]9
10our $VERSION = (q$Rev$ =~ /^Rev: (\d+) /)[0];
11
12=head1 NAME
13
[1023]14LATMOS::Accounts::Bases::Sql::Group - Groups objects support
[21]15
16=cut
17
[1014]18sub _object_table { 'group' }
[21]19
[1014]20sub _key_field { 'name' }
[29]21
[1014]22sub _has_extended_attributes { 1 }
[74]23
[861]24sub _get_attr_schema {
25    my ($class, $base) = @_;
[251]26
[861]27    $class->SUPER::_get_attr_schema($base,
28        {
29            gidNumber  => { inline => 1, uniq => 1, iname => 'gidnumber',
30                mandatory => 1, },
31            gidnumber  => { inline => 1, uniq => 1, hide => 1, },
32            exported   => { inline => 1, },
33            name       => { inline => 1, ro => 1 },
34            cn         => { inline => 1, ro => 1, iname => 'name', },
35            create     => { inline => 1, ro => 1 },
36            date       => { inline => 1, ro => 1 },
37            memberUID  => {
[1299]38                monitored => 1,
[1236]39                hide => 1,
[861]40                reference => 'user',
41                multiple => 1,
42                delayed => 1,
43                ro => sub {
44                    $_[0] && 
[1135]45                    (($_[0]->_get_c_field('sutype') ||'') =~ /^(jobtype|contrattype)$/
46                     || $_[0]->_get_c_field('autoMemberFilter'))
[861]47                    ? 1 : 0 
48                },
49            },
50            member     => {
[1299]51                monitored => 1,
[861]52                reference => 'user',
53                multiple => 1, 
54                delayed => 1,
55                can_values => sub { $base->list_objects('user') },
56                ro => sub {
57                    $_[0] && 
[1135]58                    (($_[0]->_get_c_field('sutype') ||'') =~ /^(jobtype|contrattype)$/
59                     || $_[0]->_get_c_field('autoMemberFilter'))
[861]60                    ? 1 : 0 
61                },
62            },
63            sAMAccountName => { iname => 'name', ro => 1 },
64            groupname  => { ro => 1 },
65            managedBy  => {
[1299]66                monitored => 1,
[861]67                reference => 'user',
68                can_values => sub {
69                    my %uniq = map { $_ => 1 } grep { $_ }
70                    ($_[1] ? $_[1]->get_attributes('manager') : ()),
71                    $base->search_objects('user', 'active=*');
72                    sort keys %uniq;
73                },
74            },
[1186]75            managedAlsoBy  => {
[1299]76                monitored => 1,
[1186]77                reference => 'user',
78                multiple => 1,
79                delayed => 1,
80                can_values => sub {
81                    my %uniq = map { $_ => 1 } grep { $_ }
82                    ($_[1] ? $_[1]->get_attributes('manager') : ()),
83                    $base->search_objects('user', 'active=*');
84                    sort keys %uniq;
85                },
86            },
[861]87            sutype => {
88                reference => 'sutype',
[1299]89                monitored => 1,
[861]90            },
[1135]91            autoMemberFilter => {
92                multiple => 1,
93            }
[861]94        }
95    )
[59]96}
97
98sub get_field {
99    my ($self, $field) = @_;
100    for ($field) {
[91]101        /^(member|memberUID)$/ and do {
[59]102            my $sth = $self->db->prepare_cached(
103                q{
[751]104                select value from group_attributes
105                join "group" on "group".ikey = group_attributes.okey
[1238]106                join "user" on "user".name = group_attributes.value
107                where "group".name = ? and attr = ?
108                } .
109                ($self->base->{wexported} ? '' : 'and "user".exported = true')
[59]110            );
[163]111            $sth->execute($self->id, 'memberUID');
[59]112            my @res;
113            while (my $res = $sth->fetchrow_hashref) {
[163]114                push(@res, $res->{value});
[59]115            }
116            return \@res;
117        };
118    }
119    $self->SUPER::get_field($field);
120}
121
[1135]122sub _set_group_members {
123    my ($self, $members) = @_;
124    my %member;
125    my $res = 0;
126    foreach (@{ $self->get_field('memberUID') }) {
127        $member{$_}{c} = 1;
128    }
129    foreach (ref $members ? @{ $members || []} : $members) {
130        $_ or next; # avoid undef
131        $member{$_}{n} = 1;
132    }
133
134    foreach (keys %member) {
135        $member{$_}{c} && $member{$_}{n} and next; # no change !
136        my $user = $self->base->get_object('user', $_) or next;
137        if ($member{$_}{n}) {
138            my $sth = $self->db->prepare_cached(
139                q{insert into group_attributes_users (value, attr, okey) values (?,?,?)}
140            );
141            $sth->execute($_, 'memberUID', $self->_get_ikey);
142            $res++;
143        } elsif ($member{$_}{c}) {
144            if (($user->get_c_field('department') || '') eq $self->id) {
145                $self->base->log(LA_WARN,
146                    "Don't removing user %s from group %s: is it's department",
147                    $user->id, $self->id);
148                next;
149            }
150            my $sth = $self->db->prepare_cached(
151                q{delete from group_attributes_users where value = ? and attr = ? and okey = ?}
152            );
153            $sth->execute($_, 'memberUID', $self->_get_ikey);
154            $res++;
155        } # else {} # can't happend
156    }
157    return $res;
158}
159
[59]160sub set_fields {
161    my ($self, %data) = @_;
162    my %fdata;
[396]163    my $res = 0;
[59]164    foreach my $attr (keys %data) {
[218]165        $attr =~ /^memberUID|member$/ and do {
[1135]166            if (($self->_get_c_field('sutype') ||'') =~ /^(jobtype|contrattype)$/ ||
167                 $self->get_field('autoMemberFilter')) {
[751]168                $self->base->log(LA_WARN,
169                    "Group %s is managed, ignoring member set request",
170                    $self->id);
171                next;
172            }
[1294]173            $res += $self->_set_group_members($data{$attr});
[59]174            next;
175        };
176        $fdata{$attr} = $data{$attr};
177    }
[1135]178
[59]179    if (keys %fdata) {
[861]180            my $setres = $self->SUPER::set_fields(%fdata);
[1135]181        if (exists($fdata{autoMemberFilter})) {
182            $res += $self->populate_dyn_group;
183        }
[1294]184        return unless(defined($setres));
185            $res += ($setres || 0);
[59]186    }
[1294]187   
188    $res
[59]189}
190
[1154]191=head2 populate_dyn_group
192
193Synchronise group's members according filter set into C<autoMemberFilter> attribute.
194
195=cut
196
[1135]197sub populate_dyn_group {
198    my ($self) = @_;
199
200    if (!$self->get_field('autoMemberFilter')) {
[1187]201        return 0;
[1135]202    }
203    $self->base->log(LA_DEBUG,
204        "Populating group %s from autoMemberFilter attribute",
205        $self->id
206    );
207    my $filter = $self->get_field('autoMemberFilter');
208    $self->_set_group_members(
209        [ $self->base->search_objects(
210            'user',
211            ref $filter ? @{ $filter } : $filter
212        ) ]
213    )
214}
215
[21]2161;
217
218__END__
219
220=head1 SEE ALSO
221
[1023]222L<LATMOS::Accounts::Bases::Sql>
223
[21]224=head1 AUTHOR
225
226Olivier Thauvin, E<lt>olivier.thauvin@latmos.ipsl.frE<gt>
227
228=head1 COPYRIGHT AND LICENSE
229
230Copyright (C) 2008, 2009 CNRS SA/CETP/LATMOS
231
232This library is free software; you can redistribute it and/or modify
233it under the same terms as Perl itself, either Perl version 5.10.0 or,
234at your option, any later version of Perl 5 you may have available.
235
236=cut
Note: See TracBrowser for help on using the repository browser.