[29] | 1 | package LATMOS::Accounts::Bases::Sql::Group; |
---|
[21] | 2 | |
---|
| 3 | use 5.010000; |
---|
| 4 | use strict; |
---|
| 5 | use warnings; |
---|
| 6 | |
---|
[29] | 7 | use base qw(LATMOS::Accounts::Bases::Sql::objects); |
---|
[751] | 8 | use LATMOS::Accounts::Log; |
---|
[21] | 9 | |
---|
| 10 | our $VERSION = (q$Rev$ =~ /^Rev: (\d+) /)[0]; |
---|
| 11 | |
---|
| 12 | =head1 NAME |
---|
| 13 | |
---|
[1023] | 14 | LATMOS::Accounts::Bases::Sql::Group - Groups objects support |
---|
[21] | 15 | |
---|
| 16 | =cut |
---|
| 17 | |
---|
[1014] | 18 | sub _object_table { 'group' } |
---|
[21] | 19 | |
---|
[1014] | 20 | sub _key_field { 'name' } |
---|
[29] | 21 | |
---|
[1014] | 22 | sub _has_extended_attributes { 1 } |
---|
[74] | 23 | |
---|
[861] | 24 | sub _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 | |
---|
| 98 | sub 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] | 122 | sub _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] | 160 | sub 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 | |
---|
| 193 | Synchronise group's members according filter set into C<autoMemberFilter> attribute. |
---|
| 194 | |
---|
| 195 | =cut |
---|
| 196 | |
---|
[1135] | 197 | sub 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] | 216 | 1; |
---|
| 217 | |
---|
| 218 | __END__ |
---|
| 219 | |
---|
| 220 | =head1 SEE ALSO |
---|
| 221 | |
---|
[1023] | 222 | L<LATMOS::Accounts::Bases::Sql> |
---|
| 223 | |
---|
[21] | 224 | =head1 AUTHOR |
---|
| 225 | |
---|
| 226 | Olivier Thauvin, E<lt>olivier.thauvin@latmos.ipsl.frE<gt> |
---|
| 227 | |
---|
| 228 | =head1 COPYRIGHT AND LICENSE |
---|
| 229 | |
---|
| 230 | Copyright (C) 2008, 2009 CNRS SA/CETP/LATMOS |
---|
| 231 | |
---|
| 232 | This library is free software; you can redistribute it and/or modify |
---|
| 233 | it under the same terms as Perl itself, either Perl version 5.10.0 or, |
---|
| 234 | at your option, any later version of Perl 5 you may have available. |
---|
| 235 | |
---|
| 236 | =cut |
---|