File Coverage

blib/lib/App/Taskflow.pm

Criterion	Covered	Total	%
statement	18	115	15.6
branch	0	50	0.0
condition	0	23	0.0
subroutine	6	11	54.5
pod	5	5	100.0
total	29	204	14.2

package App::Taskflow;
use v5.10;
use POSIX qw(setsid);
our @EXPORT = qw/usage version taskflow daemonize/;# Symbols to autoexport (:DEFAULT tag)
use base qw/Exporter/;
use Log::Handler;
use DBM::Deep;
$|++; # disable buffering on STDOUT - autoflush

our $VERSION = '1.0';
our $re_line = qr/(?\w+):\s*(?.+?)\s*(\[(?\w+)\]\s*)?:\s*(?.*)\s*(?\&)?/;

sub daemonize {
    defined(my $pid = fork) or die "Can't fork: $!";
    exit if $pid;
    setsid or die "Can't start a new session: $!";
    umask 0;
}

sub load_config {
    my $config_filename = shift;
    my $data            = shift;
    return if (! -e $config_filename);
    my $config_mt = (stat $config_filename )[9];

    my @config = ();
    print '-'x10,' loading rules ','-'x10, "\n";
    my $lines = do {   # narrow scope
        local $/;      # Enter file slurp mode localized
        open my $in_fh, '<', $config_filename or "Cannot read '$config_filename': $!\n";
        <$in_fh>;      # slurp whole input file in a run
    };
    for my $line ( split(/\n/, $lines) ) {
        if ($line !~ /^#/ and $line =~ /:/) { # not starts with '#' and has ':'
            if ($line =~ /$re_line/) {
                print $line, "\n";
                my $name    = $+{n};
                my $pattern = $+{p};
                my $dt_str  = $+{dt} // '1';
                for (qw/1 s m h d/) {
                    $dt_str =~ s/s/*1/;
                    $dt_str =~ s/m/*60/;
                    $dt_str =~ s/h/*3600/;
                    $dt_str =~ s/d/*24*3600/;
                    $dt_str =~ s/w/*7*24*3600/;
                }
                my $dt = eval $dt_str;
                my $command   = $+{c};
                my $ampersand = $+{a};
                push @config, [$name,$pattern,$dt,$command,$ampersand];
                $data->{$name} = () if ( !$data->{$name} );
            }
        }
    }
    print '-'x35, "\n";
    return \@config, $config_mt;
}

sub taskflow {
    my ($folder, $logfile, $config_filename, $cache_filename, $target_name, $sleep) = @_;
    my $log = Log::Handler->new(file => {
        filename        => $logfile,
        maxlevel        => "debug",
        minlevel        => "emerg",
        message_layout  => "%T [%L] %S: %m" });
    my $data = DBM::Deep->new($cache_filename);
    my ($config, $config_mt) = load_config($config_filename, $data);
    my %processes = ();
    while (@$config){
        my $pause = 1;
        ($config, $config_mt) = load_config($config_filename, $data) if ($config_mt < (stat $config_filename )[9]);
        return if (!@$config);
        for my $clear (<.taskflow.*.clear>) {
            my $rule = substr($clear, 10, -6);
            $log->info('clearing rule '.$rule);
            delete $data->{$rule};
            unlink($clear);
        }
        for my $cfg (@$config) {
            next if (!defined $cfg);
            my ($name, $pattern, $dt, $action, $ampersand) = @$cfg;
            for my $filename (glob($pattern)) {
                next if (!$filename);
                my $mt =  (stat $filename)[9];
                next if ($mt > time - $dt);
                my $pid_file = $filename.".$name.pid";
                my $log_file = $filename.".$name.out";
                my $err_file = $filename.".$name.err";
                (my $key = $pattern.'='.$filename.':'.$action) =~ s/\s+/ /g;
                unless (-e $pid_file or -e $err_file) {
                    if (!exists $data->{$key} or $data->{$key} != $mt){
                        (my $command = $action) =~ s/\Q$target_name\E/$filename/g;
                        $log->info($filename.' -> '.$command); my $buffer;
                        my $return;
                        if (my $pid = fork) {
                            # parent - child process pid is available in $pid
                            open my $fh, '>', $pid_file or die $!;
                            print $fh $pid; # write pid
                            close $fh;
                            waitpid($pid, 0) unless ($ampersand);
                        } else { # $pid is zero here if defined
                            die "cannot fork: $!" unless defined $pid;
                            # parent process pid is available with getppid
                            open STDOUT, '>', $log_file;
                            open STDERR, '>', $log_file;
                            $return = system $command;
                            close STDOUT;
                            close STDERR;
                        }
                        $processes{$pid_file} = [$filename, $command, $return];
                    }
                }
                my @pids = keys %processes;
                if ($pid_file ~~ @pids and exists $processes{$pid_file}[2] and $processes{$pid_file}[2] == 0) {
                    my ($filename, $command, $return) = @{$processes{$pid_file}};
                    if ($return){
                        open my $fh, '>', $err_file or die $!;
                        print $fh $return;
                        close $fh;
                    }else{
                        $data->{$key}  = $mt;
                        $data->{$name}  = (defined $data->{$name}) ? $data->{$name}.' '.$key : $key;
                    }
                    delete $processes{$pid_file};
                    unlink $pid_file;
                    $pause = 0;
                } elsif (-e $pid_file and $pid_file !~ @pids ) {
                    unlink $pid_file;
                    $pause = 0;
                }
            }
           sleep $sleep if ($pause);
        }
    }
}

sub version { my $ver = shift // $VERSION; print "Version: $ver\n"; exit 0; }
sub usage   { system("perldoc $0"); exit 0; }
1; # End of App::Taskflow
__END__