view release on metacpan or  search on metacpan

lib/Mail/Internet.pm  view on Meta::CPAN

    my $head   = $self->cleaned_header_dup;

    # Remove these incase the NNTP host decides to mail as well as me
    $head->delete(qw(To Cc Bcc)); 

    my $news;
    my $quit   = 1;

    my $host   = $opt{Host};
    if(ref($host) && UNIVERSAL::isa($host,'Net::NNTP'))
    {   $news = $host;
	$quit = 0;
    }
    else
    {   my @opt = $opt{Host};

	push @opt, Port => $opt{Port}
	    if exists $opt{Port};

	push @opt, Debug => $opt{Debug}
	    if exists $opt{Debug};

	$news = Net::NNTP->new(@opt)
	    or return ();
    }

    $news->post(@{$head->header}, "\n", @{$self->body});
    my $rc = $news->code;

    $news->quit if $quit;

    $rc == 240 ? @groups : ();
}


sub escape_from
{   my $body = shift->body;
    scalar grep { s/\A(>*From) />$1 /o } @$body;
}



sub unescape_from
{   my $body = shift->body;
    scalar grep { s/\A>(>*From) /$1 /o } @$body;
}

# Don't tell people it exists
sub cleaned_header_dup()
{   my $head = shift->head->dup;

    $head->delete('From '); # Just in case :-)

    # An original message should not have any Received lines
    $head->delete('Received');

    $head->replace('X-Mailer', "Perl5 Mail::Internet v".$Mail::Internet::VERSION)
        unless $head->count('X-Mailer');

    my $name = eval {local $SIG{__DIE__}; (getpwuid($>))[6]} || $ENV{NAME} ||"";

    while($name =~ s/\([^\(\)]*\)//) { 1; }

    if($name =~ /[^\w\s]/)
    {   $name =~ s/"/\"/g;
	$name = '"' . $name . '"';
    }

    my $from = sprintf "%s <%s>", $name, mailaddress();
    $from =~ s/\s{2,}/ /g;

    foreach my $tag (qw(From Sender))
    {   $head->get($tag) or $head->add($tag, $from);
    }

    $head;
}

1;