aboutsummaryrefslogtreecommitdiffstats
path: root/lib/Fripost/Schema/Util.pm
diff options
context:
space:
mode:
Diffstat (limited to 'lib/Fripost/Schema/Util.pm')
-rw-r--r--lib/Fripost/Schema/Util.pm64
1 files changed, 54 insertions, 10 deletions
diff --git a/lib/Fripost/Schema/Util.pm b/lib/Fripost/Schema/Util.pm
index 0f6821c..2c71411 100644
--- a/lib/Fripost/Schema/Util.pm
+++ b/lib/Fripost/Schema/Util.pm
@@ -13,11 +13,12 @@ use utf8;
use Exporter 'import';
our @EXPORT_OK = qw /concat get_perms explode
- must_attrs email_valid split_addr
- canonical_dn ldap_explode_dn ldap_error
+ must_attrs email_valid split_addr dn2mail
+ canonical_dn ldap_explode_dn ldap_error ldap_and_filter
+ clean_ldap_entry
assert softdie/;
use Email::Valid;
-use Net::IDN::Encode;
+use Net::IDN::Encode qw/domain_to_unicode email_to_unicode/;
use Net::LDAP::Util;
use Encode;
@@ -139,20 +140,24 @@ sub split_addr {
my $addr = shift;
my %options = @_;
+ $addr =~ /^(.*)\@([^@]+)$/s;
+ my ($l,$d) = ($1, $2);
+
if (defined $options{'-encode'}) {
my $e = $options{'-encode'};
if ($e eq 'ascii') {
- $addr = Net::IDN::Encode::email_to_ascii($addr);
+ Encode::_utf8_on($d);
+ $addr = Net::IDN::Encode::domain_to_ascii($d);
}
elsif ($e eq 'unicode') {
- $addr = Net::IDN::Encode::email_to_unicode($addr);
+ $d = Net::IDN::Encode::domain_to_unicode($d);
}
else {
- die "Unknown encoding: ". $e;
+ softdie ("Unknown encoding: ". $e, %options);
+ return;
}
}
-
- split /\@/, $addr, 2;
+ return ($l,$d);
}
sub ldap_error {
@@ -180,8 +185,7 @@ sub ldap_error {
$error = $mesg->error if $mesg->code;
}
- return $mesg unless defined $error;
- return unless $error;
+ return 1 unless $error;
if (defined $options{'-error'}) {
${$options{'-error'}} = $error;
@@ -210,10 +214,50 @@ sub softdie {
my $mesg = shift;
my %options = @_;
+ return 1 unless $mesg;
$options{'-die'} = $mesg;
&assert (undef, %options);
}
+sub dn2mail {
+ my $dn = ldap_explode_dn(shift);
+
+ return '@'. domain_to_unicode(lc $dn->[0]->{fvd})
+ if exists $dn->[0]->{fvd};
+ return email_to_unicode(lc $dn->[0]->{fvl} .'@'. lc $dn->[1]->{fvd});
+}
+
+sub ldap_and_filter {
+ my @filters = @_;
+
+ if ($#filters == 0) {
+ return $filters[0];
+ }
+ else {
+ @filters = map {'('.$_.')'} @filters;
+ return '(&'.(join '', @filters).')';
+ }
+}
+
+
+sub clean_ldap_entry {
+ my $attrs = shift;
+
+ foreach (keys %$attrs) {
+ if (defined $attrs->{$_}) {
+ if (ref $attrs->{$_} eq 'ARRAY') {
+ delete $attrs->{$_} unless @{$attrs->{$_}}
+ }
+ elsif (ref $attrs->{$_} eq '') {
+ delete $attrs->{$_} if $attrs->{$_} eq '';
+ }
+ }
+ else {
+ delete $attrs->{$_};
+ }
+ }
+}
+
=head1 AUTHOR
Guilhem Moulin C<< <guilhem at fripost.org> >>