File Coverage

lib/Time/Activated.pm

Criterion	Covered	Total	%
statement	62	63	98.4
branch	18	24	75.0
condition	4	6	66.6
subroutine	14	14	100.0
pod	5	5	100.0
total	103	112	91.9

package Time::Activated;

## no critic (ProhibitSubroutinePrototypes, ProhibitAutomaticExportation)

use strict;
use warnings;

use 5.8.8;

=pod

=encoding UTF-8

=cut

=head1 NAME

Time::Activated - Syntactic sugar over time activated code supporting DateTime and ISO8601 (a.k.a. "Javascript dates").

=head1 VERSION

Version 1.00

=cut

our $VERSION = 1.00;

=head1 SYNOPSIS

	use Time::Activated;

	# simple statements
	time_activated after_moment '1985-01-01T00:00:00' => execute_logic { print "New feature beginning Jan 1st 1985!" };
	time_activated before_moment '1986-12-31T00:00:00' => execute_logic { print "This feature ends by 1986!" };
	time_activated before_moment '2000' => execute_logic { print "Let's dance like its 1999!" };
	time_activated
		between_moments '2016-01-01T00:00:00' => '2016-12-31T23:59:59' =>
		execute_logic { print "Business logic exception for 2016!" };

	# combined statements a la try {} catch {} by Try::Tiny (tm)
	time_activated
		after_moment '1985-01T00:00:00-03:00' => execute_logic { print "New business logic!" }, # <-- Gotcha! it is a ,
		before_moment '1986-12-31T00:00:00-03:00' => execute_logic { print "Old business logic!" };

	# elements get evaluated in order
	time_activated
		before_moment '1986-12-31T00:00:00-03:00' => execute_logic { print "Old business logic!" }, # <-- Switch that ;
		after_moment '1985-01-01T00:00:00-03:00' => execute_logic { print "New business logic!" }; # <-- Switch that ,

	# overlapping allowed, all matching items get executed
	time_activated
		after_moment '2018', execute_logic { print "This is from 2018-01-01 and on." },
		after_moment '2018-06-01', execute_logic { print "This is from 2018-06-01 and on. On top of the previuos." };

	# Alternate syntax
	time_activated
		after_moment '2018', execute_logic { print "Welcome to new business process for 2018!" }, #=> is a ,
		after_moment '2019', execute_logic { print "This is added on top of 2018 processes for 2019!" };

	# DateTime objects can be used to define points in time
	my $dt = DateTime->new(year=>2018, month=>10, day=>16);
	time_activated after_moment $dt => execute_logic { print "This happens after 2018-10-16!" };

=head1 DESCRIPTION

This modules aims at managing and documenting time activated code such as that which may araise from migrations and planified process changes in a way that can be
integrated and tested in advance.

You can use Time::Activated C<before>, C<after> and C<between> to state which parts of code will be executed on certain dates due to changing business rules,
programmed web service changes in endpoints/contracts or other time related events.

=head1 USAGE



=cut

use Exporter 5.57 'import';
our @EXPORT = our @EXPORT_OK = qw(time_activated before_moment after_moment between_moments execute_logic);

=head1 EXPORTS

By default Time::Activated exports C<time_activated>, C<before>, C<after>, C<between> and C<execute>.

If you need to rename the C<time_activated>, C<after>, C<before>, C<between> or C<executye> keyword consider using L<Sub::Import|Sub::Import> to
get L<Sub::Exporter|Sub::Exporter>'s flexibility.

If automatic exporting sound nasty: use Time::Activated qw();

=head1 SYNTAX

time_activated "CONDITION" "WHEN" "WHAT"

=head2 "CONDITION"

Can be any of C<after_moment>, C<before_moment>, C<between_moments>.
C<after_moment>, accepts a parameters representing a point in time B<at and after> which the execute_logic statement will be executed.
C<before_moment>, accepts a parameters representing a point in time B<before, but not including>, which the execute_logic statement will be executed.
C<between_moments>, accepts two parameters representing a range in time B<between, both limits included>, which the execute_logic statement will be executed.

=head2 "WHEN"

Is either a DateTime object or a scalar representing a iso8601 (a.k.a. Javascript date)

Expansion is supported so '2000', '2000-01', '2000-01-01' and '2000-01-01T00:00' all are equivalents to '2000-01-01T00:00:00'.

Timezones are supported and honored. Thus:

    time_activated
		after_moment '1999-12-31T23:00:00-01:00' => execute_logic { print('Matches from 2000-01-01T00:00:00 GMT!') },
		after_moment '2000-01-01T00:00:00+01:00' => execute_logic { print('Matches from 1999-01-01T23:00:00 GMT!') };

