File Coverage

blib/lib/Log/Defer.pm

Criterion	Covered	Total	%
statement	88	89	98.8
branch	24	38	63.1
condition	11	15	73.3
subroutine	16	16	100.0
pod	0	10	0.0
total	139	168	82.7

package Log::Defer;

use strict;

our $VERSION = '0.312';

use Time::HiRes;
use Carp qw/croak/;

use Guard;


sub new {
  my ($class, $cb, $opts) = @_;

  if ($cb) {
    if (ref $cb eq 'CODE') {
      $opts ||= {};
      croak "two callbacks provided" if $opts->{cb};
    } elsif (ref $cb eq 'HASH') {
      $opts = $cb;
      $cb = $opts->{cb};
    } else {
      croak "first arg to new must be a coderef or hashref";
    }
  }

  my $self = $opts;
  bless $self, $class;

  croak "must provide callback to Log::Defer" unless $cb && ref $cb eq 'CODE';

  my $msg = {
    start => format_time(Time::HiRes::time),
  };

  $self->{msg} = $msg;

  $self->{guard} = guard {
    my $end_time = format_time(Time::HiRes::time());
    my $duration = format_time($end_time - $msg->{start});
    $msg->{end} = $duration;

    if (exists $msg->{timers}) {
      foreach my $timer_entry (@{$msg->{timers}}) {
        push @$timer_entry, $duration
          if @$timer_entry == 2;
      }
    }

    $cb->($msg);
  };

  return $self;
}


sub error {
  my ($self, @logs) = @_;

  $self->add_log(10, @logs);
}

sub warn {
  my ($self, @logs) = @_;

  $self->add_log(20, @logs);
}

sub info {
  my ($self, @logs) = @_;

  $self->add_log(30, @logs);
}

sub debug {
  my ($self, @logs) = @_;

  $self->add_log(40, @logs);
}

sub add_log {
  my ($self, $verbosity, @logs) = @_;

  if (!exists $self->{verbosity} || $verbosity <= $self->{verbosity}) {
    my $time = format_time(Time::HiRes::time() - $self->{msg}->{start});

    @logs = $logs[0]->() if $logs[0] && ref $logs[0] eq 'CODE';

    push @{$self->{msg}->{logs}}, [$time, $verbosity, @logs];
  }
}


sub timer {
  my ($self, $name) = @_;

  ##croak "timer $name already registered" if defined $self->{msg}->{timers}->{$name};

  my $timer_start = format_time(Time::HiRes::time() - $self->{msg}->{start});

  ##$self->{msg}->{timers}->{$name} = [ $timer_start, ];

  my $msg = $self->{msg};

  my $timer_entry = [ $name, $timer_start, ];

  $msg->{timers} ||= [];

  push @{$msg->{timers}}, $timer_entry;

  return guard {
    my $timer_end = format_time(Time::HiRes::time() - $msg->{start});

    push @$timer_entry, $timer_end;
  }
}

sub data {
  my ($self) = @_;

  $self->{msg}->{data} ||= {};

  return $self->{msg}->{data};
}



sub merge {
  my ($self, $msg) = @_;

  my $time_offset = $msg->{start} - $self->{msg}->{start};

  ## Merge logs

  my @logs = (
               @{ $self->{msg}->{logs} || [] },
               (map { [ $_->[0] + $time_offset, @$_[1..(@$_-1)] ] } @{ $msg->{logs} || [] })
             );

  $self->{msg}->{logs} = [ sort { $a->[0] <=> $b->[0] } @logs ];

  ## Merge timers

  my $timers = [ @{ $msg->{timers} || [] } ];

  foreach my $timer_entry (@$timers) {
    $timer_entry->[1] += $time_offset;
    $timer_entry->[2] += $time_offset;
  }

  $self->{msg}->{timers} = [ @{ $self->{msg}->{timers} || [] }, @$timers, ];

  ## Merge data

  ## FIXME: This needs to do something like Hash::Merge but I don't want to add a dependency...

  $self->{msg}->{data} = { %{ $self->{msg}->{data} || {} }, %{ $msg->{data} || {} } };


  delete $self->{msg}->{logs} unless @{ $self->{msg}->{logs} };
  delete $self->{msg}->{timers} unless @{ $self->{msg}->{timers} };
  delete $self->{msg}->{data} unless keys %{ $self->{msg}->{data} };
}




#### INTERNAL ####

sub format_time {
  my $time = shift;

  $time = 0 if $time < 0;

  return 0.0 + sprintf("%.6f", $time);
}


1;




__END__