lire 2:2.1.1-2.1 / usr / share / perl5 / Lire / OutputJob.pm

package Lire::OutputJob;

use strict;

use Lire::OutputFormat;
use Lire::Utils qw/check_param check_object_param/;
use Lire::PluginManager;

use Carp;

=pod

=head1 NAME

Lire::OutputJob - Object used to represent a configured formatting of a report

=head1 SYNOPSIS

  use Lire::OutputJob;
  use Lire::OutputFormat;

  my $email = new Lire::OutputJob( 'email', $output, $output_cfg,
                                   'emails' => [ 'email@domain.org' ] );

  $email->run( 'report.xml' );

  my $file = new Lire::OutputJob( 'file', $output, $output_cfg,
                                  'filename' => '/var/www/reports/daily-%Y%m%d'  );
  $file->run( 'report.xml' );

=head1 DESCRIPTION

The Lire::OutputJob objects are used to represent how a report should
formatted. These objects are most often created from the Lire
configuration. (The 'output_jobs' specification.)

=head1 new( $destination_type, $format, $format_cfg, ... );

Create a new Lire::OutputJob object. Two parameters are required:

=over

=item $destination_type

Can be either 'email' or 'file'.

=item $format

A Lire::OutputFormat object.

=item $format

The configuration data that will be passed to the OutputFormat
object.

=back

The method will returns an instance of Lire::EmailOutputJob or
Lire::FileOutputJob.

=cut

sub new {
    my ( $pkg, $type, $format, $format_cfg, %args ) = @_;

    check_param( $type, 'type', qr/^(email|file)$/,
                 "'type' parameter should be one of 'email' or 'file'" );
    check_object_param( $format, 'format', 'Lire::OutputFormat' );
    check_param( $format_cfg, 'format_cfg' );

    my $self = { '_format' => $format,
                 '_format_cfg' => $format_cfg,
               };
    if ( $type eq 'email' ) {
        bless $self, 'Lire::EmailOutputJob';
    } else {
        bless $self, 'Lire::FileOutputJob';
    }
    $self->init( %args );

    return $self;
}

=pod

=head2 format

Returns the Lire::OutputFormat associated with this OutputJob.

=cut

sub format {
    return $_[0]{'_format'};
}

=pod

=head2 format_cfg

Returns the configuration data that will be used when formatting the
report.

=cut

sub format_cfg {
    return $_[0]{'_format_cfg'};
}

=pod

=head2 run( $report_file )

Formats and sends or save the XML report $report_file according the
OutputJob parameters.

=cut

sub run {
    croak ref shift, "::run unimplemented";
}

sub new_from_config {
    my ( $pkg, $value ) = @_;

    my $format =
      Lire::PluginManager->get_plugin( 'output_format',
                                       $value->get( 'format' )->get_plugin() );
    return new Lire::OutputJob( $value->get( 'destination' )->get_plugin(),
                                $format,
                                $value->get( 'format' )->get_properties()->as_value(),
                                %{$value->get( 'destination' )->get_properties()->as_value()} );
}

package Lire::EmailOutputJob;

use base qw/Lire::OutputJob/;

use Lire::Utils qw/check_object_param file_content/;
eval "use MIME::Entity";

sub init {
    my ( $self,  %args ) = @_;

    check_object_param( $args{'emails'}, 'emails', 'ARRAY' );
    $self->{'_emails'} = $args{'emails'};
    $self->{'_subject'} = $args{'subject'} ? $args{'subject'} : '';
    $self->{'_subject'} = $args{'subject'} ? $args{'subject'} : '';
    $self->{'_extra_file'} = $args{'extra_file'};

    return;
}

=pod

=head1 Lire::EmailOutputJob

=head2 Extra parameters for 'email' type

=over

=item emails

An array reference to the emails that will receive the formatted report.

=item subjet

The subject of the email.

=item extra_file

An additional text file that will be appended to text report or attach
to other report types.

=back

=head2 emails()

Returns as an array the emails to which the report will be sent.

=cut


sub emails {
    return @{$_[0]{'_emails'}};
}

=pod

=head2 subject()

Returns the subject of the email.

=cut

sub subject {
    return $_[0]{'_subject'};
}

=pod

=head2 extra_file()

Returns the filename that will be appended to the text report or
attach to the message for other report's type.

=cut

sub extra_file {
    return $_[0]{'_extra_file'};
}

sub run {
    my ( $self, $report_file ) = @_;

    my $msg = $self->format()->mime_report( $report_file,
                                            $self->format_cfg() );
    if ( $self->{'_extra_file'} ) {
        if ( $msg->mime_type() eq 'text/plain' ) {
            my $new_content = $msg->bodyhandle()->as_string() 
              . "\n" . file_content( $self->{'_extra_file'} );
            my $io = $msg->open( 'w' );
            $io->print( $new_content );
            $io->close();
        } else {
            my $entity = MIME::Entity->build( 'Type' => 'multipart/mixed' );
            $entity->add_part( $msg );
            $msg = $entity;
            $msg->attach( 'Type' => 'text/plain',
                          'Path' => $self->{'_extra_file'} );
        }
    }
    $msg->head()->set( 'To', join( ", ", @{$self->{'_emails'}} ) );
    my $from = Lire::Config->get( 'lr_mail_from' ) || $ENV{'EMAIL'};
    $msg->head()->set( 'From', $from )
      if $from;
    $msg->head()->set( 'Subject', $self->subject() );
    my $reply_to = Lire::Config->get( 'lr_mail_reply_to' );
    $msg->head()->set( 'Reply-To', $reply_to )
      if $reply_to;

    my $pid = open( my $fh, "|-" );
    die "can't fork: $!\n"  unless defined $pid;
    if ( $pid ) {
	# Parent
	$msg->print( $fh );
	close $fh
	  or die "error: sendmail exited with non zero status: $?\n";
    } 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' ), @{$self->{'_emails'}} )
          or do {
              print STDERR "error executing sendmail: $!\n";
              # Since we are a fork, we don't want our die trapped.
              CORE::exit(1);
          };
    }

    return;
}

package Lire::FileOutputJob;

use base qw/Lire::OutputJob/;

use Lire::Utils qw/check_param/;

use POSIX qw/strftime/;

sub init {
    my ( $self,  %args ) = @_;

    check_param( $args{'file'}, 'file' );
    $self->{'_file'} = $args{'file'};

    return;
}

=pod

=head1 Lire::FileOutputJob

=head2 Extra parameters for 'file' type.

=over 4

=item file

A file path with possible strftime(3pm) interpolation. This will be
were the formatted report will be saved.

=back

=head2 file()

Returns this OutputJob destination file.

=cut

sub file {
    return $_[0]{'_file'};
}

=pod

=head2 output_file( [$time] )

Returns the  destination file with strftime(3) specifier interpolated.

=cut

sub output_file {
    my ( $self, $time ) = @_;

    $time ||= time();
    return strftime( $self->{'_file'}, localtime $time );
}

sub run {
    my ( $self, $report, $time ) = @_;

    check_param( $report, 'report' );

    $time ||= time();

    $self->format()->format_report( $report, $self->output_file( $time ),
                                    $self->format_cfg() );

    return;
}

# keep perl happy
1;

__END__

=pod

=head1 SEE ALSO

Lire::ReportJob(3pm) Lire::OutputFormat(3pm)

=head1 AUTHOR

  Francis J. Lacoste <flacoste@logreport.org>

=head1 VERSION

$Id: OutputJob.pm,v 1.8 2006/07/23 13:16:29 vanbaal Exp $

=head1 COPYRIGHT

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

This file is part of Lire.

Lire 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