Factorized split_addr.

6 files changed, 49 insertions, 25 deletions

diff --git a/lib/Fripost/Schema/Alias.pm b/lib/Fripost/Schema/Alias.pm
index 7d729f0..f575b4c 100644
--- a/lib/Fripost/Schema/Alias.pm
+++ b/lib/Fripost/Schema/Alias.pm
@@ -17,7 +17,8 @@ use warnings;
 use utf8;
 
 use parent 'Fripost::Schema';
-use Fripost::Schema::Misc qw/concat explode must_attrs email_valid/;
+use Fripost::Schema::Misc qw/concat explode must_attrs email_valid
+                             split_addr/;
 use Net::IDN::Encode qw/domain_to_ascii
                         email_to_ascii email_to_unicode/;
 
@@ -79,7 +80,7 @@ sub replace {
     }
 
     eval {
-        my ($l,$d) = split /\@/, email_to_ascii($a->{alias}), 2;
+        my ($l,$d) = split_addr( $a->{alias}, -encoding => 'ascii' );
         &_is_valid($a);
         my $mesg = $self->ldap->modify(
                        "fva=$l,fvd=$d,".$self->suffix,
@@ -112,7 +113,7 @@ sub add {
 
     eval {
         die "Missing alias name\n" unless $a->{alias} =~ /^.+\@.+$/;
-        my ($l,$d) = split /\@/, email_to_ascii($a->{alias}), 2;
+        my ($l,$d) = split_addr( $a->{alias}, -encoding => 'ascii' );
         &_is_valid($a);
         die "‘".$a->{alias}."’ already exists\n"
             if $self->local->exists($a->{alias},%options);
@@ -144,7 +145,7 @@ Delete the given alias.
 
 sub delete {
     my $self = shift;
-    my ($l,$d) = split /\@/, email_to_ascii(shift), 2;
+    my ($l,$d) = split_addr( shift, -encoding => 'ascii' );
     my %options = @_;
 
     my $mesg = $self->ldap->delete( "fva=$l,fvd=$d,".$self->suffix );
@@ -186,7 +187,7 @@ Guilhem Moulin C<< <guilhem at fripost.org> >>
 
 =head1 COPYRIGHT
 
-Copyright 2012 Guilhem Moulin.
+Copyright 2012,2013 Guilhem Moulin.
 
 =head1 LICENSE
 
diff --git a/lib/Fripost/Schema/Domain.pm b/lib/Fripost/Schema/Domain.pm
index 80810e5..0e1de49 100644
--- a/lib/Fripost/Schema/Domain.pm
+++ b/lib/Fripost/Schema/Domain.pm
@@ -196,7 +196,7 @@ Guilhem Moulin C<< <guilhem at fripost.org> >>
 
 =head1 COPYRIGHT
 
-Copyright 2012 Guilhem Moulin.
+Copyright 2012,2013 Guilhem Moulin.
 
 =head1 LICENSE
 
diff --git a/lib/Fripost/Schema/List.pm b/lib/Fripost/Schema/List.pm
index ad06b50..e6605f0 100644
--- a/lib/Fripost/Schema/List.pm
+++ b/lib/Fripost/Schema/List.pm
@@ -17,7 +17,8 @@ use warnings;
 use utf8;
 
 use parent 'Fripost::Schema';
-use Fripost::Schema::Misc qw/concat explode must_attrs email_valid/;
+use Fripost::Schema::Misc qw/concat explode must_attrs email_valid
+                             split_addr/;
 use Net::IDN::Encode qw/domain_to_ascii
                         email_to_ascii email_to_unicode/;
 use Mail::GnuPG;
@@ -116,7 +117,7 @@ sub add {
 
     eval {
         die "Missing list name\n" unless $l->{list} =~ /^.+\@.+$/;
-        my ($l2,$d) = split /\@/, email_to_ascii($l->{list}), 2;
+        my ($l2,$d) = split_addr ( $l->{list}, -encoding => 'ascii' );
         must_attrs( $l, 'transport' );
         &_is_valid($l);
         die "‘".$l->{list}."’ already exists\n"
@@ -171,7 +172,7 @@ the ListCreator entity, and the list is not known by the list manager.
 
 sub is_pending {
     my $self = shift;
-    my ($l,$d) = split /\@/, email_to_ascii(shift), 2;
+    my ($l,$d) = split_addr( shift, -encoding => 'ascii' );
     my %options = @_;
 
     my $mesg = $self->ldap->search(
@@ -202,7 +203,7 @@ Add the lists commands, and remove the pending status.
 
 sub add_commands {
     my $self = shift;
-    my ($l,$d) = split /\@/, email_to_ascii(shift), 2;
+    my ($l,$d) = split_addr( shift, -encoding => 'ascii' );
     my $cmds = shift;
     my %options = @_;
 
@@ -234,7 +235,7 @@ disk, but merely delete the list entry in the LDAP directory.
 
 sub delete {
     my $self = shift;
-    my ($l,$d) = split /\@/, email_to_ascii(shift), 2;
+    my ($l,$d) = split_addr( shift, -encoding => 'ascii' );
     my %options = @_;
 
     my $mesg = $self->ldap->delete( "fvl=$l,fvd=$d,".$self->suffix );
@@ -267,7 +268,7 @@ sub _is_valid {
     must_attrs( $l, qw/list isactive/ );
     $l->{list} = email_valid( $l->{list}, -exact => 1 );
 
-    my ($l2,$d) = split /\@/, $l->{list}, 2;
+    my ($l2,$d) = split_addr( $l->{list} );
     foreach ( qw/admin bounces confirm join leave owner request subscribe unsubscribe bounce sendkey/ ){
         die "Invalid list name: ‘".$l->{list}."’\n" if $l2 =~ /-$_$/;
     }
@@ -286,7 +287,7 @@ Guilhem Moulin C<< <guilhem at fripost.org> >>
 
 =head1 COPYRIGHT
 
-Copyright 2012 Guilhem Moulin.
+Copyright 2012,2013 Guilhem Moulin.
 
 =head1 LICENSE
 
diff --git a/lib/Fripost/Schema/Local.pm b/lib/Fripost/Schema/Local.pm
index 400b4e5..e2e7a4b 100644
--- a/lib/Fripost/Schema/Local.pm
+++ b/lib/Fripost/Schema/Local.pm
@@ -17,8 +17,9 @@ use warnings;
 use utf8;
 
 use parent 'Fripost::Schema';
-use Fripost::Schema::Misc 'concat';
+use Fripost::Schema::Misc qw/concat split_addr/;
 use Net::IDN::Encode qw/email_to_ascii email_to_unicode/;
+use Net::LDAP::Util 'escape_filter_value';
 
 
 =head1 METHODS
@@ -39,7 +40,7 @@ sub get {
     my %options = @_;
     my $concat = $options{'-concat'};
 
-    my ($l,$d) = split /\@/, email_to_ascii($loc), 2;
+    my ($l,$d) = split_addr( $loc, -encoding => 'ascii' );
     my $locals = $self->ldap->search(
                      base => "fvd=$d,".$self->suffix,
                      scope => 'one',
@@ -147,7 +148,7 @@ sub exists {
             die $options{'-die'}."\n" if defined $options{'-die'};
             die $mesg->error."\n";
         }
-        
+
     }
     return 0;
 }
@@ -171,7 +172,7 @@ Guilhem Moulin C<< <guilhem at fripost.org> >>
 
 =head1 COPYRIGHT
 
-Copyright 2012 Guilhem Moulin.
+Copyright 2012,2013 Guilhem Moulin.
 
 =head1 LICENSE
 
diff --git a/lib/Fripost/Schema/Misc.pm b/lib/Fripost/Schema/Misc.pm
index 114e01b..9ae8cdc 100644
--- a/lib/Fripost/Schema/Misc.pm
+++ b/lib/Fripost/Schema/Misc.pm
@@ -13,7 +13,8 @@ use utf8;
 
 use Exporter 'import';
 our @EXPORT_OK = qw /concat get_perms explode
-                     must_attrs email_valid/;
+                     must_attrs email_valid
+                     split_addr/;
 use Email::Valid;
 use Net::IDN::Encode;
 use Encode;
@@ -115,6 +116,25 @@ sub email_valid {
     return $addr;
 }
 
+sub split_addr {
+    my $addr = shift;
+    my %options = @_;
+
+    if (defined $options{'-encoding'}) {
+        if ($options{'-encoding'} eq 'ascii') {
+            $addr = Net::IDN::Encode::email_to_ascii($addr);
+        }
+        elsif ($options{'-encoding'} eq 'unicode') {
+            $addr = Net::IDN::Encode::email_to_unicode($addr);
+        }
+        else {
+            die "Unknown encoding: ". $options{'-encoding'};
+        }
+    }
+
+    split /\@/, $addr, 2;
+}
+
 
 =head1 AUTHOR
 
@@ -122,7 +142,7 @@ Guilhem Moulin C<< <guilhem at fripost.org> >>
 
 =head1 COPYRIGHT
 
-Copyright 2012 Guilhem Moulin.
+Copyright 2012,2013 Guilhem Moulin.
 
 =head1 LICENSE
 
diff --git a/lib/Fripost/Schema/User.pm b/lib/Fripost/Schema/User.pm
index 11f5e28..c1d559a 100644
--- a/lib/Fripost/Schema/User.pm
+++ b/lib/Fripost/Schema/User.pm
@@ -17,7 +17,8 @@ use warnings;
 use utf8;
 
 use parent 'Fripost::Schema';
-use Fripost::Schema::Misc qw/concat explode must_attrs email_valid/;
+use Fripost::Schema::Misc qw/concat explode must_attrs email_valid
+                             split_addr/;
 use Net::IDN::Encode qw/domain_to_ascii
                         email_to_ascii email_to_unicode/;
 
@@ -81,7 +82,7 @@ sub replace {
     }
 
     eval {
-        my ($l,$d) = split /\@/, email_to_ascii($m->{user}), 2;
+        my ($l,$d) = split_addr( $m->{user}, -encoding => 'ascii' );
         &_is_valid($m);
         my $mesg = $self->ldap->modify(
                        "fvu=$l,fvd=$d,".$self->suffix,
@@ -105,7 +106,7 @@ may want to hash it before hand.
 
 sub passwd {
     my $self = shift;
-    my ($l,$d) = split /\@/, email_to_ascii(shift), 2;
+    my ($l,$d) = split_addr( shift, -encoding => 'ascii' );
     my $pw = shift;
     my %options = @_;
 
@@ -135,7 +136,7 @@ sub add {
 
     eval {
         die "Missing user name\n" unless $m->{user} =~ /^.+\@.+$/;
-        my ($l,$d) = split /\@/, email_to_ascii($m->{user}), 2;
+        my ($l,$d) = split_addr( $m->{user}, -encoding => 'ascii' );
         &_is_valid($m);
         die "‘".$m->{user}."’ already exists\n"
             if $self->local->exists($m->{user},%options);
@@ -170,7 +171,7 @@ but merely delete its entry in the LDAP directory.
 
 sub delete {
     my $self = shift;
-    my ($l,$d) = split /\@/, email_to_ascii(shift), 2;
+    my ($l,$d) = split_addr( shift, -encoding => 'ascii' );
     my %options = @_;
 
     my $mesg = $self->ldap->delete( "fvu=$l,fvd=$d,".$self->suffix );
@@ -213,7 +214,7 @@ Guilhem Moulin C<< <guilhem at fripost.org> >>
 
 =head1 COPYRIGHT
 
-Copyright 2012 Guilhem Moulin.
+Copyright 2012,2013 Guilhem Moulin.
 
 =head1 LICENSE