-# }}}
-
-# {{{ ParseSenderAdddressFromHead
-
-=head2 ParseSenderAddressFromHead
-
-Takes a MIME::Header object. Returns a tuple: (user@host, friendly name)
-of the From (evaluated in order of Reply-To:, From:, Sender)
-
-=cut
-
-sub ParseSenderAddressFromHead {
- my $self = shift;
-
- #Figure out who's sending this message.
- my $From = $self->Head->get('Reply-To')
- || $self->Head->get('From')
- || $self->Head->get('Sender');
- return ( $self->ParseAddressFromHeader($From) );
-}
-
-# }}}
-
-# {{{ ParseErrorsToAdddressFromHead
-
-=head2 ParseErrorsToAddressFromHead
-
-Takes a MIME::Header object. Return a single value : user@host
-of the From (evaluated in order of Errors-To:,Reply-To:, From:, Sender)
-
-=cut
-
-sub ParseErrorsToAddressFromHead {
- my $self = shift;
-
- #Figure out who's sending this message.
-
- foreach my $header ( 'Errors-To', 'Reply-To', 'From', 'Sender' ) {
-
- # If there's a header of that name
- my $headerobj = $self->Head->get($header);
- if ($headerobj) {
- my ( $addr, $name ) = $self->ParseAddressFromHeader($headerobj);
-
- # If it's got actual useful content...
- return ($addr) if ($addr);
- }
- }
-}
-
-# }}}
-
-# {{{ ParseAddressFromHeader
-
-=head2 ParseAddressFromHeader ADDRESS
-
-Takes an address from $self->Head->get('Line') and returns a tuple: user@host, friendly name
-
-=cut
-
-sub ParseAddressFromHeader {
- my $self = shift;
- my $Addr = shift;
-
- # Perl 5.8.0 breaks when doing regex matches on utf8
- Encode::_utf8_off($Addr) if $] == 5.008;
- my @Addresses = Mail::Address->parse($Addr);
-
- my $AddrObj = $Addresses[0];
-
- unless ( ref($AddrObj) ) {
- return ( undef, undef );
- }
-
- my $Name = ( $AddrObj->phrase || $AddrObj->comment || $AddrObj->address );
-
- #Lets take the from and load a user object.
- my $Address = $AddrObj->address;
-
- return ( $Address, $Name );
-}
-
-# }}}
-
-# {{{ IsRTAddress