File Coverage

blib/lib/Devel/Spy.pm

Criterion	Covered	Total	%
statement	47	47	100.0
branch			n/a
condition			n/a
subroutine	15	15	100.0
pod	4	4	100.0
total	66	66	100.0

package Devel::Spy;
use strict;
use warnings;
use Devel::Spy::Util;
use Sub::Name ();

use Devel::Spy::_constants;

our $VERSION = '0.07';

sub new {
    my @self;

    # Store a tied wrapper over the object. This will be used anytime
    # thing is ever used as a value or reference.
    $self[TIED_PAYLOAD] = Devel::Spy::Util->wrap_thing( $_[_thing], $_[_logger] );

    # Store a plain copy of $thing as well. If $thing is an object the
    # method calls have to go through this copy instead. tied objects
    # can't be returned as objects from function calls.
    $self[UNTIED_PAYLOAD] = $_[_thing];

    # Store the reporting code, whatever that is.
    $self[CODE] = $_[_logger];

    return bless \@self, "$_[_class]\::_obj";
}

my $null_eventlog = Devel::Spy::Util->Y(
    Sub::Name::subname( null_eventlog_curry => sub {
        my $f = shift @_;
        return Sub::Name::subname( null_eventlog => sub {
            return $f;
        } );
    } )
);

sub make_null_eventlog {
    return $null_eventlog;
}

sub make_eventlog {

    # C returns a closure which appends a new element to a
    # log and returns a closure which appends to the new log entry.
    #
    #   my ( $log, $logger ) = Devel::Spy->make_eventlog;
    #
    #   my $foo = $logger->log( 'A' ); # pushes 'A' onto @$log
    #   $foo = $foo->( 'B' );          # Appends 'B' to 'A'
    #   $foo = $foo->( 'C' );          # Appends 'C' to 'AB'
    #   $foo = $foo->( 'D' );          # Appends 'D' to 'ABC'
    #
    #   my $bar = $logger->log( 1 )    # pushes '1' onto @$log
    #   $bar = $bar->( 2 );            # Appends '2' onto '1'
    #   $bar = $bar->( 3 );            # Appends '3' onto '12'
    #   $bar = $bar->( 4 );            # Appends '4' onto '123'

    my @eventlog;
    my $logger = Sub::Name::subname( EVENT => sub {

        # Add to the event log
        push @eventlog, "@_";

        # Let the caller add more information to this log entry
        # with more information as needed.
        my $followup = \$eventlog[-1];
        return Devel::Spy::Util->Y(
            Sub::Name::subname( eventlog_curry => sub {
                my $f = shift @_;
                Sub::Name::subname( eventlog_followup => sub {
                    $$followup .= "@_";
                    $f;
                } );
            }
        ) );
    } );

    return ( \@eventlog, $logger );
}

my $tattler = Devel::Spy::Util->Y(
    Sub::Name::subname( tattler_curry => sub {
        my $f = shift @_;
        return Sub::Name::subname( tattler => sub {
            local $\        = "\n";
            print for @_;
            return $f;
        } );
    }
) );

sub make_tattler {
    return $tattler;
}

# Include these *after* _compile is compiled because they'll want it available.
use Devel::Spy::_obj;
use Devel::Spy::TieScalar;
use Devel::Spy::TieArray;
use Devel::Spy::TieHash;
use Devel::Spy::TieHandle;

our $DEBUG;

1;

__END__