#! @PERL@ -w

# vim:syntax=perl

use strict;

use lib '@LR_PERL5LIBDIR@';

use Getopt::Long;
use MIME::Entity;

use Lire::Config;
use Lire::Logger;
use Lire::Program qw/ $PROG $LR_ID /;

sub encoding {
    if ($_[0] =~ /^text/ ) {
        return 'quoted-printable';
    } else {
        return 'base64';
    }
}

my $usage =<<EOU;
Usage: $PROG [-f from] [-r reply-to] [-c type -a attach]* [-s subject] content-type reportfile to...
EOU
my %opts=();

$opts{'reply-to'} = Lire::Config->get( 'lr_mail_reply_to' )
  if defined Lire::Config->get_var( 'lr_mail_reply_to' )->get();
$opts{'from'} = Lire::Config->get( 'lr_mail_from' )
  if defined Lire::Config->get_var( 'lr_mail_from' )->get();
$opts{'from'} ||= $ENV{'EMAIL'};

GetOptions( \%opts, "from=s", "reply-to=s", 'content-type=s@',
	    'attach=s@', "subject=s" )
  or lr_err( $usage );
@ARGV >= 3 or lr_err( $usage );

my ( $type, $file, @to ) = @ARGV;

if ( $opts{'content-type'} || $opts{'attach'} ) {
    lr_err( "the number of -c options must match the number of -a options" )
      unless $opts{'content-type'} && $opts{'attach'} &&
	@{$opts{'content-type'}} eq @{$opts{'attach'}};
}

# Check for prerequisite
lr_err( "sendmail isn't available" )
  unless defined Lire::Config->get( 'sendmail_path' );

my @headers = ( 'To', join( ", ", @to) );
push @headers, "From", $opts{'from'}
  if $opts{from};
push @headers, "Subject", $opts{'subject'}
  if $opts{'subject'};
push @headers, "Reply-To", $opts{'reply-to'}
  if $opts{'reply-to'};

eval {
    my $msg = MIME::Entity->build( @headers,
                                   Type => $type,
                                   Encoding => encoding( $type ),
                                   Path => $file,
                                 );
    if ( $opts{'attach'} ) {
	for ( my $i=0; $i < @{$opts{'attach'}}; $i++ ) {
	    $msg->attach( Path => $opts{'attach'}[$i],
			  Type => $opts{'content-type'}[$i],
                          Encoding => encoding( $opts{'content-type'}[$i] ),
			);
	}
    }

    my $pid = open( SENDMAIL, "|-" );
    lr_err( "can't fork: $!\n" ) unless defined $pid;
    if ( $pid ) {
	# Parent
	$msg->print( \*SENDMAIL );
	close SENDMAIL
	  or lr_err( "error: sendmail exited with non zero status: $?" );
    } else {
	# Children, execute sendmail
	# We use this form of exec so that @to can't be used to trick 
	# a shell.
	exec( Lire::Config->get( 'sendmail_path' ), @to )
	  or lr_err( "error executing sendmail: $!\n" );
    }
};
lr_err( $@ ) if $@;

exit 0;

# Local Variables:
# mode: cperl
# End:

__END__

=pod

=head1 NAME

lr_mail - Lire MIME mailer

=head1 SYNOPSIS 

B<lr_mail> [options] content-type file sendto...

=head1 DESCRIPTION

B<lr_mail> is a command line MIME mailer using MIME::Tools.

=head1 OPTIONS

=over 4

=item B<-f> I<email>

Sets the from address. Defaults to the value of the I<lr_from>
configuration variable.

=item B<-r> I<email>

Sets the reply-to address. Defaults to the value of the I<lr_reply_to>
configuration variable.

=item B<-s> I<subject>

Sets the subject of the email.

=item B<-c> I<content-type>

Sets the content-type for the next attachment.

=item B<-a> I<file>

Attach another file to the email.

=back

=head1 SEE ALSO

lr_xml2mail(1)

=head1 VERSION

$Id: lr_mail.in,v 1.18 2006/07/23 13:16:33 vanbaal Exp $

=head1 AUTHOR

Francis J. Lacoste <flacoste@logreport.org>

=head1 COPYRIGHT

Copyright (C) 2002 Stichting LogReport Foundation LogReport@LogReport.org

This program 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.

This program 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 this program (see COPYING); if not, check with
http://www.gnu.org/copyleft/gpl.html.

=cut