C<after> includes the exact time which is used as parameter, C<before> does not.
Thus using C<after> and C<before> with the same time parameter ensures that only one statement gets executed.
i.e.:

	time_activated
		before_moment 	SOME_DATE => execute { print "Before!" },
		after_moment 	SOME_DATE => execute { print "After!" };


=head2 "WHAT"

Is either an anonymous code block or a reference to subroutine
Code that will be executed on a given conditions in many ways:

	time_activated
		after_moment '2001' => execute_logic \&my_great_new_feature; #No parameters can be passed with references...

	time_activated
		after_moment '2000' => execute_logic { print 'Y2K ready!' },
		after_moment '2001' => execute_logic (\&my_great_new_feature), #References with multilines need ()
		after_moment '2002' => execute_logic { &my_great_new_feature("We need parameters by 2002")};

=head2 CONSTANTS

It is cool to use constants documenting both time and intent.

	use constants PROCESS_X_CUTOVER_DATE => '2017-01-01T00:00:00';

	time_activated after_moment PROCESS_X_CUTOVER_DATE => execute_logic { &new_business_process($some_state) };

=cut

=head1 TESTING

L<Test::MockTime|Test::MockTime> is your friend.

	use Test::More tests => 1;
	use Time::Activated;
	use Test::MockTime;

	Test::MockTime::set_absolute_time('1986-05-27T00:00:00Z');
	time_activated after_moment '1985-01-01T00:00:00-03:00' => execute_logic { pass('Basic after') }; # this gets executed

	Test::MockTime::set_absolute_time('1984-05-27T00:00:00Z');
	time_activated after_moment '1985-01-01T00:00:00-03:00' => execute_logic { fail('Basic after') }; # this does not get executed

=cut

use Carp;
$Carp::Internal{ __PACKAGE__ }++;

use Sub::Name 0.08;
use DateTime;
use DateTime::Format::ISO8601;

=head1 SUBROUTINES/METHODS

=head2 time_activated

C<time_activated> is both the syntactical placeholder for grammar in C<Time::Activated> and the internal implementation of the modules functionality.

Syntactically the structure is like so (note the ','s and ';'):

	time_activated
		after_moment ..., execute_logic ...,
		before_moment ..., execute_logic ...,
		between_moments ..., ... execute_logic ...;

Alternatively some can be changed for a => for a fancy syntax. This abuses anonymous hashes, some inteligent selections of prototypes (stolen from L<Try::Tiny|Try::Tiny>) and probably
other clever perl-ish syntactical elements that escape my understanding. Note '=>'s, ','s and ';':

	time_activated
		after_moment ... => execute_logic ...,
		before_moment ... => execute_logic ...,
		between_moments ... => ... => execute_logic ...; #Given. This does not look so fancy but more into the weird side...

=cut

# Blatantly stolen from Try::Tiny since it really makes sence and changing it produces headaches.
# Need to prototype as @ not $$ because of the way Perl evaluates the prototype.
# Keeping it at $$ means you only ever get 1 sub because we need to eval in a list
# context & not a scalar one

sub time_activated (@) {
    my (@stanzas) = @_;
	my $activations = 0;

    my $now = DateTime->now();
    foreach my $stanza (@stanzas) {
		if (ref($stanza) eq 'Time::Activated::Before') {
			if ($now < $stanza->{before}) {
				$stanza->{code}();
				$activations++;
			}
		} elsif (ref($stanza) eq 'Time::Activated::After') {
			if ($now >= $stanza->{after}) {
				$stanza->{code}();
				$activations++;
			}
		} elsif (ref($stanza) eq 'Time::Activated::Between') {
			if ($stanza->{after} > $stanza->{before}) {
                my $before = $stanza->{after};
                $stanza->{after}  = $stanza->{before};
                $stanza->{before} = $before;
            }
			if ($now >= $stanza->{after} && $now <= $stanza->{before}) {
				$stanza->{code}();
				$activations++;
			};
		} else {
			croak('time_activated() encountered an unexpected argument (' . ( defined $stanza ? $stanza : 'undef' ) . ') - perhaps a missing semi-colon?' );
		}
    }
	return $activations;
}

=head2 before_moment

C<before_moment> defines a point in time before B<not including the exact point in time> which code is executed.

This does not happen before January 1st 2018 at 00:00 but does happen from that exact point in time and on.

	time_activated
		before_moment '2018', execute_logic { print "We are awaiting for 1/1/2018..." };

Another fancy way to say do not do that before January 1st 2018 at 00:00.

	ime_activated
		before_moment '2018' => execute_logic { print "We are awaiting for 1/1/2018..." };

