#!/usr/bin/perl

# ---------------------------------------------------------------
# Prontus CMS
# http://www.prontus.cl
# by Altavoz.net
#
# licensed under LGPL license.
# http://www.prontus.cl/license.html
# ---------------------------------------------------------------

# -------------------------------COMENTARIO GLOBAL---------------
# ---------------------------------------------------------------
# PROPOSITO.
# -----------
# Funciones para envio de emails.
# ---------------------------------------------------------------

#
# ---------------------------------------------------------------
# DECLARACIONES GLOBALES.
# ------------------------

package lib_mail;
use strict;
use warnings;
use utf8;
use Encode;

use LWP::UserAgent;
use HTTP::Response;

# ---------------------------------------------------------------
# SUB-RUTINAS.
# ---------------------------------------------------------------

# Envia email correspondiente a los parametros entregados.
# Contenidos basicos del email : Autor, Asunto, Texto.
# Contenidos adicionales : URL y/o archivo adjunto.
# @param string $email
# @param string $from
# @param string $replyto_name
# @param string $replyto_email
# @param string $asunto
# @param string $texto
# @param string $htmldoc el mail html
# @param string $attach
# @param string $url
# @param string $dir_attach
# @param string $smtp
# EJEMPLO DE INVOCACION:
# ---------------------------------------------
#  my ($email) = $elip_varglb::MAIL_CUOTA_TO;
#  my ($from) = $elip_varglb::MAIL_CUOTA_FROM;
#  my ($replyto_name) = $elip_varglb::MAIL_CUOTA_REPLYTO;
#  my ($replyto_email) =  $elip_varglb::MAIL_CUOTA_REPLYTO;
#  my ($asunto) = $elip_varglb::MAIL_CUOTA_SUBJECT;
#  my ($texto) = "El nro. de contactos ya ha alcanzado el máximo asignado en el mailcenter correspondiente. ENTIDAD[$FORM{'ENTIDAD'}]";
#  my ($htmldoc) = '';
#  my ($attach) = '';
#  my ($url) = '';
#  my ($dir_attach) = '';
#
#  &lib_mail::enviar_mail($email, $from, $replyto_name, $replyto_email, $asunto, $texto, $htmldoc, $attach, $url, $dir_attach, $smtp);

# @return string S (éxito) o N (error)
sub enviar_mail {  # FROM MAILCENTER

    my ($email, $from, $replyto_name, $replyto_email, $asunto, $texto, $htmldoc, $attach, $url, $dir_attach, $smtp) = @_;
    # my ($autor_replyto) = '"' . $replyto_name . '"' . " <" . $replyto_email . '>';
    my ($autor_replyto) = $replyto_email;
    my $filename = $attach;

    if ($attach ne '') {
        $attach = "$dir_attach/$attach";
    }

    if ($attach) {
        if ($htmldoc ne '') {
            $texto =~ s/\n/<br>\n/g;
            $htmldoc =~ s/(<body.*?>)/$1\n$texto<br>\n/is;
            $htmldoc = &procesar_html($htmldoc, $url);
            if (&mail_multipart($from, $email, $autor_replyto, $asunto, $htmldoc, $filename, $attach, 1, $smtp)) {
                return 'S';
            } else {
                return 'N';
            }
        } else {
            if (&mail_multipart($from, $email, $autor_replyto, $asunto, $texto, 0, $smtp)) {
                return 'S';
            } else {
                return 'N';
            }
        }
    } elsif ($htmldoc eq '') {
        if (&mail_text($from, $email, $autor_replyto, $asunto, $texto, 0, $smtp)) {
            # print STDERR "OK"; # DEBUG
            return 'S';
        } else {
            # print STDERR "FAIL"; # DEBUG
            return 'N';
        }
    } else{
        # Envio con html.
        if ($htmldoc ne '') {
            # Inserta bajo el body el $texto, transformando los \n en <br>
            $texto =~ s/\n/<br>\n/g;
            $htmldoc =~ s/(<body.*?>)/$1\n$texto<br>\n/is;
            $htmldoc = &procesar_html($htmldoc, $url);
            if (&mail_text($from, $email, $autor_replyto, $asunto, $htmldoc, 1, $smtp)) {
                return 'S';
            } else {
                return 'N';
            }
        } else {
            return 'N';
        }
    }
}

