source: trunk/LATMOS-Accounts/lib/LATMOS/Accounts/Bases/OCHelper/User.pm @ 2528

Last change on this file since 2528 was 2528, checked in by nanardon, 22 months ago

Dont overwrite mails attributes if given

File size: 3.5 KB
RevLine 
[861]1package LATMOS::Accounts::Bases::OCHelper::User;
2
3# $Id: User.pm 2932 2010-08-10 17:19:21Z nanardon $
4
5use strict;
6use warnings;
7use base qw(LATMOS::Accounts::Bases::OCHelper);
8use LATMOS::Accounts::Utils;
[2291]9use LATMOS::Accounts::I18N;
[861]10
[1014]11=head1 NAME
12
[1023]13LATMOS::Accounts::Bases::OCHelper::User -
14Helper to create user in L<LATMOS::Accounts> system
[1014]15
16=cut
17
[861]18sub _step {
19    my ($self, $info) = @_;
[959]20    if ($info->{step} <= 0) {
[861]21        $info->{name}{ask} = 1;
22        push(@{$info->{ask}}, qw(givenName sn));
23        $info->{step} = 1;
[959]24        if (!($info->{name}{content} || 
25              ($info->{contents}{sn}) && $info->{contents}{givenName})) {
26            return 'NEEDINFO';
27        }
28    } 
29    if ($info->{step} == 1) {
[861]30        $info->{step} = 2;
31        my $login = $info->{name}{content};
32        if (!$login) {
33            $info->{name}{ask} = 1;
34            # Try to find a login:
35           
36            if ($info->{contents}{sn}) {
[2291]37
38                # On regarde si on objet de même nom existe:
39                if ($info->{contents}{givenName}) {
40                    if (my @objs = $self->base->search_objects(
41                            'user',
42                            'givenName~' . $info->{contents}{givenName},
[2292]43                            'sn~' . $info->{contents}{sn},
44                            'oalias=NULL' ) ) {
45                        $info->{duplicates} = \@objs;
[2291]46                    }
47                }
[1984]48                my $login = buildLogin(
49                    sub {
50                        !$self->base->get_object('user', $_[0]);
51                    },
52                    $info->{contents}{sn},
53                    $info->{contents}{givenName},
54                );
55                if ($login) {
56                    $info->{name}{content} = $login;
[861]57                }
58            }
59        } else {
60            $self->base->get_object('user', $login) and do {
61                $info->{name}{ask} = 1;
62            }
63        }
64        push(@{$info->{ask}}, 'uidNumber');
65        push(@{$info->{ask}}, 'gidNumber');
[1076]66
67       my %default = $self->base->compute_default(
68            'user', $login || '',
69            %{ $info->{contents} || {} }
70        );
71
72        if ($default{mail}) {
73            push(@{$info->{ask}}, 'mail');
[2528]74            $info->{contents}{mail} ||= $default{mail};
[1076]75        }
[861]76        if (my $attr = $self->base->attribute('user', 'aliases')) {
77            if (!$attr->ro) {
78                push(@{$info->{ask}}, 'aliases');
[2528]79                $info->{contents}{aliases} ||= $default{aliases};
[861]80            }
81        }
82        if (my $attr = $self->base->attribute('user', 'revaliases')) {
83            if (!$attr->ro) {
84                push(@{$info->{ask}}, 'revaliases');
[2528]85                $info->{contents}{revaliases} ||= $default{revaliases};
[861]86            }
87        }
88        return 'NEEDINFO';
89
90
91    } elsif ($info->{step} == 2) {
92        if ($self->base->create_c_object($self->otype,
93                $info->{name}{content},
94                %{$info->{contents} || {}},
95            )) {
96            return 'CREATED';
97        } else {
98            return 'ERROR';
99        }
100    } else {
101        return undef;
102    }
103}
104
1051;
[1014]106
107__END__
108
109=head1 SEE ALSO
110
[1023]111L<LATMOS::Accounts::Bases::OCHelper>
112
[1014]113=head1 AUTHOR
114
115Thauvin Olivier, E<lt>olivier.thauvin@latmos.ipsl.frE<gt>
116
117=head1 COPYRIGHT AND LICENSE
118
119Copyright (C) 2012 by Thauvin Olivier
120
121This library is free software; you can redistribute it and/or modify
122it under the same terms as Perl itself, either Perl version 5.10.0 or,
123at your option, any later version of Perl 5 you may have available.
124
125=cut
Note: See TracBrowser for help on using the repository browser.