view release on metacpan or  search on metacpan

Bio/Root/Utilities.pm  view on Meta::CPAN

=head2 authority

 Title    : authority
 Usage    : $Util->authority('admin@example.com');
 Purpose  : Set/get the email address that should be notified by mail_authority()

See Also  : L<mail_authority()|mail_authority>

=cut

#-------------
sub authority {
#-------------
    my( $self, $email ) = @_;
    $self->{'_auth_email'} = $email if defined $email;
    return $self->{'_auth_email'};
}


=head2 send_mail

 Title    : send_mail
 Usage    : $Util->send_mail( named_parameters )
 Purpose  : Provides an interface to mail or sendmail, if available
 Returns  : n/a
 Argument : Named parameters:  (case-insensitive)
          :  -TO   => e-mail address to send to
          :  -SUBJ => subject for message  (optional)
          :  -MSG  => message to be sent   (optional)
          :  -CC   => cc: e-mail address   (optional)
 Thows    : Exception if TO: address appears bad or is missing.
          : Exception if mail cannot be sent.
 Comments : Based on  TomC's tip at:
          :   http://www.perl.com/CPAN/doc/FMTEYEWTK/safe_shellings
          :
          : Using default 'From:' information.
          :   sendmail options used:
          :      -t: ignore the address given on the command line and
          :          get To:address from the e-mail header.
          :     -oi: prevents send_mail from ending the message if it
          :          finds a period at the start of a line.

See Also  : L<mail_authority()|mail_authority>

=cut


#-------------
sub send_mail {
#-------------
    my( $self, @param) = @_;
    my($recipient,$subj,$message,$cc) = $self->_rearrange([qw(TO SUBJ MSG CC)],@param);

    $self->throw("Invalid or missing e-mail address: $recipient")
        if not $recipient =~ /\S+\@\S+/;

    $subj ||= 'empty subject'; $message ||= '';

    # Best to use mail rather than sendmail. Permissions on sendmail in
    # linux distros have been significantly locked down in recent years,
    # due to the perception that it is insecure.
    my ($exe, $ccinfo);
    if ($exe = $self->find_exe('mail')) {
        if (defined $cc) {
            $ccinfo = "-c $cc";
        }
        $self->debug("send_mail: $exe -s '$subj' $ccinfo $recipient\n");
        open (MAIL, "| $exe -s '$subj' $ccinfo $recipient") ||
            $self->throw("Can't send email: mail cannot fork: $!");
        print MAIL <<QQ_EOFM_QQ;
$message
QQ_EOFM_QQ
        $? and $self->warn("mail didn't exit nicely: $?");
        close(MAIL);
    } elsif ($exe = $self->find_exe('sendmail')) {
        open (SENDMAIL, "| $exe -oi -t") ||
            $self->throw("Can't send email: sendmail cannot fork: $!");
        print SENDMAIL <<QQ_EOFSM_QQ;
To: $recipient
Subject: $subj
Cc: $cc

$message

QQ_EOFSM_QQ
        $? and $self->warn("sendmail didn't exit nicely: $?");

        close(SENDMAIL);
    } else {
        $self->throw("Can't find executable for mail or sendmail.");
    }
}


=head2 find_exe

 Title     : find_exe
 Usage     : $Util->find_exe(name);
 Purpose   : Locate an executable (for use in a system() call, e.g.))
 Example   : $Util->find_exe("gzip");
 Returns   : String containing executable that passes the -x test.
             Returns undef if an executable of the supplied name cannot be found.
 Argument  : Name of executable to be found.
           : Can be a full path. If supplied name is not executable, an executable
           : of that name will be searched in all directories in the currently
           : defined PATH environment variable.
 Throws    : No exceptions, but issues a warning if multiple paths are found
           : for a given name. The first one is used.
 Comments  : TODO: Confirm functionality on all bioperl-supported platforms.
             May get tripped up by variation in path separator character used
             for splitting ENV{PATH}.
See Also   :

=cut

#------------
sub find_exe {
#------------
    my ($self, $name) = @_;
    my @bindirs;