Group
Extension

App-Taskflow/lib/App/Taskflow.pm

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/(?<n>\w+):\s*(?<p>.+?)\s*(\[(?<dt>\w+)\]\s*)?:\s*(?<c>.*)\s*(?<a>\&)?/;

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__
=head1 NAME

App::Taskflow - a light weight file-based taskflow system

This module is the helper library for I<taskflow>. No user-serviceable
parts inside. Use I<taskflow> only.

For a complete documentation of I<taskflow>,  see its POD.

=head1 VERSION

Version 1.0

=cut

=head1 SYNOPSIS

    use App::Taskflow;
    workflow ($folder, $log, $config, $cache, $name, $sleep);
    ...

=head1 EXPORT

usage version taskflow daemonize

=head1 SUBROUTINES/METHODS

=head2 usage  

description and examples of usage

=head2 version 

Print-out of current version of script

=head2 taskflow 

Main function, a file-based taskflow system based on configuration file

=head2 load_config

Read configuration file and returns its content as a reference to an
array, and the modification time of configuration file

=head2 daemonize

Fork and detach from the parent process

=cut

=head1 AUTHOR

Farhad Fouladi, C<< <farhad at cpan.org> >>

=head1 BUGS

Please report any bugs or feature requests to C<bug-app-taskflow at rt.cpan.org>, or through
the web interface at L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=App-Taskflow>.  I will be notified, and then you'll
automatically be notified of progress on your bug as I make changes.

=head1 SUPPORT

You can find documentation for this module with the perldoc command.

    perldoc App::Taskflow

    or 

    perldoc taskflow

=over 4

=item * RT: CPAN's request tracker (report bugs here)

L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=App-Taskflow>

=item * AnnoCPAN: Annotated CPAN documentation

L<http://annocpan.org/dist/App-Taskflow>

=item * CPAN Ratings

L<http://cpanratings.perl.org/d/App-Taskflow>

=item * Search CPAN

L<http://search.cpan.org/dist/App-Taskflow/>

=back

=head1 ACKNOWLEDGEMENTS

=head1 LICENSE AND COPYRIGHT

Copyright 2012 Farhad Fouladi.

This program is free software; you can redistribute it and/or modify it
under the terms of either: the GNU General Public License as published
by the Free Software Foundation; or the Artistic License.

See http://dev.perl.org/licenses/ for more information.

=cut


Powered by Groonga
Maintained by Kenichi Ishigaki <ishigaki@cpan.org>. If you find anything, submit it on GitHub.