File Coverage

blib/lib/AnyEvent/Cron.pm

Criterion	Covered	Total	%
statement	13	15	86.6
branch			n/a
condition			n/a
subroutine	5	5	100.0
pod			n/a
total	18	20	90.0

package AnyEvent::Cron;
use warnings;
use strict;
use DateTime;
use AnyEvent;
use Moose;
use Try::Tiny;
use DateTime::Event::Cron;
use v5.12;

our $VERSION = '0.03';


# map of expiration formats to their respective time in seconds
my %_Expiration_Units = ( map(($_,             1), qw(s second seconds sec)),
                          map(($_,            60), qw(m minute minutes min)),
                          map(($_,         60*60), qw(h hour hours)),
                          map(($_,      60*60*24), qw(d day days)),
                          map(($_,    60*60*24*7), qw(w week weeks)),
                          map(($_,   60*60*24*30), qw(M month months)),
                          map(($_,  60*60*24*365), qw(y year years)) );

has interval =>
    ( is => 'rw' , isa => 'Int' , default => sub { 1 } );

has verbose =>
    ( is => 'rw' , isa => 'Bool' , default => sub { 0 } );

has debug =>
    ( is => 'rw' , isa => 'Bool' , default => sub { 0 } );

# TODO:
has ignore_floating =>
    ( is => 'rw',  isa => 'Bool' , default => sub { 0 } );

has jobs =>
    traits  => ['Array'],
    handles => {
        add_job => 'push'
    },
    is => 'rw',
    isa => 'ArrayRef' ,
    default => sub {  [ ] }

    ;


has timers => ( is => 'rw', isa => 'ArrayRef' , default => sub { [ ] } );

use Scalar::Util qw(refaddr);

sub add {
    my $self = shift;
    my ( $timespec, $cb , %args ) = @_;

    # try to create with crontab format
    try {
        my $cron_event = DateTime::Event::Cron->new($timespec);
        $self->add_job({
            event => $cron_event,
            cb => $cb,
            %args
        });
    }
    catch {
        given ( $timespec ) {
            # hour:minute per day
            when( m{^(\d+):(\d+)$} ) {
                my ( $hour, $minute ) = ( $1, $2 );
                $self->add_job({
                    time => { hour => $hour, minute => $minute },
                    cb => $cb,
                    %args,
                });
            }
            when( m{^\s*(\d+)\s*(\w+)} ) {
                my ( $number, $unit ) = ( $1, $2 );
                my $seconds = $number * $_Expiration_Units{$unit};
                $self->add_job({
                    seconds => $seconds,
                    cb      => $cb,
                    %args
                });
                # $self->create_interval_event( { second => $seconds, callback => $cb } );
            }
            default {
                die 'time string format is not supported.';
            }
        }
    };
    return $self;
}

sub _call_event {
    my ( $self, $e, $dt ) = @_;
    unless ( $e->{triggered} ) {
        print $e->{name} . " triggered\n" if $self->verbose;
        $e->{callback}->( $self, $e, $dt );
        $e->{triggered} = 1;
    }
}

sub _schedule {
    my ($self,$job) = @_;

    AnyEvent->now_update();
    my $now_epoch = AnyEvent->now;
    my $next_epoch;
    my $delay;
    my $name = $job->{name};
    my $debug = $job->{debug};

    if( $job->{event} ) {
        my $event = $job->{event};
        $next_epoch = $event->next->epoch;  # set next schedule time
        $delay      = $next_epoch - $now_epoch;
        warn "delay:",$delay if $debug;
    }
    elsif( $job->{seconds} ) {
        $next_epoch = $now_epoch + $job->{seconds};
        $delay      = $next_epoch - $now_epoch;
        warn "delay:",$delay if $debug;
    }
    elsif( $job->{time} ) {
        my $time = $job->{time};
        my $now = DateTime->from_epoch( epoch => $now_epoch ); # depends on now
        my $next = $now->clone;
        $next->set( %$time );

        # now > the scheduled time
        if( DateTime->compare( $now, $next ) == 1 ) {
            if( $time->{month} ) {
                $next->add( years => 1 );
            }
            elsif( $time->{day} ) {
                $next->add( months => 1 );
            }
            elsif( $time->{hour} ) {
                $next->add( days => 1 );
            }
            elsif( $time->{minute} ) {
                $next->add( hours => 1 );
            }
            elsif( $time->{second} ) {
                $next->add( minutes => 1 );
            }
            else {
                die 'unknown spec';
            }
        }
    }

    $job->{next}{ $next_epoch } = 1;
    $job->{watchers}{$next_epoch} = AnyEvent->timer(
        after    => $delay,
        cb       => sub {
            $self->{_cv}->begin;
            delete $job->{watchers}{$next_epoch};

            $self->_schedule($job) unless $job->{once};

            if ( $job->{single} && $job->{running}++ ) {
                print STDERR "Skipping job '$name' - still running\n"
                    if $debug;
            }
            else {
                eval { $job->{cb}->( $self->{_cv}, $job ); 1 }
                    or warn $@ || 'Unknown error';
                delete $job->{running};
                print STDERR "Finished job '$name'\n"
                    if $debug;
            }
            $self->{_cv}->end;
        }
    );
}

sub run {
    my $self = shift;
    my $cv = $self->{_cv} = AnyEvent->condvar;
    for my $job ( @{ $self->jobs } ) {
        $self->_schedule($job);
    }
}


1;
__END__

=head1 NAME

AnyEvent::Cron - Crontab in AnyEvent! provide an interface to register event on specified time.

=head1 SYNOPSIS

    my $cron = AnyEvent::Cron->new(
            verbose => 1,
            debug => 1,
            ignore_floating => 1
    );

                # 00:00 (hour:minute)
    $cron->add("00:00" => sub { warn "zero"; })
        ->add( '* * * * *' => sub {  } )
        ->add( '1 seconds' => sub {  } )
        ->add( '3 days' => sub {  } )
        ->run();

    my $cv = AnyEvent->condvar;
    $cv->recv;


=head1 METHODS

=head2 add( "12:36" => sub {     } )

=head2 add( DateTime->now => sub {     } )

=head1 AUTHOR

Cornelius, C<< <cornelius.howl_at_gmail.com> >>

=head1 BUGS

Please report any bugs or feature requests to C<bug-anyevent-cron at rt.cpan.org>, or through
the web interface at L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=AnyEvent-Cron>.  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 AnyEvent::Cron


You can also look for information at:

=over 4

=item * RT: CPAN's request tracker

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

=item * AnnoCPAN: Annotated CPAN documentation

L<http://annocpan.org/dist/AnyEvent-Cron>

=item * CPAN Ratings

L<http://cpanratings.perl.org/d/AnyEvent-Cron>

=item * Search CPAN

L<http://search.cpan.org/dist/AnyEvent-Cron/>

=back


=head1 ACKNOWLEDGEMENTS


=head1 LICENSE AND COPYRIGHT

Copyright 2010 Cornelius.

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

1; # End of AnyEvent::Cron