view release on metacpan or  search on metacpan

DWIM.pm  view on Meta::CPAN

###########################################
package Mail::DWIM;
###########################################

use strict;
use warnings;
our @ISA = qw(Exporter);
our @EXPORT_OK = qw(mail);
our $VERSION = "0.09";
our @HTML_MODULES = qw(HTML::FormatText HTML::TreeBuilder MIME::Lite);
our @ATTACH_MODULES = qw(File::MMagic MIME::Lite);

use YAML qw(LoadFile);
use Log::Log4perl qw(:easy);
use Config;
use Mail::Mailer;
use Sys::Hostname;
use File::Basename;
use POSIX qw(strftime);
use File::Spec;

my $error;

###########################################
sub mail {
###########################################
    my(@params) = @_;

    my $mailer = Mail::DWIM->new(@params);
    $mailer->send();
}

###########################################
sub new {
###########################################
    my($class, %options) = @_;

    my($homedir) = glob "~";

    my %defaults;

    my $self = {
        global_cfg_file => "/etc/maildwim",
        user_cfg_file   => "$homedir/.maildwim",
        transport       => "sendmail",
        raise_error     => 1,
        %options,
    };

      # Guess the 'from' address
    if(! exists $self->{from}) {
        my $user   = scalar getpwuid($<);
        my $domain = domain();
        $self->{from} = "$user\@$domain";
    }

      # Guess the 'date'
    if (!exists $self->{date}) {
        $self->{date} = strftime("%a, %e %b %Y %H:%M:%S %Z", localtime(time));
    }

    for my $cfg (qw(global_cfg_file user_cfg_file)) {
        if(-f $self->{$cfg}) {
            my $yml = LoadFile( $self->{$cfg} );
            if(defined $yml and ref $yml ne 'HASH') {
                  # Needs to be a hash, but YAML file can be empty (undef)
                LOGDIE "YAML file $self->{$cfg} format not a hash";
            }
              # merge with existing hash
            %defaults = (%defaults, %$yml) if defined $yml;
        }
    }

    %$self = (%$self, %defaults, %options);

    bless $self, $class;
}

###########################################
sub cmd_line_mail {
###########################################
    my($self) = @_;

    $self->{subject} = 'no subject' unless defined $self->{subject};

    my $mailer;
    $mailer = $self->{program} if defined $self->{program};
    $mailer = bin_find("mail") unless defined $mailer;

    open(PIPE, "|-", $mailer,
                    "-s", $self->{subject}, $self->{to},
        ) or LOGDIE "Opening $mailer failed: $!";

    print PIPE $self->{text};
    return close PIPE;
}

###########################################
sub send {
###########################################
    my($self, $evaled) = @_;

    if(!$self->{raise_error} && ! $evaled) {
        return $self->send_evaled();
    }

    my $msg =
          "Sending from=$self->{from} to=$self->{to} " .
          "subj=" . snip($self->{subject}, 20) . " " .
          "text=" . snip($self->{text}, 20) .
          "";