The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
# ============================================================================
package Mail::Builder::Address;
# ============================================================================

use namespace::autoclean;
use Moose;
use Mail::Builder::TypeConstraints;

use Carp;
use Encode qw/encode decode/; 

use Email::Valid;

our $VERSION = $Mail::Builder::VERSION;

has 'email' => (
    is              => 'rw',
    isa             => 'Mail::Builder::Type::EmailAddress',
    required        => 1,
);

has 'name' => (
    is              => 'rw',
    isa             => 'Str',
    predicate       => 'has_name',
);

has 'comment' => (
    is              => 'rw',
    isa             => 'Str',
    predicate       => 'has_comment',
);

=encoding utf8

=head1 NAME

Mail::Builder::Address - Module for handling e-mail addresses

=head1 SYNOPSIS

  use Mail::Builder;
  
  my $mail = Mail::Builder::Address->new('mightypirate@meele-island.mq','Gaybrush Thweedwood');
  # Now correct type in the display name and address
  $mail->name('Guybrush Threepwood');
  $mail->email('verymightypirate@meele-island.mq');
  $mail->comment('Mighty Pirate (TM)');
  
  # Serialize
  print $mail->serialize;
  
  # Use the address as a recipient for  Mail::Builder object
  $mb->to($mail); # Removes all other recipients 
  OR
  $mb->to->add($mail); # Adds one more recipient (without removing the existing ones)

=head1 DESCRIPTION

This is a simple module for handling e-mail addresses. It can store the address
and an optional display name.

=head1 METHODS

=head2 Constructor

=head3 new

 Mail::Builder::Address->new(EMAIL[,DISPLAY NAME[,COMMENT]]);
 OR
 Mail::Builder::Address->new({
     email      => EMAIL,
     [ name     => DISPLAY NAME, ]
     [ comment  => COMMENT, ]
 })
 OR 
 my $email = Email::Address->parse(...);
 Mail::Builder::Address->new($email);

Simple constructor

=cut


around BUILDARGS => sub {
    my $orig = shift;
    my $class = shift;
    my @args = @_;
    
    my $args_length = scalar @args;
    my %params;
    
    if ($args_length == 1) {
        if (blessed $args[0] && $args[0]->isa('Email::Address')) {
            $params{email} = $args[0]->address;
            $params{name} = $args[0]->phrase;
            $params{comment} = $args[0]->comment;
        } elsif (ref $args[0] eq 'HASH') {
            return $class->$orig($args[0]);
        } elsif (ref $args[0] eq 'ARRAY') {
            $params{email} = $args[0]->[0];
            $params{name} = $args[0]->[1];
            $params{comment} = $args[0]->[2];
        } else {
            $params{email} = $args[0];
        }
    } elsif ($args_length == 2
        && $args[0] ne 'email') {
        $params{email} = $args[0];
        $params{name} = $args[1];
    } elsif ($args_length == 3) {
        $params{email} = $args[0];
        $params{name} = $args[1];
        $params{comment} = $args[2];
    } else {
        return $class->$orig(@args);
    }
    
    delete $params{name}
        unless defined $params{name} && $params{name} !~ /^\s*$/;
    delete $params{comment}
        unless defined $params{comment} && $params{comment} !~ /^\s*$/;
    
    return $class->$orig(\%params);
};

sub address {
    my $self = shift;
    return $self->email(@_);
}

=head2 Public Methods

=head3 serialize

Prints the address as required for creating the e-mail header.

=cut

sub serialize {
    my ($self) = @_;
    
    return $self->email
        unless $self->has_name;
    
    my $name = $self->name;
    $name =~ s/"/\\"/g;
    
    my $return = sprintf '"%s" <%s>',encode('MIME-Header', $name),$self->email;
    $return .= ' '.$self->comment
        if $self->has_comment;
    
    return $return;
}

=head3 compare

 $obj->compare(OBJECT);
 or
 $obj->compare(E-MAIL);

Checks if two address objects contain the same e-mail address. Returns true 
or false. The compare method does not check if the address names of the
two objects are identical.

Instead of a C<Mail::Builder::Address> object you can also pass a 
scalar value representing the e-mail address.

=cut

sub compare {
    my ($self,$compare) = @_;
    
    return 0 
        unless (defined $compare);
    
    if (blessed($compare)) {
        return 0 unless $compare->isa(__PACKAGE__);
        return (uc($self->email) eq uc($compare->email)) ? 1:0;
    } else {
        return ( uc($compare) eq uc($self->{email}) ) ? 1:0;
    }
}

sub empty {
    croak('DEPRECATED')
}

__PACKAGE__->meta->make_immutable;

1;

=head2 Accessors

=head3 name

Display name

=head3 email

E-mail address. Will be checked with L<Email::Valid>
L<Email::Valid> options may be changed by setting the appropriate values
in the %Mail::Builder::TypeConstraints::EMAILVALID hash.

Eg. if you want to disable the check for valid TLDs you can set the 'tldcheck'
option (without dashes 'tldcheck' and not '-tldcheck'):

 $Mail::Builder::TypeConstraints::EMAILVALID{tldcheck} = 0;

Required

=head3 comment

Comment

=head1 AUTHOR

    Maroš Kollár
    CPAN ID: MAROS
    maros [at] k-1.com
    http://www.k-1.com

=cut