File Coverage

lib/Functional/Utility.pm

Criterion	Covered	Total	%
statement	58	58	100.0
branch	18	22	81.8
condition	15	18	83.3
subroutine	18	18	100.0
pod	4	7	57.1
total	113	123	91.8

use strict;
use warnings;
package Functional::Utility;
use base qw(Exporter);

use Time::HiRes ();

our @EXPORT_OK = qw(
  context
  hook_run_hook
  hook_run
  throttle
  y_combinator
);

# most of my modules start at 0.01. This one started at 1.01 because
# I actually use this code in production.
our $VERSION = 1.02;

sub context {
	my ($lookback) = @_;
	my $wa = (caller($lookback || 0))[5];
	return 'VOID' unless defined $wa;
	return 'SCALAR' if !$wa;
	return 'LIST' if $wa;
}

sub hook_run_hook {
	my ($pre, $code, $post) = @_;

	$pre->() if $pre;

	my $callers_context = context(1);
	my @ret;
	+{
	  LIST => sub { @ret = $code->() },
	  SCALAR => sub { $ret[0] = $code->() },
	  VOID => sub { $code->(); return },
	}->{$callers_context}->();

	$post->() if $post;

	return $callers_context eq 'LIST' ? @ret : $ret[0];
}

sub hook_run {
	my (%args) = @_;
	return hook_run_hook(@args{qw(before run after)});
}

{
	my ($delay_time, $nth_run);
	sub throttle_delay (&$) {
		my ($code, $delay) = @_;
		my $delta = Time::HiRes::time - ($delay_time = Time::HiRes::time);
		Time::HiRes::sleep($delay - $delta) if $nth_run && $delay - $delta > 0;
		$nth_run ||= 1;
		$code->();
	}

	my ($ultimate_factor_duration, $penultimate_factor_duration);
	sub throttle_factor (&$) {
		my ($code, $factor) = @_;
		my $start;
		return hook_run_hook(
			sub {
				# If we're about to excute the 3rd or higher run, we can easily calculate how much we need to sleep
				# so the delay between runs is the right $factor.
				my $catchup = (($penultimate_factor_duration || 0) * $factor) - ($ultimate_factor_duration || 0);
				Time::HiRes::sleep($catchup) if $catchup > 0;

				# Are we about to execute the 2nd run? If so, we should sleep a little before executing so the delay
				# between the 1st and 2nd run is the right $factor.
				my $whoa_there_nelly = defined $ultimate_factor_duration && ! defined $penultimate_factor_duration;

				$penultimate_factor_duration = $ultimate_factor_duration;

				if ($whoa_there_nelly) {
					my $catchup = (($penultimate_factor_duration || 0) * $factor) - ($ultimate_factor_duration || 0);
					Time::HiRes::sleep($catchup) if $catchup > 0;
				}

				$start = Time::HiRes::time;
			},
			$code,
			sub {
				$ultimate_factor_duration = Time::HiRes::time - $start;
			},
		);
	}

	sub throttle (&@) {
		my $type = splice @_, 1, 1;
		goto &throttle_delay if $type eq 'delay';
		goto &throttle_factor;
	}
}

sub y_combinator (&) {
	my $curried = shift;
	return sub {
		my $f1 = shift;
		return $curried->(sub { $f1->($f1)(@_) })
	}->(sub {
		my $f2 = shift;
		return $curried->(sub { $f2->($f2)(@_) });
	});
}

1;

__END__