view release on metacpan or  search on metacpan

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

            return $s;
            }
    }
}

sub enc_qp {
    if ($_[0]) {
        my $charset = $_[0];
        return sub {
            my $s = Encode::encode($charset, $_[0]);
            $s =~ s/\x0D\x0A/\n/g;
            $s = MIME::QuotedPrint::encode_qp($s);
            $s =~ s/^\./../gm;
            $s =~ s/\x0A/\x0D\x0A/sg;
            return $s;
            }
    }
    else {
        return sub {
            my $s = $_[0];
            $s =~ s/\x0D\x0A/\n/g;
            $s = MIME::QuotedPrint::encode_qp($s);
            $s =~ s/^\./../gm;
            $s =~ s/\x0A/\x0D\x0A/sg;
            return $s;
            }
    }
}

sub enc_plain {
    if ($_[0]) {
        my $charset = $_[0];
        return sub {
            my $s = Encode::encode($charset, $_[0]);
            $s =~ s/^\./../gm;
            $s =~ s/(?:\x0D\x0A?|\x0A)/\x0D\x0A/sg;
            return $s;
            }
    }
    else {
        return sub {
            my $s = $_[0];
            $s =~ s/^\./../gm;
            $s =~ s/(?:\x0D\x0A?|\x0A)/\x0D\x0A/sg;
            return $s;
            }
    }
}

sub enc_xtext {
    my $input = shift;
    $input =~ s/([^!-*,-<>-~])/'+'.uc(unpack('H*', $1))/eg;
    return $input;
}

{
    my $username;

    sub getusername () {
        return $username if defined($username);
        return $username = eval { getlogin || getpwuid($<) } || $ENV{USERNAME};
    }
}

#IO

#reads the whole SMTP response
# converts
#    nnn-very
#    nnn-long
#    nnn message
# to
#    nnn very
#    long
#    message
sub get_response ($) {
    my $s   = shift;
    my $res = <$s>;
    if ($res =~ s/^(\d\d\d)-/$1 /) {
        my $nextline = <$s>;
        while ($nextline =~ s/^\d\d\d-//) {
            $res .= $nextline;
            $nextline = <$s>;
        }
        $nextline =~ s/^\d\d\d //;
        $res .= $nextline;
    }
    $Mail::Sender::LastResponse = $res;
    return $res;
}

sub send_cmd ($$) {
    my ($s, $cmd) = @_;
    chomp $cmd;
    if ($s->opened()) {
        print $s "$cmd\x0D\x0A";
        get_response($s);
    }
    else {
        return '400 connection lost';
    }
}

sub _print_hdr {
    my ($s, $hdr, $str, $charset) = @_;
    return if !defined $str or $str eq '';
    $str =~ s/[\x0D\x0A\s]+$//;

    if ($charset && $str =~ /[^[:ascii:]]/) {
        $str = Encode::encode($charset, $str);
        my @parts = split /(\s*[,;<> ]\s*)/, $str;
        $str = '';
        for (my $i = 0; $i < @parts; $i++) {
            my $part = $parts[$i];
            $part .= $parts[++$i]
                if ($i < $#parts && $parts[$i + 1] =~ /^\s+$/);
            if ($part =~ /[^[:ascii:]]/ || $part =~ /[\r\n\t]/) {
                $part = MIME::QuotedPrint::encode_qp($part, '');
                $part =~ s/([\s\?])/'=' . sprintf '%02x',ord($1)/ge;
                $str .= "=?$charset?Q?$part?=";
            }