package Sisimai::Address;
use feature ':5.10';
use strict;
use warnings;
use Class::Accessor::Lite;
use Sisimai::RFC5322;

my $Indicators = {
    'email-address' => (1 << 0),    # <neko@example.org>
    'quoted-string' => (1 << 1),    # "Neko, Nyaan"
    'comment-block' => (1 << 2),    # (neko)
};
my $ValidEmail = qr{(?>
    (?:([^\s]+|["].+?["]))          # local part
    [@]
    (?:([^@\s]+|[0-9A-Za-z:\.]+))   # domain part
    )
}x;
my $undisclosed = 'libsisimai.org.invalid';
my $roaccessors = [
    'address',  # [String] Email address
    'user',     # [String] local part of the email address
    'host',     # [String] domain part of the email address
    'verp',     # [String] VERP
    'alias',    # [String] alias of the email address
];
my $rwaccessors = [
    'name',     # [String] Display name
    'comment',  # [String] (Comment)
];
Class::Accessor::Lite->mk_ro_accessors(@$roaccessors);
Class::Accessor::Lite->mk_accessors(@$rwaccessors);

sub undisclosed { 
    # Return pseudo recipient or sender address
    # @param    [String] atype  Address type: 'r' or 's'
    # @return   [String, Undef] Pseudo recipient address or sender address or
    #                           Undef when the $argv1 is neither 'r' nor 's'
    my $class = shift;
    my $atype = shift || return undef;

    return undef unless $atype =~ /\A(?:r|s)\z/;
    my $local = $atype eq 'r' ? 'recipient' : 'sender';
    return sprintf("undisclosed-%s-in-headers%s%s", $local, '@', $undisclosed);
}

sub new {
    # Old constructor of Sisimai::Address, wrapper method of make()
    # @param        [String] email            Email address
    # @return       [Sisimai::Address, Undef] Object or Undef when the email 
    #                                         address was not valid.
    my $class = shift;
    my $email = shift // return undef;
    my $addrs = __PACKAGE__->find($email);

    return undef unless $addrs;
    return undef unless scalar @$addrs;
    return __PACKAGE__->make($addrs->[0]);
}

sub make {
    # New constructor of Sisimai::Address
    # @param    [Hash] argvs        Email address, name, and other elements
    # @return   [Sisimai::Address]  Object or Undef when the email address was
    #                               not valid.
    # @since    v4.22.1
    my $class = shift;
    my $argvs = shift // return undef;
    my $thing = {
        'address' => '',    # Entire email address
        'user'    => '',    # Local part
        'host'    => '',    # Domain part
        'verp'    => '',    # VERP
        'alias'   => '',    # Alias
        'comment' => '',    # Comment
        'name'    => '',    # Display name
    };

    return undef unless ref $argvs eq 'HASH';
    return undef unless exists $argvs->{'address'};
    return undef unless $argvs->{'address'};

    if( $argvs->{'address'} =~ /\A([^\s]+)[@]([^@]+)\z/ ||
        $argvs->{'address'} =~ /\A(["].+?["])[@]([^@]+)\z/ ) {
        # Get the local part and the domain part from the email address
        my $lpart = $1;
        my $dpart = $2;
        my $email = __PACKAGE__->expand_verp($argvs->{'address'});
        my $alias = 0;

        unless( $email ) {
            # Is not VERP address, try to expand the address as an alias
            $email = __PACKAGE__->expand_alias($argvs->{'address'});
            $alias = 1 if $email;
        }

        if( $email =~ /\A.+[@].+?\z/ ) {
            # The address is a VERP or an alias
            if( $alias ) {
                # The address is an alias: neko+nyaan@example.jp
                $thing->{'alias'} = $argvs->{'address'};

            } else {
                # The address is a VERP: b+neko=example.jp@example.org
                $thing->{'verp'}  = $argvs->{'address'};
            }
        }
        $thing->{'user'} = $lpart;
        $thing->{'host'} = $dpart;
        $thing->{'address'} = $lpart.'@'.$dpart;

    } else {
        # The argument does not include "@"
        return undef unless Sisimai::RFC5322->is_mailerdaemon($argvs->{'address'});
        return undef if rindex($argvs->{'address'}, ' ') > -1;

        # The argument does not include " "
        $thing->{'user'}    = $argvs->{'address'};
        $thing->{'address'} = $argvs->{'address'};
    }

    $thing->{'name'}    = $argvs->{'name'}    || '';
    $thing->{'comment'} = $argvs->{'comment'} || '';
    return bless($thing, __PACKAGE__);
}

