File Coverage

blib/lib/App/RunCron.pm

Criterion	Covered	Total	%
statement	130	149	87.2
branch	32	54	59.2
condition	30	48	62.5
subroutine	24	24	100.0
pod	6	7	85.7
total	222	282	78.7

package App::RunCron;
use 5.008001;
use strict;
use warnings;

our $VERSION = "0.07";

use Fcntl       qw(SEEK_SET);
use File::Temp  qw(tempfile);
use Time::HiRes qw/gettimeofday/;
use Sys::Hostname;

use Class::Accessor::Lite (
    new => 1,
    ro  => [qw/timestamp command reporter error_reporter common_reporter tag print/],
    rw  => [qw/logfile logpos exit_code _finished/],
);

sub _logfh {
    my $self = shift;

    $self->{_logfh} ||= do {
        my $logfh;
        my $logfile = $self->{logfile};
        if ($logfile) {
            open $logfh, '>>', $logfile or die "failed to open file:$logfile:$!";
        } else {
            ($logfh, $logfile) = tempfile(UNLINK => 1);
            $self->logfile($logfile);
        }
        autoflush $logfh 1;
        print $logfh '-'x78, "\n";
        $self->logpos(tell $logfh);
        die "failed to obtain position of logfile:$!" if $self->logpos == -1;
        seek $logfh, $self->logpos, SEEK_SET or die "cannot seek within logfile:$!";
        $logfh;
    };
}

sub run {
    my $self = shift;
    if (!$self->_finished) {
        $self->_run;
        exit $self->child_exit_code;
    }
    else {
        warn "already run. can't rerun.\n";
    }
}

sub command_str {
    my $self = shift;
    $self->{command_str} ||= join ' ', @{ $self->command };
}

sub _run {
    my $self = shift;
    die "no command specified" unless @{ $self->command };

    my $logfh = $self->_logfh;
    pipe my $logrh, my $logwh or die "failed to create pipe:$!";

    # exec
    $self->_log(sprintf("%s tag:[%s] starting: %s\n", hostname, $self->tag || '', $self->command_str));
    $self->exit_code(-1);
    unless (my $pid = fork) {
        if (defined $pid) {
            # child process
            close $logrh;
            close $logfh;
            open STDERR, '>&', $logwh or die "failed to redirect STDERR to logfile";
            open STDOUT, '>&', $logwh or die "failed to redirect STDOUT to logfile";
            close $logwh;
            exec @{ $self->command };
            die "exec(2) failed:$!:@{ $self->command }";
        }
        else {
            close $logrh;
            close $logwh;
            print $logfh, "fork(2) failed:$!\n" unless defined $pid;
        }
    }
    else {
        close $logwh;
        if ($self->print) {
            require PerlIO::Util;
            $self->_logfh->push_layer(tee => *STDOUT);
        }
        $self->_log($_) while <$logrh>;
        close $logrh;
        $self->_logfh->pop_layer if $self->print;
        while (wait == -1) {}
        $self->exit_code($?);
    }

    # end
    $self->_finished(1);
    $self->_log($self->result_line. "\n");

    if ($self->is_success) {
        $self->_send_report;
    }
    else {
        $self->_send_error_report;
    }
}

sub child_exit_code {
    my $self = shift;
    my $exit_code = $self->exit_code;
    return $exit_code if !$exit_code || $exit_code < 0;

    $self->exit_code >> 8;
}

sub child_signal {
    my $self = shift;
    my $exit_code = $self->exit_code;
    return $exit_code if !$exit_code || $exit_code < 0;

    $self->exit_code & 127;
}

sub is_success { shift->exit_code == 0 }

sub result_line {
    my $self = shift;
    $self->{result_line} ||= do {
        my $exit_code = $self->exit_code;
        if ($exit_code == -1) {
            "failed to execute command:$!";
        }
        elsif ($self->child_signal) {
            "command died with signal:" . $self->child_signal;
        }
        else {
            "command exited with code:" . $self->child_exit_code;
        }
    };
}

sub report {
    my $self = shift;

    $self->{report} ||= do {
        open my $fh, '<', $self->logfile  or die "failed to open @{[$self->logfile]}:$!";
        seek $fh, $self->logpos, SEEK_SET or die "failed to seek to the appropriate position in logfile:$!";
        my $report = '';
        $report .= $_ while <$fh>;
        $report;
    }
}

sub _send_report {
    my $self = shift;

    my $reporter = $self->reporter || 'None';
    $self->_do_send_report($reporter, $self->common_reporter || ());
}

sub _send_error_report {
    my $self = shift;

    my $reporter = $self->error_reporter || 'Stdout';
    $self->_do_send_report($reporter, $self->common_reporter || ());
}

sub _do_send_report {
    my ($self, @reporters) = @_;

    eval {
        # XXX error handling
        for my $reporter (@reporters) {
            if (ref($reporter) && ref($reporter) eq 'CODE') {
                $reporter->($self);
            }
            else {
                my @reporters = _retrieve_reporters($reporter);

                for my $r (@reporters) {
                    my ($class, $arg) = @$r;
                    _load_reporter($class)->new($arg || ())->run($self);
                }
            }
        }
    };
    if (my $err = $@) {
        warn $self->report;
        warn $err;
    }
}

sub _retrieve_reporters {
    my $reporter = shift;
    my @reporters;
    if (ref $reporter && ref($reporter) eq 'ARRAY') {
        my @stuffs = @$reporter;

        while (@stuffs) {
            my $reporter_class = shift @stuffs;
            my $arg;
            if ($stuffs[0] && ref $stuffs[0]) {
                $arg = shift @stuffs;
            }
            push @reporters, [$reporter_class, $arg || ()];
        }
    }
    else {
        push @reporters, [$reporter];
    }
    @reporters;
}

sub _load_reporter {
    my $class = shift;
    my $prefix = 'App::RunCron::Reporter';
    unless ($class =~ s/^\+// || $class =~ /^$prefix/) {
        $class = "$prefix\::$class";
    }

    my $file = $class;
    $file =~ s!::!/!g;
    require "$file.pm"; ## no citic

    $class;
}

sub _log {
    my ($self, $line) = @_;
    my $logfh = $self->_logfh;
    print $logfh (
        ($self->timestamp ? _timestamp() : ''),
        $line,
    );
}

sub _timestamp {
    my @tm = gettimeofday;
    my @dt = localtime $tm[0];
    sprintf('[%04d-%02d-%02d %02d:%02d:%02d.%06.0f] ',
        $dt[5] + 1900,
        $dt[4] + 1,
        $dt[3],
        $dt[2],
        $dt[1],
        $dt[0],
        $tm[1],
    );
}

__END__