File Coverage

blib/lib/Time/Checkpoint.pm

Criterion	Covered	Total	%
statement	42	66	63.6
branch	9	12	75.0
condition			n/a
subroutine	8	16	50.0
pod	10	10	100.0
total	69	104	66.3

package Time::Checkpoint;

use 5.12.0;

use feature qw{ state };

use Time::HiRes      qw{ time };
use Params::Validate qw{ :all };

use constant IDX_CALLBACK => 0;
use constant IDX_CKPOINTS => 1;

sub new {
	my $package = shift;

	state $val = {
		callback   => {
			type     => CODEREF,
			optional => 1,
		},
	};
	validate( @_, $val );

	my $self = [ ];

	if (defined { @_ }->{callback}) {
		$self->[IDX_CALLBACK] = { @_ }->{callback};
	}

	$self->[IDX_CKPOINTS] = { };

	return bless $self, $package;
}

sub checkpoint {
	state $val = [
		{ isa  => 'Time::Checkpoint', },
		{ type => SCALAR,             },
	];
	validate_pos( @_, @$val );

	my ($self, $cp) = (@_);

	if (not defined $self->[IDX_CKPOINTS]->{$cp}) {
		my $ot = undef;
		my $nt = time;
		if ($self->[IDX_CALLBACK]) {
			$self->[IDX_CALLBACK]->( $cp, $ot, $nt );
		}
		$self->[IDX_CKPOINTS]->{$cp} = $nt;
		return 0;
	}
	elsif (defined $self->[IDX_CKPOINTS]->{$cp}) {
		my $ot = $self->[IDX_CKPOINTS]->{$cp};
		my $nt = time;
		if ($self->[IDX_CALLBACK]) {
			$self->[IDX_CALLBACK]->( $cp, $self->[IDX_CKPOINTS]->{$cp}, $nt );
		}
		$self->[IDX_CKPOINTS]->{$cp} = $nt;
		return $nt - $ot;
	}
}

sub cp { checkpoint( @_ ) }

sub list_checkpoints {
	state $val = [
		{ isa => 'Time::Checkpoint' },
	];
	validate_pos( @_, @$val );
	my ($self) = (@_);
	my $points = $self->[IDX_CKPOINTS];
	return $points;
}

sub lscp { list_checkpoints( @_ ) }

sub checkpoint_status {
	state $val = [
		{ isa  => 'Time::Checkpoint', },
		{ type => SCALAR,             },
	];
	validate_pos( @_, @$val );

	my ($self, $cp) = (@_);

	return $self->[IDX_CKPOINTS]->{$cp};
}

sub cpstat { checkpoint_status( @_ ) }

sub checkpoint_remove {
	state $val = [
		{ isa  => 'Time::Checkpoint', },
		{ type => SCALAR,             },
	];
	validate_pos( @_, @$val );

	my ($self, $cp) = (@_);

	if (defined $self->[IDX_CKPOINTS]->{$cp}) {
		return delete $self->[IDX_CKPOINTS]->{$cp};
	}
	else {
		return undef;
	}
	return undef;
}

sub cprm { checkpoint_remove( @_ ) }

sub flush {
	state $val = [
		{ isa  => 'Time::Checkpoint', },
		{ type => SCALAR,             },
	];
	validate_pos( @_, @$val );

	my ($self)= (@_);

	$self->[IDX_CKPOINTS] = { };
}

1;

=pod

=head1 NAME

Time::Checkpoint

=head1 ABSTRACT

Simple module to report deltas between waypoints in code, with extensible
reactions.

=head1 SYNOPSIS

  my $t = Time::Checkpoint->new( );
  $t->checkpoint( 'Start' );

  # Code elapses ...

  my $delta = $t->checkpoint( 'Start' );

  # With callback

  my $t = Time::Checkpoint->new(
    callback => \&print_delta
  );

  $t->checkpoint( 'foo' );

  sub print_delta {
    my ($checkpoint, $old_time, $new_time) = (@_);
    my $delta = $new_time - $old_time;
    $LOG->debug( "$checkpoint: delta $delta seconds" );
  }

  # More code elapses...

  $t->checkpoint( 'foo' ); # print_delta is called

=head1 METHODS

=over 2

=head2 Constructor

=item B

=over 2

The constructor takes either no arguments or a hash with one key: I.
If a callback is passed (a code ref), that code will be called with the arguments
$name_of_checkpoint, $old_timestamp, $new_timestamp. Returns a Time::Checkpoint object.

=back

=item B

=item B

=over 2

Takes one argument, the name of the checkpoint reached. When called, it will perform
a hash lookup to determine when it was called last. It will return the delta between
the two. It will also call the 'callback' code, as mentioned above, provided it exists.

=back

=item B

=item B

=over 2

Takes no arguments. Returns a hash of checkpoints and their timestamps.

=back

=item B

=item B

=over 2

Returns the timestamp for a given checkpoint, or undef.

=back

=item B

=item B

=over 2

Removes the specified checkpoint, returning its value if it had one.

=back

=item B

=over 2

Removes all checkpoints.

=back

=head1 AUTHOR

  Jane A. Avriette

=head1 BUGS

Yep.

=cut

# jaa // vim:tw=80:ts=2:noet