#!/usr/bin/perl

use strict;
use warnings;
use Carp;
use utf8;

use Encode;
use English;
use Basicos::Config;
use File::Temp qw(tempfile);
use Mail::Sender;

our $VERSION = '0.03';

my $body_template = <<EOF;

Las siguientes cintas que necesita Bacula para completar
las copias de seguridad son las siguientes:

%s 

Atentamente
EOF

my %config = _configure(
    file    =>  q(/etc/bacula/next-media.conf),
    env     =>  q(NEXT_MEDIA),
    merge   =>  1,
    getopt  =>  {
        man     =>  sub { pod2usage(2) },
        version =>  sub { print "next_media - version ${VERSION}\n"; },
    },
    variables   => {
        email   =>  [ 'email=s', undef, q(email), 'root@localhost' ],
        jobs    =>  [ 'jobs=s', undef, q(jobs), undef ],
    },
    defaults    =>  {
        console =>  q(bconsole -c /home/victor/lib/bconsole.conf),
        mail    =>  {
            subject =>  q([Bacula] Las próximas cintas),
            body    =>  $body_template,
            smtp    =>  q(localhost),
            from    =>  q(bacula@localhost),
        },            
    }
);

my @jobs = split(m{[\s+,]+}, $config{jobs});
die "there are not jobs names" if not @jobs;

my  $body   =   undef;

#   between zero and five days forward
for my $try (0 .. 5) {
    #   query to director about the next jobs and media 
    my $text = _query_to_director(  
                        $config{console}, 
                        _build_session( jobs => \@jobs, days => $try ),
                    );

    $body = _build_email_body( $text );

    last if $body;
}    

if (not $body) {
    $body = <<EOF;
No puedo determinar cuáles son las 
siguientes cintas.
EOF
}

eval {
    my $msg = Mail::Sender->new( {
                smtp        =>  $config{mail}->{smtp},
                from        =>  $config{mail}->{from},
                subject     =>  encode('MIME-Header',$config{mail}->{subject}),
                to          =>  $config{email},
                charset     =>  'utf-8',
                on_errors   =>  'die',
            } );

    $msg->Open();
    $msg->print($body);
    $msg->Close();
};

if ($EVAL_ERROR) {
    die "could not send email - ${EVAL_ERROR}";
}    

exit(0);

sub _build_email_body {
    my  $text   =   shift;
    my  @tapes  =   ();

    foreach my $line (split(/\n/,$text)) {
        if ($line =~ m!^The next .* by Job "([\w\d_]+)" .* will be ([\w\d_-]+)$!) {
            push(@tapes, sprintf("%s -> %s\n", $1, $2));
        }        
    }

    return @tapes ? sprintf($config{mail}->{body}, join("\n", @tapes)) :
            undef;
}

sub _query_to_director {
    my  $bconsole   =   shift;        
    my  $session    =   shift;
    my  $response   =   "";

    if (my $fd = IO::File->new("${bconsole} < $session |")) {
        while (<$fd>) {
            $response .= $_;
        }
        $fd->close();
    } 
    else {
        die "could not contact with bacula director - $!";
    }        

    return $response;
}

sub _build_session {
    my  %args           =  @_;
    my  @jobs           = @{$args{jobs}};
    my  $days           = $args{days} == 0 ? '' :
                          sprintf('days=%u', $args{days});
    my ($fh, $fname)    = tempfile( DIR => '/tmp' );
                          
    foreach my $name (@jobs) {
        $fh->print(sprintf("list nextvol %s job=%s\n", $days, $name));
    }

    $fh->close();

    return $fname;
}

__END__
=pod

=head1 NAME

next_media - Obtiene los siguientes medios a usar en las copias con Bacula

=head1 USAGE

    next_media [options]

=head1 OPTIONS

=over

=item email

Define la dirección de correo a la cual enviar el informe. El valor
predeterminado es I<root@localhost>.

=item jobs

Lista de trabajos sobre los que consultar a bacula el siguiente medio físico
que usarán. Pueden definirse separados con espacios en blanco y/ó comas.

=item console

Línea de órdenes a utilizar para comunicarse con el director de copias. Por
defecto su valor es C<bconsole -c /etc/bacula/bconsole.conf>.

=item conf_file archivo

Permite determinar qué archivo de configuración leer.

=item version 

Muestra la version del programa

=item man

Muestra esta documentación

=back

=head1 DESCRIPTION

Este programa abre una sessión no interactiva con el director de copias
Bacula, mediante L<bconsole>, y le interroga acerca de los medios físicos a
utilizar en una serie concreta de trabajos. 

Una vez obtenido dichos medios mediante la instrucción de consola C<nextvol>,
prepara un resumen y envía un mensaje de correo a la dirección indicada. 

=head1 DIAGNOSTICS

=over 

=item Could not read the configuration file

El archivo de configuración indicado no puede leerse por falta de permisos.

=item could not send email

No se ha podido enviar el correo electrónico. 

=back

=head1 CONFIGURATION AND ENVIRONMENT

=head2 El archivo de configuración

Por defecto su ruta de acceso es F</etc/bacula/next-media.conf> y en él,
utilizando el formato de L<Config::General> se pueden y/ó deben definir los
siguientes valores:

=over 

=item email

=item jobs

=item console

=item sección mail

=over 

=item smtp

Servidor SMTP con el que comunicarse para enviar el correo. El valor
predeterminado es C<localhost>.

=item from

Dirección de correo del remitente. Por defecto es C<bacula@localhost>.

=item subject 

Texto descriptivo del mismo nombre en el mensaje de correo

=item body 

Texto con el cuerpo del mensaje. La lista de medios se incluirá en él,
sustituyendo la primera aparición de la expresión C<%s>.

=back

=head2 Entorno

El programa lee la variable de entorno C<NEXT_MEDIA> como alternativa para
encontrar el archivo de configuración. 

=head1 DEPENDENCIES

=over

=item Paquete bacula-console

=item Paquete libbasicos-perl

=item Paquete libmail-sender-perl

=back

=head1 BUGS AND LIMITATIONS

There are no known bugs in this module.

Please report problems to the author(s). 

Patches are welcome.

=head1 AUTHOR

Víctor Moral <victor@taquiones.net>, Angel Ortega <angel@triptico.com>

=head1 LICENCE AND COPYRIGHT

Copyright (c) 2006 <Venexma Europa, S.L.>. All rights reserved.

This module is free software; you can redistribute it and/or
modify it under the same terms as Perl itself. See L<perlartistic>.

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.