# ---------------------------------------------------------------
# Obtiene el contenido de la página pasada
# @param string $url la página a descargar
# @return string el texto obtenido o ''
sub get_html {  # FROM MAILCENTER
    my($url) = $_[0];
    return '' if (($url eq '') or ($url !~ /^https?/i));
    my($ua) = new LWP::UserAgent;
    my($request) = new HTTP::Request('GET', $url) || die $!;
    my($response) = $ua->request($request) || die $!;
    if ($response->is_success) {
        return $response->content;
    } else {
        return '';
    };

} # getHTML

# ---------------------------------------------------------------
# procesa un bloque de código HTML corrigiendo tags y paths.
# @param string $body el código html
# @param string $url una URL para asignar dominios a urls relativas.
# @return string el código corregido.
sub procesar_html {

    my($body, $url) = @_;

    # Agrega tag base si es que no esta.
    if ($body !~ /<BASE HREF=/i) {
        $body =~ s/<HEAD>/<head>\n<base href="$url">/i;
    };

    $url =~ /(https?\:\/\/.*?)\//i;
    my $theserver = $1;

    # Corrige paths no relativos.
    $body =~ s/ HREF="\// href="$theserver\//ig;
    $body =~ s/ SRC="\// src="$theserver\//ig;

    # Corrige la ausencia de retornos de carro.
    $body =~ s/\r\n/\n/sg;
    $body =~ s/\r/\n/sg;

    return $body;
}

# -------------------------------------------------------------------
# Recibe un mensaje relacionado con el envío de emails y lo imprime a STDERR.
# @param string $msg el error
# @return 0
sub err_mail {
    my $msg = $_[0];
    print STDERR $msg;
    return 0;
}

# ------------------------------------------------------------------
# Envía un email.
# @param string $from
# @param string $to
# @param string $replyto
# @param string $subject
# @param string $body
# @param bool $encode_html si enviar correo como html o como texto.
# @param string $smtp
# @return 1 (éxito) o el mensaje de error.
sub mail_text {
    my ($from, $to, $replyto, $subject, $body, $encode_html, $smtp) = @_;
    my ($message);

    eval { require Email::Sender;};
    my $no_hay_mailsender = $@;

    if ($no_hay_mailsender) { # intenta enviar con SENDMAIL
        print STDERR "No se encuentra modulo Email::Sender, enviando con SENDMAIL.\n";
        my $sendmail = "/usr/sbin/sendmail -t";

        open(my $SENDMAIL, '|', $sendmail) or return &err_mail("Error al enviar mail via SENDMAIL EN /usr/sbin/sendmail [$!]");
        print $SENDMAIL "From: $from\n";
        print $SENDMAIL "Reply-to: $replyto\n";
        print $SENDMAIL "Subject: $subject\n";
        print $SENDMAIL "To: $to\n";
        print $SENDMAIL "MIME-Version: 1.0\n";
        if ($encode_html) {
            print $SENDMAIL "Content-type: text/html\nContent-Transfer-Encoding: 7bit\n\n";
        } else {
            print $SENDMAIL "Content-type: text/plain\nContent-Transfer-Encoding: quoted-printable\n\n";
        }
        print $SENDMAIL $body;
        close($SENDMAIL);
        return 1;
    } else {
        #print STDERR "Usando modulo Email::Sender\n";
        require Email::Sender::Simple;
        require Email::Simple;
        require Email::Sender::Transport::SMTP;
        require Email::Simple::Creator;

        my $transport = Email::Sender::Transport::SMTP->new({
            host => $smtp,
            timeout => 20
        });

        my ($ctype, $charset, $encoding, $disposition);

        $ctype = 'text/html';
        $charset = 'utf-8';
        $encoding = "quoted-printable";
        $disposition = '';

        if ($encode_html) {
            $encoding = "quoted-printable";
            $ctype = 'text/html; charset='.$charset;
        } else {
            $encoding = "8bit";
            $ctype = 'text/plain; charset='.$charset;
        }

        # los strings se deben enviar como octetos (bytes) a email simple
        utf8::encode($body);

        my $encoded_subject = encode('MIME-Header', $subject);
        # elimina "vertical whitespaces" del subject
        $encoded_subject =~ s/\v+/\x20/g;

        $message = Email::Simple->create(
            header => [
                To => $to,
                From => $from,
                Subject => $encoded_subject,
                "Reply-To" => $replyto,
                "Content-Type" => $ctype,
                Encoding => $encoding,
                Disposition => $disposition,
                #Charset => $charset,
            ],
            body => $body,
        );

        # Envio de email html sin attachs
        eval { Email::Sender::Simple->send($message, {transport => $transport}); };
        if ($@) {
            return &err_mail("Error al enviar mail via Email::Sender[$@]\n");
        }
        return 1;
    }
}

