view release on metacpan or  search on metacpan

Agent/Driver/Mail.pm  view on Meta::CPAN

###########################################################################
#
#   Mail.pm
#
#   Copyright (C) 1999 Raphael Manfredi.
#   Copyright (C) 2002-2017 Mark Rogaski, mrogaski@cpan.org;
#   all rights reserved.
#
#   See the README file included with the
#   distribution for license information.
#
##########################################################################

package Log::Agent::Driver::Mail;

use strict;
use Mail::Mailer;
require Log::Agent::Driver;

use vars qw(@ISA);
@ISA = qw(Log::Agent::Driver);

###########################################################################
#
# Public Methods
#
###########################################################################

#
# make -- driver constructor
#
sub make {
    my $self = bless {
        prefix      => '',
        to          => (getpwuid $<)[0],
        cc          => '',
        bcc         => '',
        subject     => '',
        from        => '',
        priority    => '',
        reply_to  => '',
        mailer      => []
    }, shift;

    my (%args) = @_;

    foreach my $key (keys %args) {
        if ($key =~ /^-(to|cc|bcc|prefix|subject|from|priority|reply_to|
                mailer)$/x) {
            $self->{$1} = $args{$key};
        } else {
            use Carp;
            croak "invalid argument: $key";
        }
    }

    $self->_init($self->{prefix}, 0);

    return $self;
}

#
# chan_eq -- not much of anything at the moment
#
sub chan_eq {
    my($self, $chan0, $chan1) = @_;
    return $chan0 eq $chan1;
}

#
# write -- send a message to the channel
#
sub write {
    my($self, $chan, $prio, $mesg) = @_;

    my(%headers);
    foreach my $hdr (qw( to cc bcc subject from priority reply_to )) {
        my $fhdr = ucfirst($hdr);
        $fhdr =~ s/_/-/g;
        $headers{$fhdr} = $self->{$hdr} unless $self->{$hdr} eq '';
    }

    my $mailer = Mail::Mailer->new(@{$self->{mailer}});
    $mailer->open(\%headers);
    print $mailer $mesg, "\n";
    $mailer->close;
}

#
# prefix_msg -- add prefix
#
sub prefix_msg {
    my($self, $str) = @_;
    return ($self->{prefix} ? $self->{prefix} . ' ' : '') . $str;
}