Changeset 1984 for trunk/LATMOS-Accounts/lib
- Timestamp:
- 04/18/17 17:49:15 (7 years ago)
- Location:
- trunk/LATMOS-Accounts/lib/LATMOS/Accounts
- Files:
-
- 2 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/LATMOS-Accounts/lib/LATMOS/Accounts/Bases/OCHelper/User.pm
r1076 r1984 34 34 35 35 if ($info->{contents}{sn}) { 36 my $login = lc(to_ascii($info->{contents}{sn})); 37 $login =~ s/ //g; # strip space in login 38 length($login) > 10 and $login = substr($login, 0, 8); 39 for (1) { 40 $self->base->get_object('user', $login) or do { 41 $info->{name}{content} = $login; 42 last; 43 }; 44 if ($info->{contents}{givenName}) { 45 length($login) > 8 and $login = substr($login, 0, 8); 46 $login .= substr(lc(to_ascii($info->{contents}{givenName})), 0, 1); 47 $self->base->get_object('user', $login) or do { 48 $info->{name}{contents} = $login; 49 last; 50 }; 51 } 36 my $login = buildLogin( 37 sub { 38 !$self->base->get_object('user', $_[0]); 39 }, 40 $info->{contents}{sn}, 41 $info->{contents}{givenName}, 42 ); 43 if ($login) { 44 $info->{name}{content} = $login; 52 45 } 53 46 } -
trunk/LATMOS-Accounts/lib/LATMOS/Accounts/Utils.pm
r1770 r1984 21 21 22 22 @ISA = qw(Exporter); 23 @EXPORT = qw(to_ascii exec_command switch_user run_via_sudo yesno);24 @EXPORT_OK = qw(to_ascii exec_command switch_user run_via_sudo yesno);23 @EXPORT = qw(to_ascii exec_command switch_user run_via_sudo buildLogin yesno); 24 @EXPORT_OK = qw(to_ascii exec_command switch_user run_via_sudo buildLogin yesno); 25 25 26 26 =head2 to_ascii($text) … … 314 314 } 315 315 316 =head2 buildLogin([$cb, ] @names) 317 318 Try to find a proper login from @names. 319 320 Optionnal $cb is a callback to check the solution over exiting data. If return false, another solution is tried 321 322 Example: 323 324 buildLogin(sub { $_[0] ? 1 : 0 }, "sn", "givenName") 325 326 =cut 327 328 sub buildLogin { 329 my (@names) = @_; 330 my $cb = undef; 331 332 if (ref $names[0]) { 333 $cb = shift(@names); 334 } else { 335 $cb = sub { 1 }; # always validating 336 } 337 338 # Cleaning names: 339 foreach (@names) { 340 $_ ||= ''; 341 $_ = lc(to_ascii($_)); 342 s/[^\w]//g; 343 } 344 345 @names = grep { $_ } @names; 346 my $base = shift(@names) or return; 347 my $rest = join('', grep { $_ } @names); 348 349 if ((my $l = length($base)) > 10) { 350 my $len = 8; 351 while ($len < $l) { 352 my $try = substr($base, 0, $len); 353 if ($cb->($try)) { 354 return $try; 355 } 356 $len++; 357 } 358 } elsif ($cb->($base)) { 359 return $base; 360 } 361 362 my $try = $base; 363 while (my $len = length($try) - length($base) + 1) { 364 if ($len > length($rest)) { 365 last; 366 } 367 $try = $base . substr($rest, 0, $len); 368 if ($cb->($try)) { 369 return $try; 370 } 371 } 372 return; 373 } 374 316 375 =head2 yesno($value, $default) 317 376
Note: See TracChangeset
for help on using the changeset viewer.