+Takes a MIME::Header object. Returns (user@host, friendly name, errors)
+where the first two values are the From (evaluated in order of
+Reply-To:, From:, Sender).
+
+A list of error messages may be returned even when a Sender value is
+found, since it could be a parse error for another (checked earlier)
+sender field. In this case, the errors aren't fatal, but may be useful
+to investigate the parse failure.
+
+=cut
+
+sub ParseSenderAddressFromHead {
+ my $head = shift;
+ my @sender_headers = ('Reply-To', 'From', 'Sender');
+ my @errors; # Accumulate any errors
+
+ #Figure out who's sending this message.
+ foreach my $header ( @sender_headers ) {
+ my $addr_line = Encode::decode( "UTF-8", $head->get($header) ) || next;
+ my ($addr, $name) = ParseAddressFromHeader( $addr_line );
+ # only return if the address is not empty
+ return ($addr, $name, @errors) if $addr;
+
+ chomp $addr_line;
+ push @errors, "$header: $addr_line";
+ }
+
+ return (undef, undef, @errors);
+}
+
+=head2 ParseErrorsToAddressFromHead HEAD
+
+Takes a MIME::Header object. Return a single value : user@host
+of the From (evaluated in order of Return-path:,Errors-To:,Reply-To:,
+From:, Sender)
+
+=cut
+
+sub ParseErrorsToAddressFromHead {
+ my $head = 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 = Encode::decode( "UTF-8", $head->get($header) );
+ if ($headerobj) {
+ my ( $addr, $name ) = ParseAddressFromHeader($headerobj);
+
+ # If it's got actual useful content...
+ return ($addr) if ($addr);
+ }
+ }
+}
+
+
+
+=head2 ParseAddressFromHeader ADDRESS
+
+Takes an address from C<$head->get('Line')> and returns a tuple: user@host, friendly name
+
+=cut
+
+sub ParseAddressFromHeader {
+ my $Addr = shift;
+
+ # Some broken mailers send: ""Vincent, Jesse"" <jesse@fsck.com>. Hate
+ $Addr =~ s/\"\"(.*?)\"\"/\"$1\"/g;
+ my @Addresses = RT::EmailParser->ParseEmailAddress($Addr);
+
+ my ($AddrObj) = grep ref $_, @Addresses;
+ unless ( $AddrObj ) {
+ return ( undef, undef );
+ }
+
+ return ( $AddrObj->address, $AddrObj->phrase );
+}
+
+=head2 DeleteRecipientsFromHead HEAD RECIPIENTS
+
+Gets a head object and list of addresses.
+Deletes addresses from To, Cc or Bcc fields.
+
+=cut
+
+sub DeleteRecipientsFromHead {
+ my $head = shift;
+ my %skip = map { lc $_ => 1 } @_;
+
+ foreach my $field ( qw(To Cc Bcc) ) {
+ $head->replace( $field => Encode::encode( "UTF-8",
+ join ', ', map $_->format, grep !$skip{ lc $_->address },
+ Email::Address->parse( Encode::decode( "UTF-8", $head->get( $field ) ) ) )