package LATMOS::Accounts::Bases::OCHelper::User; # $Id: User.pm 2932 2010-08-10 17:19:21Z nanardon $ use strict; use warnings; use base qw(LATMOS::Accounts::Bases::OCHelper); use LATMOS::Accounts::Utils; =head1 NAME LATMOS::Accounts::Bases::OCHelper::User - Helper to create user in L system =cut sub _step { my ($self, $info) = @_; if ($info->{step} <= 0) { $info->{name}{ask} = 1; push(@{$info->{ask}}, qw(givenName sn)); $info->{step} = 1; if (!($info->{name}{content} || ($info->{contents}{sn}) && $info->{contents}{givenName})) { return 'NEEDINFO'; } } if ($info->{step} == 1) { $info->{step} = 2; my $login = $info->{name}{content}; if (!$login) { $info->{name}{ask} = 1; # Try to find a login: if ($info->{contents}{sn}) { my $login = lc(to_ascii($info->{contents}{sn})); $login =~ s/ //g; # strip space in login length($login) > 10 and $login = substr($login, 0, 8); for (1) { $self->base->get_object('user', $login) or do { $info->{name}{content} = $login; last; }; if ($info->{contents}{givenName}) { length($login) > 8 and $login = substr($login, 0, 8); $login .= substr(lc(to_ascii($info->{contents}{givenName})), 0, 1); $self->base->get_object('user', $login) or do { $info->{name}{contents} = $login; last; }; } } } } else { $self->base->get_object('user', $login) and do { $info->{name}{ask} = 1; } } push(@{$info->{ask}}, 'uidNumber'); push(@{$info->{ask}}, 'gidNumber'); my $mailid = $info->{contents}{givenName} && $info->{contents}{sn} ? sprintf('%s.%s', to_ascii(lc($info->{contents}{givenName})), to_ascii(lc($info->{contents}{sn})),) : undef; $mailid =~ s/ /-/g if ($mailid); # replace space by '-' in mail push(@{$info->{ask}}, 'mail'); $info->{contents}{mail} = $mailid && $self->base->{defattr}{'user.maildomain'} ? sprintf('%s@%s', $mailid, $self->base->{defattr}{'user.maildomain'}) : undef; if (my $attr = $self->base->attribute('user', 'aliases')) { if (!$attr->ro) { push(@{$info->{ask}}, 'aliases'); $info->{contents}{aliases} = $mailid } } if (my $attr = $self->base->attribute('user', 'revaliases')) { if (!$attr->ro) { push(@{$info->{ask}}, 'revaliases'); $info->{contents}{revaliases} = $mailid } } return 'NEEDINFO'; } elsif ($info->{step} == 2) { if ($self->base->create_c_object($self->otype, $info->{name}{content}, %{$info->{contents} || {}}, )) { return 'CREATED'; } else { return 'ERROR'; } } else { return undef; } } 1; __END__ =head1 SEE ALSO L =head1 AUTHOR Thauvin Olivier, Eolivier.thauvin@latmos.ipsl.frE =head1 COPYRIGHT AND LICENSE Copyright (C) 2012 by Thauvin Olivier This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself, either Perl version 5.10.0 or, at your option, any later version of Perl 5 you may have available. =cut