# -------------------------------------------------------------------
# Envía un mail con adjuntos
# @param string $from
# @param string $to
# @param string $replyto
# @param string $subject
# @param string $body
# @param string $filename
# @param string $attach
# @param bool $encode_html
# @param string $smtp
# @return 1 (éxito) o el mensaje de error.
sub mail_multipart {

    my ($from, $to, $replyto, $subject, $body, $filename, $attach, $encode_html, $smtp) = @_;
    my ($sender);

    eval {require Email::Sender;};
    my $no_hay_mailsender = $@;

    if ($no_hay_mailsender) { # intenta enviar con SENDMAIL
        print STDERR "No se encuentra modulo Email::Sender, enviando con SENDMAIL.\n";
        my $sendmail = "/usr/sbin/sendmail -t";

        open(my $SENDMAIL, '|', $sendmail) or return &err_mail("Error al enviar mail via SENDMAIL EN /usr/sbin/sendmail [$!]");
        print $SENDMAIL "From: $from\n";
        print $SENDMAIL "Reply-to: $replyto\n";
        print $SENDMAIL "Subject: $subject\n";
        print $SENDMAIL "To: $to\n";
        print $SENDMAIL "MIME-Version: 1.0\n";
        if ($encode_html) {
            print $SENDMAIL "Content-type: text/html\nContent-Transfer-Encoding: 7bit\n\n";
        } else {
            print $SENDMAIL "Content-type: text/plain\nContent-Transfer-Encoding: quoted-printable\n\n";
        };
        print $SENDMAIL $body;
        close($SENDMAIL);
        return 1;

    } else {
        #~ print STDERR "Usando modulo Email::Sender\n";
        require Email::Sender::Simple;
        require Email::Simple;
        require Email::MIME;
        require IO::All;
        require Email::Sender::Transport::SMTP;
        require Email::Simple::Creator;
        require File::LibMagic;

        my $transport = Email::Sender::Transport::SMTP->new({
            host => $smtp,
            timeout => 20
        });
        my ($ctype, $charset, $encoding, $disposition);

        # detectamos el tipo de attachment
        my $magic = File::LibMagic->new();
        # retorna algo similar a => "image/jpeg; charset=binary"
        my $ctype_file = $magic->checktype_filename($attach);
        # se quita todo lo que viene despues del ;
        # o falla la librería Email::MIME
        $ctype_file = (split(';' , $ctype_file))[0];
        $ctype = 'text/html';
        $charset = 'utf-8';
        $encoding = "quoted-printable";
        $disposition = '';

        if ($encode_html) {
            $encoding = "quoted-printable";
            $ctype = 'text/html';
        } else {
            $encoding = "8bit";
            $ctype = 'text/plain';
        }

        # creacion de partes se hace por separado para identificar mejor errores
        my $part1 = Email::MIME->create(
                attributes => {
                    filename => $filename,
                    name => $attach,
                    content_type => $ctype_file,
                    encoding => 'base64',
                    disposition => 'attachment',
                },
                body => IO::All->new($attach)->binary->all,
            );
        my $part2 = Email::MIME->create(
                attributes => {
                    content_type => $ctype,
                    disposition => $disposition,
                    charset => $charset,
                    encoding => $encoding,
                },
                body_str => $body,
            );
        my @parts = ($part1, $part2);

        # elimina "vertical whitespaces" del subject
        $subject =~ s/\v+/\x20/g;

        my $email = Email::MIME->create(
            header_str => [
                To => $to,
                From => $from,
                Subject => $subject,
                "Reply-To" => $replyto,
                "Content-Type" => 'multipart/mixed',
                Encoding => $encoding,
                Charset => $charset,
            ],
            parts => [ @parts ],
        );

        # Envio de email con attachs

        eval { Email::Sender::Simple->send($email, {transport => $transport}); };
        if ($@) {
            return &err_mail("Error al enviar mail via Email::Sender[$@]\n");
        }
        return 1;
    }
}

1;