A fancy way to combine before statements.

	time_activated
		before_moment '2018' => execute_logic { print "We are awaiting for 1/1/2018..." },
		before_moment '2019' => execute_logic { print "Not quite there for 1/1/2019..." };

=cut

sub before_moment ($$;@) {
    my ( $before, $block, @rest ) = @_;

    croak 'Useless bare before_moment()' unless wantarray;

    my $caller = caller;
    subname("${caller}::before_moment{...} " => $block);

    return (bless({before => _spawn_dt($before), code => $block},'Time::Activated::Before'), @rest);
}

=head2 after_moment

C<after_moment> defines a point in time after B<including the exact point in time> which code is executed.

	time_activated
		after_moment '2018' => execute { print "Wea are either at 1/1/2018 or after it..." };

As with C<before_moment> statements can be combined with C<before_moment>, C<after_moment> and C<between_moments> with no limit.

=cut

sub after_moment ($$;@) {
    my ( $after, $block, @rest ) = @_;

    croak 'Useless bare after_moment()' unless wantarray;

    my $caller = caller;
    subname("${caller}::after _moment{...} " => $block);

    return (bless({after => _spawn_dt($after), code => $block},'Time::Activated::After'), @rest);
}

=head2 between_moments

C<between_moments> defines two points in time between which code is executes B<including both exact points in time>.

	time_activated
		between_moment '2018' => '2018-12-31T23:59:59' => execute_logic { print "This is 2018..." };

As with C<before_moments> statements can be combined with C<before_moment>, C<after_moment> and C<between_moment> with no limit.

=cut

sub between_moments ($$$;@) {
    my ( $after, $before, $block, @rest ) = @_;

    croak 'Useless bare between_moments()' unless wantarray;

    my $caller = caller;
    subname("${caller}::between_moments{...} " => $block);

    return (bless({before => _spawn_dt($before), after => _spawn_dt($after), code => $block},'Time::Activated::Between'), @rest);
}

=head2 execute_logic

Exists for the sole reason of verbosity.
Accepts a single parameters that must be a subroutine or anonymous code block.

	execute_logic { print "This is a verbose way of saying that this will be executed!" };

=cut

sub execute_logic(&) {
	my ($code) = @_;
    return $code;
}

=head2 PRIVATES

=head3 _spawn_dt

C<_spawn_dt> is a private function defined in hopes that additional date formats can be used to define points in time.
Currently supported formtats for all date time.

=cut

sub _spawn_dt {
    my ($iso8601_or_datetime) = @_;

    my $dt = ref $iso8601_or_datetime && $iso8601_or_datetime->isa('DateTime')
      ? $iso8601_or_datetime
      : DateTime::Format::ISO8601->parse_datetime($iso8601_or_datetime);

    return $dt;
}

1;

__END__

=head1 DIAGNOSTICS

=over 4

=item time_activated

(F) time_activated() encountered an unexpected argument...

time_activated is not followed by either after_moment, before_moment or between_moments

	time_activated wierd_sub(); #<- Plain weird but it could somehow happen

=item after_moment before_moment between_moments

(F)	Useless bare after_moment()
(F)	Useless bare before_moment()
(F)	Useless bare between_moments()

Use of xxxxx() with no time_activated before it.
Generally the result of a ; instead of a ,.

	time_activated
		after_moment '2018' {}; #<- mind the ;
		before_moment '2018' {}; #<- This one triggers a 'Useless bare before()' since it is not part of the time_activated call

=head1 BUGS AND LIMITATIONS

No known bugs, but you cannot have this syntax.
Some , and/or => required:

	time_activated
		before_moment '2016-09-24' {}
		after_moment '2016-10-24' {};

=head1 DEPENDENCIES

L<DateTime|DateTime>, L<DateTime::Format::ISO8601|DateTime::Format::ISO8601>, L<Carp|Carp>, L<Exporter|Exporter>, L<Sub::Name|Sub::Name>.

=head1 INCOMPATIBILITIES

Versions prior to 1.00 have collission with Moose.
Naturally, Moose wins and compatibility breaks from 0.12 to 1.00.

=head1 SEE ALSO

=over 4

=item L<Try::Tiny|Try::Tiny>

A non related module that became the inspiration for Time::Activated.

=back

=head1 VERSION CONTROL

L<http://github.com/gbarco/Time-Activated/>

=head1 SUPPORT

Bugs may be submitted through L<the RT bug tracker|https://rt.cpan.org/Public/Dist/Display.html?Name=Time-Activated>
(or L<[e-mail]|mailto:[e-mail]>).

=head1 AUTHOR

=over 4

=item *

Gonzalo Barco <gbarco uy at gmail.com, no spaces>

=back

=head1 LICENSE AND COPYRIGHT

Copyright 2016 Gonzalo Barco.

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