view release on metacpan or  search on metacpan

lib/CTK/Util.pm  view on Meta::CPAN

}
sub getfilelist {
    return [map {$_->[1]} scanfiles(@_)];
}
sub getlist { goto &getfilelist }
sub getdirlist {
    return [map {$_->[1]} scandirs(@_)];
}

#
# Extended
#

sub send_mail { # MIME::Lite interface only
    my @args = @_;
    my ($to, $cc, $from, $subject, $message, $type,
     $sendmail, $charset, $smtp, $smtpuser, $smtppass, $att, $smtpargs) =
    read_attributes([
        ['TO','ADDRESS'],
        ['COPY','CC'],
        ['FROM'],
        ['SUBJECT','SUBJ','SBJ'],
        ['MESSAGE','CONTENT','TEXT'],
        ['TYPE','CONTENT-TYPE','CONTENT_TYPE'],
        ['PROGRAM','SENDMAIL',],
        ['CHARSET','CHARACTER_SET'],
        ['SMTP','MAILSERVER','SERVER','HOST'],
        ['SMTPLOGIN','AUTHLOGIN','LOGIN','SMTPUSER','AUTHUSER','USER'],
        ['SMTPPASSWORD','AUTHPASSWORD','PASSWORD','SMTPPASS','AUTHPASS','PASS'],
        ['ATTACH','ATTACHE','ATT'],
        ['SMTPARGS','ARGS','ARGUMENTS'],
    ],@args) if defined $args[0];

    $to           //= '';
    $cc           //= '';
    $from         //= '';
    $subject      //= '';
    $message      //= '';
    $type         //= "text/plain";
    $sendmail     //= '';
    $charset      //= "utf-8";
    $smtp         //= '';
    $smtpuser     //= '';
    $smtppass     //= '';

    if ($charset !~ /utf\-?8/i) {
        $subject = to_utf8($subject, $charset);
        $message = to_utf8($message, $charset);
    }

    # Object
    my $msg = MIME::Lite->new(
        From     => $from,
        To       => $to,
        $cc ? (Cc => $cc) : (),
        Subject  => $subject, # to_base64($subject),
        Type     => $type,
        Encoding => 'base64',
        Data     => Encode::encode('UTF-8', $message)
    );
    $msg->attr('content-type.charset' => 'UTF-8');
    $msg->attr('Content-Transfer-Encoding' => 'base64');

    # Attaches
    if ($att) {
        if (ref($att) =~ /HASH/i) {
            $msg->attach(%$att);
        } elsif  (ref($att) =~ /ARRAY/i) {
            foreach (@$att) {
                if (ref($_) =~ /HASH/i) {
                    $msg->attach(%$_);
                } else {
                    carp("Can't attach scalar data. Please use hash structure");
                }
            }
        } else {
            carp("Can't attach scalar data. Please use hash structure or array of hashes");
        }
    }

    # Sending
    my $sendstat;
    my %tmp = ($smtpargs && ref($smtpargs) eq 'HASH') ? %$smtpargs : ();
    if ($smtp) { # If SMTP
        $tmp{AuthUser} //= $smtpuser if length($smtpuser);
        $tmp{AuthPass} //= $smtppass if length($smtppass);
        eval { $sendstat = $msg->send('smtp', $smtp, %tmp); };
        carp(sprintf("sendmail (smtp://%s): %s", $smtp, $@)) if $@;
    } elsif ($sendmail && -e $sendmail) { # Try sendmail program
        eval { $sendstat = $msg->send('sendmail', $sendmail); };
        carp(sprintf("sendmail (%s): %s", $sendmail, $@)) if $@;
    } else { # Try without args
        eval { $sendstat = $msg->send(); };
        carp(sprintf("sendmail (default): %s", $@)) if $@;
    }
    return $sendstat ? 1 : 0;
}
sub sendmail { goto &send_mail }
sub ftp {
    #my %ftpct = (
    #    ftphost     => '192.168.1.1',
    #    ftpuser     => 'login',
    #    ftppassword => 'password',
    #    ftpdir      => '~/',
    #    voidfile    => './void.txt',
    #    #ftpattr    => {},
    #);
    #my $rfiles = CTK::ftp(\%ftpct, 'ls');
    #my @remotefiles = $rfiles ? grep {!(/^\./)} @$rfiles : ();
    #ftp(\%ftpct, 'put', catfile($dirin,$file), $file);

    my $ftpconnect  = shift || {};
    my $cmd         = shift || '';
    my $lfile       = shift || '';
    my $rfile       = shift || '';

    unless ($ftpconnect && (ref($ftpconnect) eq 'HASH') && $ftpconnect->{ftphost}) {
        carp("Connect's data missing");
        return undef;
    }