Newer
Older
Digital_Repository / OARiNZ / DIY / deb_package / eprints-3.0 / perl_lib / EPrints / Email.pm
######################################################################
#
# EPrints::Email
#
######################################################################
#
#  This file is part of GNU EPrints 2.
#  
#  Copyright (c) 2000-2004 University of Southampton, UK. SO17 1BJ.
#  
#  EPrints 2 is free software; you can redistribute it and/or modify
#  it under the terms of the GNU General Public License as published by
#  the Free Software Foundation; either version 2 of the License, or
#  (at your option) any later version.
#  
#  EPrints 2 is distributed in the hope that it will be useful,
#  but WITHOUT ANY WARRANTY; without even the implied warranty of
#  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#  GNU General Public License for more details.
#  
#  You should have received a copy of the GNU General Public License
#  along with EPrints 2; if not, write to the Free Software
#  Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
#
######################################################################


=pod

=head1 NAME

B<EPrints::Email> - Email Utility functions for EPrints.

=head1 DESCRIPTION

This package handles sending emails.

=over 4

=cut

package EPrints::Email;

use Unicode::String qw(utf8 latin1 utf16);
use MIME::Lite;
use LWP::MediaTypes qw( guess_media_type );

use strict;


######################################################################
=pod

=item EPrints::Utils::send_mail( %properties )

Sends an email. 

Required properties:

session - the current session

langid - the id of the language to send the email in.

to_email, to_name - who to send it to

subject - the subject of the message (UTF-8 encoded string)

message - the body of the message as a DOM tree

optional properties:

from_email, from_name - who is sending the email (defaults to the archive admin)

sig - the signature file as a DOM tree

replyto_email, replyto_name

attach - ref to an array of filenames (with full paths) to attach to the message 

Returns true if mail sending (appears to have) succeeded. False otherwise.

Uses the config. option "send_email" to send the mail, or if that's
not defined sends the email via STMP.

names and the subject should be encoded as utf-8


=cut
######################################################################

sub send_mail
{
	my( %p ) = @_;

	my $repository = $p{session}->get_repository;

	if( defined $p{message} )
	{
		my $msg = $p{message};

		# First get the body
		my $body = $p{session}->html_phrase( 
			"mail_body",
			content => $p{session}->clone_for_me($msg,1) );
		# Then add the HTML around it
		my $html = $p{session}->html_phrase(
			"mail_wrapper",
			body => $body );

		$p{message} = $html;
	}

	if( !defined $p{from_email} ) 
	{
		$p{from_name} = $p{session}->phrase( "archive_name" );
		$p{from_email} = $repository->get_conf( "adminemail" );
	}
	
	my $result;
	if( $repository->can_call( 'send_email' ) )
	{
		$result = $repository->call( 'send_email', %p );
	}
	else
	{
		$result = send_mail_via_sendmail( %p );
	}

	if( !$result )
	{
		$p{session}->get_repository->log( "Failed to send mail.\nTo: $p{to_email} <$p{to_name}>\nSubject: $p{subject}\n" );
	}

	return $result;
}


######################################################################
#=pod
#
#=item EPrints::Utils::send_mail_via_smtp( %properties )
#
#Send an email via STMP. Should not be called directly, but rather by
#EPrints::Utils::send_mail.
#
#=cut
######################################################################

sub send_mail_via_smtp
{
	my( %p ) = @_;

	eval 'use Net::SMTP';

	my $repository = $p{session}->get_repository;

	my $smtphost = $repository->get_conf( 'smtp_server' );

	if( !defined $smtphost )
	{
		$repository->log( "No STMP host has been defined. To fix this, find the full\naddress of your SMTP server (eg. smtp.example.com) and add it\nas the value of smtp_server in\nperl_lib/EPrints/SystemSettings.pm" );
		return( 0 );
	}

	my $smtp = Net::SMTP->new( $smtphost );
	if( !defined $smtp )
	{
		$repository->log( "Failed to create smtp connection to $smtphost" );
		return( 0 );
	}

	
	$smtp->mail( $p{from_email} );
	if( !$smtp->recipient( $p{to_email} ) )
	{
		$repository->log( "smtp server refused <$p{to_email}>" );
		$smtp->quit;
		return 0;
	}
	my $message = build_email( %p );
	$smtp->data();
	$smtp->datasend( $message->as_string );
	$smtp->dataend();
	$smtp->quit;

	return 1;
}

######################################################################
# =pod
# 
# =item EPrints::Utils::send_mail_via_sendmail( %params )
# 
# Also should not be called directly. The config. option "send_email"
# can be set to \&EPrints::Utils::send_mail_via_sendmail to use the
# sendmail command to send emails rather than send to a SMTP server.
# 
# =cut
######################################################################

sub send_mail_via_sendmail
{
	my( %p )  = @_;

	my $repository = $p{session}->get_repository;

	unless( open( SENDMAIL, "|".$repository->invocation( "sendmail" ) ) )
	{
		$repository->log( "Failed to invoke sendmail: ".
			$repository->invocation( "sendmail" ) );
		return( 0 );
	}
	my $message = build_email( %p );
	print SENDMAIL $message->as_string;
	close(SENDMAIL) or return( 0 );
	return( 1 );
}

# $mime_message = EPrints::Utils::build_mail( %params ) 
#
# Takes the same parameters as send_mail. This creates a MIME::Lite email
# object with both a text and an HTML part.

sub build_email
{
	my( %p ) = @_;

	my $MAILWIDTH = 80;

	my $repository = $p{session}->get_repository;

	my $mimemsg = MIME::Lite->new(
		From       => "$p{from_name} <$p{from_email}>",
		To         => "$p{to_name} <$p{to_email}>",
		Subject    => $p{subject},
		Type       => "multipart/alternative",
		Precedence => "bulk",
	);

	if( defined $p{replyto_email} )
	{
		$mimemsg->attr( "Reply-to" => "$p{replyto_name} <$p{replyto_email}>" );
	}
	$mimemsg->replace( "X-Mailer" => "EPrints http://eprints.org/" );


	# If there are file attachments, change to a "mixed" type
	# and attach the body Text and HTML to an "alternative" subpart
	my $mixedmsg;
	if( $p{attach} )
	{
		$mixedmsg = $mimemsg;
		$mixedmsg->attr( "Content-Type" => "multipart/mixed" );
		$mimemsg = MIME::Lite->new(
			Type => "multipart/alternative",
		);
		$mixedmsg->attach( $mimemsg );
	}

	my $xml_mail = $p{message};
	my $data = EPrints::Utils::tree_to_utf8( $xml_mail , $MAILWIDTH, 0, 0, 1 );

	my $text = MIME::Lite->new( 
		Type  => "TEXT",
		Data  => $data
	);
	$text->attr("Content-disposition" => "");
	$mimemsg->attach( $text );
	my $html = MIME::Lite->new( 
		Type  => "text/html",
		Data  => $xml_mail->toString,
	);
	$html->attr("Content-disposition" => "");
	$mimemsg->attach( $html );

	for( @{ $p{attach} } )
	{
		my $part = MIME::Lite->new(
			Type => guess_media_type( $_ ),
			Path => $_,
		);
		$mixedmsg->attach( $part );
		return $mixedmsg;
	}

	return $mimemsg;
}




1;