From 99b3ecbaf20b4e47ee6a403fd30268939e6e1244 Mon Sep 17 00:00:00 2001
From: Guilhem Moulin <guilhem.moulin@fripost.org>
Date: Fri, 25 Jan 2013 02:49:26 +0100
Subject: Updated and redocumented Fripost::Schema::Domain.

---
 lib/Fripost/Schema/Util.pm | 64 ++++++++++++++++++++++++++++++++++++++--------
 1 file changed, 54 insertions(+), 10 deletions(-)

(limited to 'lib/Fripost/Schema/Util.pm')

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> >>
-- 
cgit v1.2.3