package cond_tp; use Moose; use namespace::autoclean; has 'foo' => ( is => 'rw', isa => 'Str', ); has 'bar' => ( is => 'rw', isa => 'Str', ); # set-up Test-Point depending on debug level { my $debug_level = $ENV{'MYDEBUG_LEVEL'} || 0; my $meta = Class::MOP::get_metaclass_by_name(__PACKAGE__); # enable TPs at debug level 5 and higher if($debug_level > 4){ $meta->add_attribute( tp_enabled => ( accessor => 'tp_enabled', init_arg => undef, # prevent override via new() predicate => 'has_tp_enabled' default => 1, # test-points are enabled writer => undef, # always read-only ) ); $meta->add_attribute( tp_callback => ( accessor => 'tp_callback', # default is rw predicate => 'has_tp_callback', default => sub {return;}, ) ); } else{ $meta->add_attribute( tp_enabled => ( accessor => 'tp_enabled', init_arg => undef, predicate => 'has_tp_enabled', default => 0, # test points are disabled writer => undef, ) ); $meta->add_attribute( tp_callback => ( accessor => 'tp_callback', predicate => 'has_tp_callback', default => sub {return;}, writer => undef, # cb is now read-only ) ); } } sub asub { my $self = shift; my $lvar_foo; my $lvar_bar; # some code that sets bar $self->bar('result'); # TP conditioned $self->tp_callback->('test_point_one') if $self->tp_enabled; # some code that sets a local vars $lvar_foo = 'yuca'; $lvar_bar = 'pelada'; # TP conditioned $self->tp_callback->('test_point_two', { lvar_foo => $lvar_foo, lvar_bar => $lvar_bar, }) if $self->tp_enabled; return 1; } __PACKAGE__->meta->make_immutable; 1;