From c70ea95c7e2e07cccbff9b7cce26e7bb506d1db6 Mon Sep 17 00:00:00 2001 From: Guilhem Moulin Date: Fri, 18 Jan 2013 21:21:17 +0100 Subject: Factorized split_addr. --- lib/Fripost/Schema/Alias.pm | 11 ++++++----- lib/Fripost/Schema/Domain.pm | 2 +- lib/Fripost/Schema/List.pm | 15 ++++++++------- lib/Fripost/Schema/Local.pm | 9 +++++---- lib/Fripost/Schema/Misc.pm | 24 ++++++++++++++++++++++-- lib/Fripost/Schema/User.pm | 13 +++++++------ 6 files changed, 49 insertions(+), 25 deletions(-) (limited to 'lib/Fripost/Schema') 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<< >> =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<< >> =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<< >> =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<< >> =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<< >> =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<< >> =head1 COPYRIGHT -Copyright 2012 Guilhem Moulin. +Copyright 2012,2013 Guilhem Moulin. =head1 LICENSE -- cgit v1.2.3