sub find {
    # Email address parser with a name and a comment
    # @param    [String] argv1  String including email address
    # @param    [Boolean] addrs 0 = Returns list including all the elements
    #                           1 = Returns list including email addresses only
    # @return   [Array, Undef]  Email address list or Undef when there is no 
    #                           email address in the argument
    # @since    v4.22.0
    my $class = shift;
    my $argv1 = shift // return undef;
    my $addrs = shift // undef;

    $argv1 =~ s/[\r\n]//g;  # Remove new line codes

    my $emailtable = { 'address' => '', 'name' => '', 'comment' => '' };
    my $addrtables = [];
    my $readbuffer = [];
    my $readcursor = 0;

    my $v = $emailtable;   # temporary buffer
    my $p = '';            # current position

    for my $e ( split('', $argv1) ) {
        # Check each characters
        if( grep { $e eq $_ } ('<', '>', '(', ')', '"', ',') ) {
            # The character is a delimiter character
            if( $e eq ',' ) {
                # Separator of email addresses or not
                if(  index($v->{'address'}, '<') == 0 &&
                    rindex($v->{'address'}, '@') > -1 &&
                    substr($v->{'address'}, -1, 1) eq '>' ) {
                    # An email address has already been picked
                    if( $readcursor & $Indicators->{'comment-block'} ) {
                        # The cursor is in the comment block (Neko, Nyaan)
                        $v->{'comment'} .= $e;

                    } elsif( $readcursor & $Indicators->{'quoted-string'} ) {
                        # "Neko, Nyaan"
                        $v->{'name'} .= $e;

                    } else {
                        # The cursor is not in neither the quoted-string nor the comment block
                        $readcursor = 0;    # reset cursor position
                        push @$readbuffer, $v;
                        $v = { 'address' => '', 'name' => '', 'comment' => '' };
                        $p = '';
                    }
                } else {
                    # "Neko, Nyaan" <neko@nyaan.example.org> OR <"neko,nyaan"@example.org>
                    $p ? ($v->{ $p } .= $e) : ($v->{'name'} .= $e);
                }
                next;
            } # End of if(',')

            if( $e eq '<' ) {
                # <: The beginning of an email address or not
                if( $v->{'address'} ) {
                    $p ? ($v->{ $p } .= $e) : ($v->{'name'} .= $e);

                } else {
                    # <neko@nyaan.example.org>
                    $readcursor |= $Indicators->{'email-address'};
                    $v->{'address'} .= $e;
                    $p = 'address';
                }
                next;
            } # End of if('<')

            if( $e eq '>' ) {
                # >: The end of an email address or not
                if( $readcursor & $Indicators->{'email-address'} ) {
                    # <neko@example.org>
                    $readcursor &= ~$Indicators->{'email-address'};
                    $v->{'address'} .= $e;
                    $p = '';

                } else {
                    # a comment block or a display name
                    $p ? ($v->{'comment'} .= $e) : ($v->{'name'} .= $e);
                }
                next;
            } # End of if('>')

            if( $e eq '(' ) {
                # The beginning of a comment block or not
                if( $readcursor & $Indicators->{'email-address'} ) {
                    # <"neko(nyaan)"@example.org> or <neko(nyaan)@example.org>
                    if( rindex($v->{'address'}, '"') > -1 ) {
                        # Quoted local part: <"neko(nyaan)"@example.org>
                        $v->{'address'} .= $e;

                    } else {
                        # Comment: <neko(nyaan)@example.org>
                        $readcursor |= $Indicators->{'comment-block'};
                        $v->{'comment'} .= ' ' if substr($v->{'comment'}, -1, 1) eq ')';
                        $v->{'comment'} .= $e;
                        $p = 'comment';
                    }
                } elsif( $readcursor & $Indicators->{'comment-block'} ) {
                    # Comment at the outside of an email address (...(...)
                    $v->{'comment'} .= ' ' if substr($v->{'comment'}, -1, 1) eq ')';
                    $v->{'comment'} .= $e;

                } elsif( $readcursor & $Indicators->{'quoted-string'} ) {
                    # "Neko, Nyaan(cat)", Deal as a display name
                    $v->{'name'} .= $e;

                } else {
                    # The beginning of a comment block
                    $readcursor |= $Indicators->{'comment-block'};
                    $v->{'comment'} .= ' ' if substr($v->{'comment'}, -1, 1) eq ')';
                    $v->{'comment'} .= $e;
                    $p = 'comment';
                }
                next;
            } # End of if('(')

            if( $e eq ')' ) {
                # The end of a comment block or not
                if( $readcursor & $Indicators->{'email-address'} ) {
                    # <"neko(nyaan)"@example.org> OR <neko(nyaan)@example.org>
                    if( rindex($v->{'address'}, '"') > -1 ) {
                        # Quoted string in the local part: <"neko(nyaan)"@example.org>
                        $v->{'address'} .= $e;

                    } else {
                        # Comment: <neko(nyaan)@example.org>
                        $readcursor &= ~$Indicators->{'comment-block'};
                        $v->{'comment'} .= $e;
                        $p = 'address';
                    }
                } elsif( $readcursor & $Indicators->{'comment-block'} ) {
                    # Comment at the outside of an email address (...(...)
                    $readcursor &= ~$Indicators->{'comment-block'};
                    $v->{'comment'} .= $e;
                    $p = '';

                } else {
                    # Deal as a display name
                    $readcursor &= ~$Indicators->{'comment-block'};
                    $v->{'name'} .= $e;
                    $p = '';
                }
                next;
            } # End of if(')')

            if( $e eq '"' ) {
                # The beginning or the end of a quoted-string
                if( $p ) {
                    # email-address or comment-block
                    $v->{ $p } .= $e;

                } else {
                    # Display name
                    $v->{'name'} .= $e;
                    if( $readcursor & $Indicators->{'quoted-string'} ) {
                        # "Neko, Nyaan"
                        unless( $v->{'name'} =~ /\x5c["]\z/ ) {
                            # "Neko, Nyaan \"...
                            $readcursor &= ~$Indicators->{'quoted-string'};
                            $p = '';
                        }
                    }
                }
                next;
            } # End of if('"')
        } else {
            # The character is not a delimiter
            $p ? ($v->{ $p } .= $e) : ($v->{'name'} .= $e);
            next;
        }
    }

    if( $v->{'address'} ) {
        # Push the latest values
        push @$readbuffer, $v;

    } else {
        # No email address like <neko@example.org> in the argument
        if( $v->{'name'} =~ $ValidEmail ) {
            # String like an email address will be set to the value of "address"
             $v->{'address'} = $1.'@'.$2;

        } elsif( Sisimai::RFC5322->is_mailerdaemon($v->{'name'}) ) {
            # Allow if the argument is MAILER-DAEMON
            $v->{'address'} = $v->{'name'};
        }

        if( $v->{'address'} ) {
            # Remove the comment from the address
            if( $v->{'address'} =~ /(.*)([(].+[)])(.*)/ ) {
                # (nyaan)nekochan@example.org, nekochan(nyaan)cat@example.org or
                # nekochan(nyaan)@example.org
                $v->{'address'} = $1.$3;
                $v->{'comment'} = $2;
            }
            push @$readbuffer, $v;
        }
    }

    while( my $e = shift @$readbuffer ) {
        # The element must not include any character except from 0x20 to 0x7e.
        next if $e->{'address'} =~ /[^\x20-\x7e]/;

        unless( $e->{'address'} =~ /\A.+[@].+\z/ ) {
            # Allow if the argument is MAILER-DAEMON
            next unless Sisimai::RFC5322->is_mailerdaemon($e->{'address'});
        }

        # Remove angle brackets, other brackets, and quotations: []<>{}'`
        # except a domain part is an IP address like neko@[192.0.2.222]
        $e->{'address'} =~ s/\A[\[<{('`]//;
        $e->{'address'} =~ s/['`>})]\z//;
        $e->{'address'} =~ s/\]\z// unless $e->{'address'} =~ /[@]\[[0-9A-Za-z:\.]+\]\z/;

        unless( $e->{'address'} =~ /\A["].+["][@]/ ) {
            # Remove double-quotations
            substr($e->{'address'},  0, 1, '') if substr($e->{'address'},  0, 1) eq '"';
            substr($e->{'address'}, -1, 1, '') if substr($e->{'address'}, -1, 1) eq '"';
        }

        if( $addrs ) {
            # Almost compatible with parse() method, returns email address only
            delete $e->{'name'};
            delete $e->{'comment'};

        } else {
            # Remove double-quotations, trailing spaces.
            for my $f ('name', 'comment') {
                # Remove traliing spaces
                $e->{ $f } =~ s/\A\s*//;
                $e->{ $f } =~ s/\s*\z//;
            }
            $e->{'comment'} = ''   unless $e->{'comment'} =~ /\A[(].+[)]\z/;
            $e->{'name'} =~ y/ //s    unless $e->{'name'} =~ /\A["].+["]\z/;
            $e->{'name'} =~ s/\A["]// unless $e->{'name'} =~ /\A["].+["][@]/;
            substr($e->{'name'}, -1, 1, '') if substr($e->{'name'}, -1, 1) eq '"';
        }
        push @$addrtables, $e;
    }

    return undef unless scalar @$addrtables;
    return $addrtables;
}

sub s3s4 {
    # Runs like ruleset 3,4 of sendmail.cf
    # @param    [String] input  Text including an email address
    # @return   [String]        Email address without comment, brackets
    my $class = shift;
    my $input = shift // return undef;
    return $input if ref $input;

    my $addrs = __PACKAGE__->find($input, 1) || [];
    return $input unless scalar @$addrs;
    return $addrs->[0]->{'address'};
}

sub expand_verp {
    # Expand VERP: Get the original recipient address from VERP
    # @param    [String] email  VERP Address
    # @return   [String]        Email address
    my $class = shift;
    my $email = shift // return undef;
    my $local = (split('@', $email, 2))[0];

    if( $local =~ /\A[-_\w]+?[+](\w[-._\w]+\w)[=](\w[-.\w]+\w)\z/ ) {
        # bounce+neko=example.org@example.org => neko@example.org
        my $verp0 = $1.'@'.$2;
        return $verp0 if Sisimai::RFC5322->is_emailaddress($verp0);
    } else {
        return '';
    }
}

sub expand_alias {
    # Expand alias: remove from '+' to '@'
    # @param    [String] email  Email alias string
    # @return   [String]        Expanded email address
    my $class = shift;
    my $email = shift // return undef;
    return '' unless Sisimai::RFC5322->is_emailaddress($email);

    my @local = split('@', $email);
    my $alias = '';
    if( $local[0] =~ /\A([-_\w]+?)[+].+\z/ ) {
        # neko+straycat@example.org => neko@example.org
        $alias = $1.'@'.$local[1];
    }
    return $alias;
}

sub is_undisclosed {
    # Check the "address" is an undisclosed address or not
    # @param    [None]
    # @return   [Integer]   1: Undisclosed address
    #                       0: Is not undisclosed address
    my $self = shift;
    return 1 if $self->host eq $undisclosed;
    return 0;
}

sub TO_JSON {
    # Instance method for JSON::encode()
    # @return   [String] The value of "address" accessor
    my $self = shift;
    return $self->address;
}

1;
__END__

=encoding utf-8

=head1 NAME

Sisimai::Address - Email address object

=head1 SYNOPSIS

    use Sisimai::Address;

    my $v = Sisimai::Address->new('neko@example.org');
    print $v->user;     # neko
    print $v->host;     # example.org
    print $v->address;  # neko@example.org

=head1 DESCRIPTION

Sisimai::Address provide methods for dealing email address.

=head1 CLASS METHODS

=head2 C<B<new(I<email address>)>>

C<new()> is a constructor of Sisimai::Address

    my $v = Sisimai::Address->new('neko@example.org');

=head2 C<B<find(I<String>)>>

C<find()> is a new parser for getting only email address from text including
email addresses.

    my $r = 'Stray cat <cat@example.org>, nyaa@example.org (White Cat)',
    my $v = Sisimai::Address->find($r);

    warn Dumper $v;
    $VAR1 = [
              {
                'name' => 'Stray cat',
                'address' => 'cat@example.org',
                'comment' => ''
              },
              {
                'name' => '',
                'address' => 'nyaa@example.jp',
                'comment' => '(White Cat)'
              }
    ];

=head2 C<B<s3s4(I<email address>)>>

C<s3s4()> works Ruleset 3, and 4 of sendmail.cf.

    my $r = [
        'Stray cat <cat@example.org>',
        'nyaa@example.org (White Cat)',
    ];

    for my $e ( @$r ) {
        print Sisimai::Address->s3s4($e);   # cat@example.org
                                            # nyaa@example.org
    }

=head2 C<B<expand_verp(I<email address>)>>

C<expand_verp()> gets the original email address from VERP

    my $r = 'nyaa+neko=example.org@example.org';
    print Sisimai::Address->expand_verp($r); # neko@example.org

=head2 C<B<expand_alias(I<email address>)>>

C<expand_alias()> gets the original email address from alias

    my $r = 'nyaa+neko@example.org';
    print Sisimai::Address->expand_alias($r); # nyaa@example.org

=head1 INSTANCE METHODS

=head2 C<B<user()>>

C<user()> returns a local part of the email address.

    my $v = Sisimai::Address->new('neko@example.org');
    print $v->user;     # neko

=head2 C<B<host()>>

C<host()> returns a domain part of the email address.

    my $v = Sisimai::Address->new('neko@example.org');
    print $v->host;     # example.org

=head2 C<B<address()>>

C<address()> returns an email address

    my $v = Sisimai::Address->new('neko@example.org');
    print $v->address;     # neko@example.org

=head2 C<B<verp()>>

C<verp()> returns a VERP email address

    my $v = Sisimai::Address->new('neko+nyaan=example.org@example.org');
    print $v->verp;     # neko+nyaan=example.org@example.org
    print $v->address;  # nyaan@example.org

=head2 C<B<alias()>>

C<alias()> returns an email address (alias)

    my $v = Sisimai::Address->new('neko+nyaan@example.org');
    print $v->alias;    # neko+nyaan@example.org
    print $v->address;  # neko@example.org

=head2 C<B<name()>>

C<name()> returns a display name

    my $e = '"Neko, Nyaan" <neko@example.org>';
    my $r = Sisimai::Address->find($e);
    my $v = Sisimai::Address->make($r->[0]);
    print $v->address;  # neko@example.org
    print $v->name;     # Neko, Nyaan

=head2 C<B<comment()>>

C<name()> returns a comment

    my $e = '"Neko, Nyaan" <neko(nyaan)@example.org>';
    my $v = Sisimai::Address->make(shift @{ Sisimai::Address->find($e) });
    print $v->address;  # neko@example.org
    print $v->comment;  # nyaan

=head1 AUTHOR

azumakuniyuki

=head1 COPYRIGHT

Copyright (C) 2014-2018 azumakuniyuki, All rights reserved.

=head1 LICENSE

This software is distributed under The BSD 2-Clause License.

=cut