source: trunk/LATMOS-Accounts/lib/LATMOS/Accounts/Bases/Ldap/Groupofuniquenames.pm @ 2580

Last change on this file since 2580 was 2580, checked in by nanardon, 9 months ago

Fix: set uniquemember

File size: 4.9 KB
Line 
1package LATMOS::Accounts::Bases::Ldap::Groupofuniquenames;
2
3use 5.010000;
4use strict;
5use warnings;
6
7use base qw(LATMOS::Accounts::Bases::Ldap::objects);
8use Net::LDAP;
9use Net::LDAP::Entry;
10use Net::LDAP::Control::Paged;
11use Net::LDAP::Constant qw( LDAP_CONTROL_PAGED ); 
12use Net::LDAP::Util     qw( escape_filter_value );
13use LATMOS::Accounts::Log;
14
15our $VERSION = (q$Rev: 649 $ =~ /^Rev: (\d+) /)[0];
16
17=head1 NAME
18
19LATMOS::Ldap - Perl extension for blah blah blah
20
21=head1 SYNOPSIS
22
23  use LATMOS::Ldap;
24  blah blah blah
25
26=head1 DESCRIPTION
27
28Stub documentation for LATMOS::Ldap, created by h2xs. It looks like the
29author of the extension was negligent enough to leave the stub
30unedited.
31
32Blah blah blah.
33
34=head1 FUNCTIONS
35
36=cut
37
38sub is_supported {
39    my ($class, $base) = @_;
40    return $base->config('groupofuniquenames_container') ? 1 : 0;
41}
42
43
44sub _class_filter { '(ObjectClass=groupOfUniqueNames)' }
45
46sub _key_attr { 'cn' } 
47
48sub _my_ldap_classes { qw(top groupOfUniqueNames) }
49
50sub _get_attr_schema {
51    my ($class, $base) = @_;
52    $class->SUPER::_get_attr_schema($base,
53    {
54        description => { },
55        uniqueMember => {
56            mandatory => 1,
57            multiple => 1,
58            reference => 'user',
59        },
60        cn => { ro => 1 },
61        dn => { ro => 1 },
62        objectClass => { ro => 1 },
63        owner => {
64            reference => 'user',
65        },
66    }
67    );
68}
69
70sub _create {
71    my ($class, $base, $id, %data) = @_;
72
73    my $entry = Net::LDAP::Entry->new();
74
75    $entry->dn(join(',',
76        sprintf('%s=%s',
77            $class->_dn_attribute($base),
78            escape_filter_value($id)),
79            $base->object_base_dn($class->type),
80    ));
81    $entry->replace(objectClass => [ $class->_my_ldap_classes ],);
82    my %delayed;
83    $data{$class->_key_attribute($base)} = $id;
84    foreach (keys %data) {
85        /^(uniqueMember)$/ and do {
86            my %DNs;
87            foreach my $user ( ref $data{$_} ? @{ $data{$_} } : $data{$_} ) {
88                my $OUser = $base->get_object('user', $user) or next;
89                $DNs{ $OUser->{entry}->dn } = 1;
90            }
91            $data{$_} = [ keys %DNs ];
92        };
93        /^(owner)$/ and do {
94            if ( my $user = $base->get_object( 'user', $data{$_} ) ) {
95                $data{$_} = $user->get_field('dn');
96            } else {
97                delete( $data{$_} );
98            }
99        };
100        $class->_populate_entry($entry, $_, $data{$_});
101    }
102    my $msg = $base->ldap->add($entry);
103    $base->log(LA_ERR, "Cannot create group: %s", $msg->error) if ($msg->code);
104    return if ($msg->code);
105    if (! keys %delayed) { return 1 };
106    my $res = $base->get_object('group', $id)->set_fields(%delayed);
107    return defined($res) ? 1 : 0;
108}
109
110sub get_field {
111    my ($self, $field) = @_;
112
113    $field eq 'uniqueMember' and do {
114        my @res;
115        foreach my $dn ($self->{entry}->get_value('uniqueMember')) {
116            my $User = $self->base->_get_object_from_dn($dn) or next;
117            push(@res, $User->get_value( LATMOS::Accounts::Bases::Ldap::User->_key_attribute($self->base) ) );
118        }
119        return [ sort(@res) ];
120    };
121    $field eq 'owner' and do {
122        my $dn = $self->SUPER::get_field($field) or return;
123        my $manager = $self->base->_get_object_from_dn($dn) or return;
124        return $manager->get_value(__PACKAGE__->_key_attribute($self->base));
125    };
126
127    $self->SUPER::get_field($field);
128}
129
130sub set_fields {
131    my ($self, %data) = @_;
132    my %ndata;
133    while (my ($f, $val) = each(%data)) {
134        $f eq 'uniqueMember' and do {
135            my %users;
136            $val = [ $val ] unless(ref $val);
137            $users{$_}{e} = 1 foreach (grep { defined($_) } @{ $self->get_field('uniqueMember') || []});
138            $users{$_}{n} = 1 foreach (grep { defined($_) } @{ $val || []});
139            foreach (keys %users) {
140                $users{$_}{e} && $users{$_}{n} and next;
141                my $user = $self->base->get_object('user', $_) or next;
142                if ($users{$_}{e}) {
143                    $self->{entry}->delete(uniqueMember => $user->get_field('dn'));
144                } elsif ($users{$_}{n}) {
145                    $self->{entry}->add(uinqueMember => $user->get_field('dn'));
146                } # else {} # can't happen
147            }
148            next;
149        };
150        $f eq 'owner' && $val and do {
151            if (my $user = $self->base->get_object('user', $val) ) {
152                $val = $user->get_field('dn');
153            } else {
154                $val = undef;
155            }
156        };
157        $ndata{$f} = $val;
158    }
159    $self->SUPER::set_fields(%ndata);
160}
161
1621;
163
164__END__
165
166=head1 SEE ALSO
167
168=head1 AUTHOR
169
170Olivier Thauvin, E<lt>olivier.thauvin@aerov.jussieu.frE<gt>
171
172=head1 COPYRIGHT AND LICENSE
173
174Copyright (C) 2008 CNRS SA/CETP/LATMOS
175
176This library is free software; you can redistribute it and/or modify
177it under the same terms as Perl itself, either Perl version 5.10.0 or,
178at your option, any later version of Perl 5 you may have available.
179
180
181=cut
Note: See TracBrowser for help on using the repository browser.