?
Current Path : /usr/share/perl5/vendor_perl/Mail/ |
Linux gator3171.hostgator.com 4.19.286-203.ELK.el7.x86_64 #1 SMP Wed Jun 14 04:33:55 CDT 2023 x86_64 |
Current File : //usr/share/perl5/vendor_perl/Mail/Mailer.pm |
# Copyrights 1995-2012 by [Mark Overmeer <perl@overmeer.net>]. # For other contributors see ChangeLog. # See the manual pages for details on the licensing terms. # Pod stripped from pm file by OODoc 2.00. use strict; package Mail::Mailer; use vars '$VERSION'; $VERSION = '2.12'; use base 'IO::Handle'; use POSIX qw/_exit/; use Carp; use Config; sub is_exe($); sub Version { our $VERSION } our @Mailers = ( sendmail => '/usr/lib/sendmail;/usr/sbin/sendmail;/usr/ucblib/sendmail' , smtp => undef , smtps => undef , qmail => '/usr/sbin/qmail-inject;/var/qmail/bin/qmail-inject' , testfile => undef ); push @Mailers, map { split /\:/, $_, 2 } split /$Config{path_sep}/, $ENV{PERL_MAILERS} if $ENV{PERL_MAILERS}; our %Mailers = @Mailers; our $MailerType; our $MailerBinary; # does this really need to be done? or should a default mailer be specfied? $Mailers{sendmail} = 'sendmail' if $^O eq 'os2' && ! is_exe $Mailers{sendmail}; if($^O =~ m/MacOS|VMS|MSWin|os2|NetWare/i ) { $MailerType = 'smtp'; $MailerBinary = $Mailers{$MailerType}; } else { for(my $i = 0 ; $i < @Mailers ; $i += 2) { $MailerType = $Mailers[$i]; if(my $binary = is_exe $Mailers{$MailerType}) { $MailerBinary = $binary; last; } } } sub import { shift; # class @_ or return; my $type = shift; my $exe = shift || $Mailers{$type}; is_exe $exe or carp "Cannot locate '$exe'"; $MailerType = $type; $Mailers{$MailerType} = $exe; } sub to_array($) { my ($self, $thing) = @_; ref $thing ? @$thing : $thing; } sub is_exe($) { my $exe = shift || ''; foreach my $cmd (split /\;/, $exe) { $cmd =~ s/^\s+//; # remove any options my $name = ($cmd =~ /^(\S+)/)[0]; # check for absolute or relative path return $cmd if -x $name && ! -d $name && $name =~ m![\\/]!; if(defined $ENV{PATH}) { foreach my $dir (split /$Config{path_sep}/, $ENV{PATH}) { return "$dir/$cmd" if -x "$dir/$name" && ! -d "$dir/$name"; } } } 0; } sub new($@) { my ($class, $type, @args) = @_; unless($type) { $MailerType or croak "No MailerType specified"; warn "No real MTA found, using '$MailerType'" if $MailerType eq 'testfile'; $type = $MailerType; } my $exe = $Mailers{$type}; if(defined $exe) { $exe = is_exe $exe if defined $type; $exe ||= $MailerBinary or croak "No mailer type specified (and no default available), thus can not find executable program."; } $class = "Mail::Mailer::$type"; eval "require $class" or die $@; my $glob = $class->SUPER::new; # object is a GLOB! %{*$glob} = (Exe => $exe, Args => [ @args ]); $glob; } sub open($) { my ($self, $hdrs) = @_; my $exe = *$self->{Exe}; # no exe, then direct smtp my $args = *$self->{Args}; my @to = $self->who_to($hdrs); my $sender = $self->who_sender($hdrs); $self->close; # just in case; if(defined $exe) { # Fork and start a mailer my $child = open $self, '|-'; defined $child or die "Failed to send: $!"; if($child==0) { # Child process will handle sending, but this is not real exec() # this is a setup!!! unless($self->exec($exe, $args, \@to, $sender)) { warn $!; # setup failed _exit(1); # no DESTROY(), keep it for parent } } } else { $self->exec($exe, $args, \@to, $sender) or die $!; } $self->set_headers($hdrs); $self; } sub _cleanup_hdrs($) { foreach my $h (values %{(shift)}) { foreach (ref $h ? @$h : $h) { s/\n\s*/ /g; s/\s+$//; } } } sub exec($$$$) { my($self, $exe, $args, $to, $sender) = @_; # Fork and exec the mailer (no shell involved to avoid risks) my @exe = split /\s+/, $exe; exec @exe, @$args, @$to; } sub can_cc { 1 } # overridden in subclass for mailer that can't sub who_to($) { my($self, $hdrs) = @_; my @to = $self->to_array($hdrs->{To}); unless($self->can_cc) # Can't cc/bcc so add them to @to { push @to, $self->to_array($hdrs->{Cc} ) if $hdrs->{Cc}; push @to, $self->to_array($hdrs->{Bcc}) if $hdrs->{Bcc}; } @to; } sub who_sender($) { my ($self, $hdrs) = @_; ($self->to_array($hdrs->{Sender} || $hdrs->{From}))[0]; } sub epilogue { # This could send a .signature, also see ::smtp subclass } sub close(@) { my $self = shift; fileno $self or return; $self->epilogue; CORE::close $self; } sub DESTROY { shift->close } 1;