[29] | 1 | package LATMOS::Accounts::Bases::Sql::Group; |
---|
[21] | 2 | |
---|
| 3 | use 5.010000; |
---|
| 4 | use strict; |
---|
| 5 | use warnings; |
---|
[1786] | 6 | use overload '""' => 'stringify'; |
---|
[21] | 7 | |
---|
[29] | 8 | use base qw(LATMOS::Accounts::Bases::Sql::objects); |
---|
[751] | 9 | use LATMOS::Accounts::Log; |
---|
[1551] | 10 | use LATMOS::Accounts::I18N; |
---|
[21] | 11 | |
---|
| 12 | our $VERSION = (q$Rev$ =~ /^Rev: (\d+) /)[0]; |
---|
| 13 | |
---|
| 14 | =head1 NAME |
---|
| 15 | |
---|
[1023] | 16 | LATMOS::Accounts::Bases::Sql::Group - Groups objects support |
---|
[21] | 17 | |
---|
| 18 | =cut |
---|
| 19 | |
---|
[1786] | 20 | sub stringify { |
---|
| 21 | my ($self) = @_; |
---|
| 22 | |
---|
| 23 | $self->get_field('label') |
---|
| 24 | || $self->id; |
---|
| 25 | } |
---|
| 26 | |
---|
[1014] | 27 | sub _object_table { 'group' } |
---|
[21] | 28 | |
---|
[1014] | 29 | sub _key_field { 'name' } |
---|
[29] | 30 | |
---|
[1014] | 31 | sub _has_extended_attributes { 1 } |
---|
[74] | 32 | |
---|
[861] | 33 | sub _get_attr_schema { |
---|
| 34 | my ($class, $base) = @_; |
---|
[251] | 35 | |
---|
[861] | 36 | $class->SUPER::_get_attr_schema($base, |
---|
| 37 | { |
---|
[1315] | 38 | gidNumber => { |
---|
| 39 | inline => 1, |
---|
| 40 | uniq => 1, |
---|
| 41 | iname => 'gidnumber', |
---|
[1912] | 42 | mandatory => 1, |
---|
[1550] | 43 | label => l('GID'), |
---|
[1315] | 44 | }, |
---|
[861] | 45 | gidnumber => { inline => 1, uniq => 1, hide => 1, }, |
---|
| 46 | cn => { inline => 1, ro => 1, iname => 'name', }, |
---|
| 47 | memberUID => { |
---|
[1297] | 48 | monitored => 1, |
---|
[1236] | 49 | hide => 1, |
---|
[861] | 50 | reference => 'user', |
---|
| 51 | multiple => 1, |
---|
| 52 | delayed => 1, |
---|
| 53 | ro => sub { |
---|
[1912] | 54 | $_[0] && |
---|
[1135] | 55 | (($_[0]->_get_c_field('sutype') ||'') =~ /^(jobtype|contrattype)$/ |
---|
[1782] | 56 | || $_[0]->_get_c_field('autoMemberFilter') |
---|
| 57 | || $_[0]->_get_c_field('autoFromSutype')) |
---|
[1912] | 58 | ? 1 : 0 |
---|
[861] | 59 | }, |
---|
[1315] | 60 | get => sub { |
---|
[1912] | 61 | my ($self) = @_; |
---|
[1315] | 62 | my $sth = $self->base->db->prepare_cached( |
---|
| 63 | q{ |
---|
| 64 | select value from group_attributes |
---|
| 65 | join "group" on "group".ikey = group_attributes.okey |
---|
| 66 | join "user" on "user".name = group_attributes.value |
---|
| 67 | where "group".name = ? and attr = ? |
---|
| 68 | } . |
---|
| 69 | ($self->base->{wexported} ? '' : 'and "user".exported = true') |
---|
| 70 | ); |
---|
| 71 | $sth->execute($self->object->id, 'memberUID'); |
---|
| 72 | my @res; |
---|
| 73 | while (my $res = $sth->fetchrow_hashref) { |
---|
| 74 | push(@res, $res->{value}); |
---|
| 75 | } |
---|
| 76 | return \@res; |
---|
| 77 | }, |
---|
| 78 | set => sub { |
---|
| 79 | my ($self, $data) = @_; |
---|
| 80 | $self->object->_set_group_members($data); |
---|
| 81 | }, |
---|
[1550] | 82 | label => l('Member'), |
---|
[861] | 83 | }, |
---|
| 84 | member => { |
---|
[1297] | 85 | monitored => 1, |
---|
[861] | 86 | reference => 'user', |
---|
[1912] | 87 | multiple => 1, |
---|
[861] | 88 | delayed => 1, |
---|
[1788] | 89 | iname => 'memberUID', |
---|
[861] | 90 | can_values => sub { $base->list_objects('user') }, |
---|
| 91 | ro => sub { |
---|
[1912] | 92 | $_[0] && |
---|
[1135] | 93 | (($_[0]->_get_c_field('sutype') ||'') =~ /^(jobtype|contrattype)$/ |
---|
[1782] | 94 | || $_[0]->_get_c_field('autoMemberFilter') |
---|
| 95 | || $_[0]->_get_c_field('autoFromSutype')) |
---|
[1912] | 96 | ? 1 : 0 |
---|
[861] | 97 | }, |
---|
[1315] | 98 | get => sub { |
---|
| 99 | my ($self) = @_; |
---|
| 100 | $self->object->_get_c_field('memberUID'); |
---|
| 101 | }, |
---|
| 102 | set => sub { |
---|
| 103 | my ($self, $data) = @_; |
---|
| 104 | $self->object->_set_group_members($data); |
---|
| 105 | }, |
---|
[1550] | 106 | label => l('Member'), |
---|
[861] | 107 | }, |
---|
| 108 | sAMAccountName => { iname => 'name', ro => 1 }, |
---|
| 109 | groupname => { ro => 1 }, |
---|
| 110 | managedBy => { |
---|
[1297] | 111 | monitored => 1, |
---|
[861] | 112 | reference => 'user', |
---|
| 113 | can_values => sub { |
---|
| 114 | my %uniq = map { $_ => 1 } grep { $_ } |
---|
[1912] | 115 | (($_[1] ? $_[1]->get_attributes('managedBy') : ()), |
---|
| 116 | $base->search_objects('user', 'active=*')); |
---|
[861] | 117 | sort keys %uniq; |
---|
| 118 | }, |
---|
[1550] | 119 | label => l('Manager'), |
---|
[1912] | 120 | post => sub { |
---|
| 121 | my ($self, $value) = @_; |
---|
| 122 | $self->object->_update_employment_manager; |
---|
| 123 | }, |
---|
[861] | 124 | }, |
---|
[1186] | 125 | managedAlsoBy => { |
---|
[1297] | 126 | monitored => 1, |
---|
[1186] | 127 | reference => 'user', |
---|
| 128 | multiple => 1, |
---|
| 129 | delayed => 1, |
---|
| 130 | can_values => sub { |
---|
| 131 | my %uniq = map { $_ => 1 } grep { $_ } |
---|
[1912] | 132 | ($_[1] ? $_[1]->get_attributes('managedBy') : ()), |
---|
[1186] | 133 | $base->search_objects('user', 'active=*'); |
---|
| 134 | sort keys %uniq; |
---|
| 135 | }, |
---|
[1550] | 136 | label => l('Secondary Manager'), |
---|
[1186] | 137 | }, |
---|
[861] | 138 | sutype => { |
---|
| 139 | reference => 'sutype', |
---|
[1297] | 140 | monitored => 1, |
---|
[1550] | 141 | label => l('Structure'), |
---|
[1782] | 142 | multiple => 1, |
---|
[861] | 143 | }, |
---|
[1135] | 144 | autoMemberFilter => { |
---|
| 145 | multiple => 1, |
---|
[1315] | 146 | set => sub { |
---|
| 147 | my ($self, $data) = @_; |
---|
| 148 | $self->object->set_fields($self->name, $data) or return; |
---|
| 149 | $self->object->populate_dyn_group; |
---|
| 150 | return 1; |
---|
[1550] | 151 | }, |
---|
| 152 | label => l('Automatics filters'), |
---|
[1315] | 153 | }, |
---|
[1782] | 154 | autoFromSutype => { |
---|
| 155 | reference => 'sutype', |
---|
| 156 | multiple => 1, |
---|
| 157 | set => sub { |
---|
| 158 | my ($self, $data) = @_; |
---|
| 159 | $self->object->set_fields($self->name, $data) or return; |
---|
| 160 | $self->object->populate_dyn_group; |
---|
| 161 | return 1; |
---|
| 162 | }, |
---|
| 163 | label => l('From group type'), |
---|
| 164 | }, |
---|
[1550] | 165 | label => { |
---|
| 166 | label => l('Label'), |
---|
| 167 | }, |
---|
| 168 | expire => { |
---|
| 169 | label => l('Expire'), |
---|
| 170 | }, |
---|
| 171 | description => { |
---|
| 172 | label => l('Description'), |
---|
| 173 | }, |
---|
| 174 | comment => { |
---|
| 175 | label => l('Comment'), |
---|
| 176 | }, |
---|
[1475] | 177 | memberCount => { |
---|
| 178 | managed => 1, |
---|
| 179 | ro => 1, |
---|
| 180 | get => sub { |
---|
| 181 | my ($self) = @_; |
---|
[1571] | 182 | scalar(@{$self->object->_get_c_field('memberUID') || []}); |
---|
[1550] | 183 | }, |
---|
| 184 | label => l('Member count'), |
---|
[1475] | 185 | }, |
---|
[861] | 186 | } |
---|
| 187 | ) |
---|
[59] | 188 | } |
---|
| 189 | |
---|
[1135] | 190 | sub _set_group_members { |
---|
| 191 | my ($self, $members) = @_; |
---|
| 192 | my %member; |
---|
| 193 | my $res = 0; |
---|
[1571] | 194 | foreach (@{ $self->_get_c_field('memberUID') || [] }) { |
---|
[1135] | 195 | $member{$_}{c} = 1; |
---|
| 196 | } |
---|
| 197 | foreach (ref $members ? @{ $members || []} : $members) { |
---|
| 198 | $_ or next; # avoid undef |
---|
| 199 | $member{$_}{n} = 1; |
---|
| 200 | } |
---|
| 201 | |
---|
| 202 | foreach (keys %member) { |
---|
| 203 | $member{$_}{c} && $member{$_}{n} and next; # no change ! |
---|
| 204 | my $user = $self->base->get_object('user', $_) or next; |
---|
| 205 | if ($member{$_}{n}) { |
---|
| 206 | my $sth = $self->db->prepare_cached( |
---|
| 207 | q{insert into group_attributes_users (value, attr, okey) values (?,?,?)} |
---|
| 208 | ); |
---|
[1737] | 209 | $res += $sth->execute($_, 'memberUID', $self->_get_ikey); |
---|
[1135] | 210 | } elsif ($member{$_}{c}) { |
---|
| 211 | if (($user->get_c_field('department') || '') eq $self->id) { |
---|
| 212 | $self->base->log(LA_WARN, |
---|
| 213 | "Don't removing user %s from group %s: is it's department", |
---|
| 214 | $user->id, $self->id); |
---|
| 215 | next; |
---|
| 216 | } |
---|
| 217 | my $sth = $self->db->prepare_cached( |
---|
| 218 | q{delete from group_attributes_users where value = ? and attr = ? and okey = ?} |
---|
| 219 | ); |
---|
[1737] | 220 | $res += $sth->execute($_, 'memberUID', $self->_get_ikey); |
---|
[1135] | 221 | } # else {} # can't happend |
---|
| 222 | } |
---|
| 223 | return $res; |
---|
| 224 | } |
---|
| 225 | |
---|
[1154] | 226 | =head2 populate_dyn_group |
---|
| 227 | |
---|
| 228 | Synchronise group's members according filter set into C<autoMemberFilter> attribute. |
---|
| 229 | |
---|
| 230 | =cut |
---|
| 231 | |
---|
[1135] | 232 | sub populate_dyn_group { |
---|
| 233 | my ($self) = @_; |
---|
| 234 | |
---|
[1782] | 235 | if ( |
---|
| 236 | !$self->get_field('autoMemberFilter') |
---|
| 237 | && !$self->get_field('autoFromSutype')) { |
---|
[1187] | 238 | return 0; |
---|
[1135] | 239 | } |
---|
| 240 | $self->base->log(LA_DEBUG, |
---|
[1782] | 241 | "Populating group %s from autoMemberFilter/autoFromSutype attribute", |
---|
[1135] | 242 | $self->id |
---|
| 243 | ); |
---|
[1782] | 244 | |
---|
| 245 | my %users; |
---|
| 246 | |
---|
| 247 | if (my $filter = $self->get_field('autoFromSutype')) { |
---|
| 248 | my @suTypeFilter = map { "sutype=$_" } (ref $filter ? @{ $filter } : $filter); |
---|
| 249 | foreach my $group ($self->base->search_objects('group', @suTypeFilter)) { |
---|
| 250 | foreach ($self->base->search_objects('user', "memberOf=$group")) { |
---|
| 251 | $users{$_} = 1; |
---|
| 252 | } |
---|
| 253 | } |
---|
| 254 | } |
---|
| 255 | |
---|
| 256 | if (my $filter = $self->get_field('autoMemberFilter')) { |
---|
| 257 | foreach ($self->base->search_objects( |
---|
| 258 | 'user', |
---|
[1904] | 259 | 'oalias=NULL', |
---|
[1782] | 260 | ref $filter ? @{ $filter } : $filter)) { |
---|
| 261 | $users{$_} = 1; |
---|
| 262 | } |
---|
| 263 | } |
---|
| 264 | |
---|
| 265 | my $res = $self->_set_group_members([ keys %users ]); |
---|
| 266 | |
---|
[1737] | 267 | $res; |
---|
[1135] | 268 | } |
---|
| 269 | |
---|
[1912] | 270 | sub _update_employment_manager { |
---|
| 271 | my ($self) = @_; |
---|
| 272 | |
---|
| 273 | my $listEmp = $self->base->db->prepare(q{ |
---|
| 274 | select name from employment join employment_attributes |
---|
| 275 | on employment.ikey = employment_attributes.okey |
---|
| 276 | where firstday < now() and (lastday > now() or lastday is NULL) |
---|
| 277 | and employment_attributes.attr = 'department' and employment_attributes.value = ? |
---|
| 278 | }); |
---|
| 279 | $listEmp->execute($self->id); |
---|
| 280 | while (my $res = $listEmp->fetchrow_hashref()) { |
---|
[1920] | 281 | $self->base->log(LA_DEBUG, "Checking if employment %s is impacted by managedBy change", $res->{name}); |
---|
[1912] | 282 | my $employment = $self->base->get_object('employment', $res->{name}) or next; |
---|
| 283 | $employment->get_attributes('managerContact') and next; |
---|
| 284 | my $dpmt = $employment->_get_attributes('department') or next; |
---|
| 285 | my $odmpt = $employment->base->get_object('group', $dpmt) or next; |
---|
| 286 | my $manager = $odmpt->get_attributes('managedBy') or next; |
---|
| 287 | my $user = $employment->get_attributes('user'); |
---|
| 288 | my $ouser = $employment->base->get_object('user', $user) or next; |
---|
[1920] | 289 | $self->base->log(LA_DEBUG, "Updating manager to $manager for user $user due to dpmt update"); |
---|
[1912] | 290 | $ouser->ReportChange( |
---|
| 291 | 'Update', 'Attr manager updated to match Dpmt manager %s (%s)', |
---|
| 292 | $manager, |
---|
| 293 | $dpmt, |
---|
| 294 | ); |
---|
[1920] | 295 | $ouser->set_fields('manager', $manager); |
---|
[1912] | 296 | } |
---|
| 297 | |
---|
| 298 | return 1; |
---|
| 299 | } |
---|
| 300 | |
---|
[21] | 301 | 1; |
---|
| 302 | |
---|
| 303 | __END__ |
---|
| 304 | |
---|
| 305 | =head1 SEE ALSO |
---|
| 306 | |
---|
[1023] | 307 | L<LATMOS::Accounts::Bases::Sql> |
---|
| 308 | |
---|
[21] | 309 | =head1 AUTHOR |
---|
| 310 | |
---|
| 311 | Olivier Thauvin, E<lt>olivier.thauvin@latmos.ipsl.frE<gt> |
---|
| 312 | |
---|
| 313 | =head1 COPYRIGHT AND LICENSE |
---|
| 314 | |
---|
| 315 | Copyright (C) 2008, 2009 CNRS SA/CETP/LATMOS |
---|
| 316 | |
---|
| 317 | This library is free software; you can redistribute it and/or modify |
---|
| 318 | it under the same terms as Perl itself, either Perl version 5.10.0 or, |
---|
| 319 | at your option, any later version of Perl 5 you may have available. |
---|
| 320 | |
---|
| 321 | =cut |
---|