package Fripost::Schema::Type::Alias; use 5.010_000; use warnings; use strict; use base qw/Net::LDAP/; our $VERSION = '0.01'; ####################################################################### # Search an alias, and return the corresponding entries if found. If no # alias is given, returns all aliases. # Filters on values of both keys `address' and `goto' (unless they are # undefined). # An extra key `domain' can be given to scope the search on aliases for # this domain only. sub search { my $self = shift; my $alias = shift; my ($username, $domain); $domain = $alias->{domain} if defined $alias->{domain}; ($username, $domain) = split /\@/, $alias->{address}, 2 if defined $alias->{address}; my $base = $self->{_options}->{base_dn}; $base = join ',', ( 'dc='.$domain, $base ) if defined $domain; my @filters = ('(ObjectClass=virtualAliases)'); push @filters, '(mailLocalAddress=' .$username. ')' if defined $username; push @filters, '(mailTarget=' .$alias->{goto}. ')' if defined $alias->{goto}; my $res = $self->{_ldap}->search( base => $base, scope => 'subtree', attrs => [ 'mailLocalAddress', 'mailTarget', 'isActive' ], filter => Fripost::Schema::Utils::mkAndFilter( @filters ) ); die "Error: " .$res->error. "\n" if $res->code; return $res; } # Add the given alias sub add { my $self = shift; my $alias = shift; # TODO: detect cycles die "Error: Cannot create alias `" .$alias->{address}. "' targetting to itself.\n" if $alias->{address} eq $alias->{goto}; my ($username, $domain) = split /\@/, $alias->{address}, 2; my $base = join ',', ( 'mailTarget='.$alias->{goto} , 'dc='. $domain , $self->{_options}->{base_dn} ); my @attrs = ( mailLocalAddress => $username ); my $res; if ($self->search({ goto => $alias->{goto}, domain => $domain })->count) { $res = $self->{_ldap}->modify( $base, add => [ @attrs ] ); } else { $res = $self->{_ldap}->add( $base, attrs => [ objectClass => [ 'inetLocalMailRecipient', 'virtualAliases' ] , @attrs , isActive => $alias->{isActive} ] ); } die "Error: " .$res->error. "\n" if $res->code; return $res; } ####################################################################### 1; =head1 NAME Fripost::Schema::Type::Alias - =head1 AUTHOR Guilhem Moulin C<< >> =head1 COPYRIGHT Copyright 2012 Guilhem Moulin, all rights reserved. =head1 LICENSE This program is free software; you can redistribute it and/or modify it under the same terms as perl itself. =cut 1; # End of Alias.pm __END__