File Coverage

blib/lib/Devel/Probe.pm

Criterion	Covered	Total	%
statement	63	63	100.0
branch	19	24	79.1
condition	9	11	81.8
subroutine	10	10	100.0
pod	0	3	0.0
total	101	111	90.9

package Devel::Probe;
use strict;
use warnings;

use XSLoader;
use Path::Tiny ();
use JSON::XS   ();

use constant {
    PROBE_CONFIG_NAME  => '/tmp/devel-probe-config.json',
    PROBE_SIGNAL_NAME  => 'HUP',
};

our $VERSION = '0.000003';
XSLoader::load( 'Devel::Probe', $VERSION );

my %known_options = map +( $_ => 1 ), qw/
    signal_name
    skip_install
    config_file
    check_config_file
/;

my $config_file;
my $signal_name;

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

    my %options = @opts;
    foreach my $option (keys %options) {
        die "Unrecognized option $option" unless exists $known_options{$option};
    }

    set_config_name($options{config_file});
    set_signal_name($options{signal_name});

    return if $options{skip_install};
    Devel::Probe::install();

    return unless $options{check_config_file};
    check_config_file("import");
}

sub set_config_name {
    my ($name) = @_;

    $config_file = $name // PROBE_CONFIG_NAME;
}

sub set_signal_name {
    my ($name) = @_;

    $signal_name = $name // PROBE_SIGNAL_NAME;
    $SIG{$signal_name} = \&Devel::Probe::check_config_file;
}

sub check_config_file {
    my ($reason) = @_;

    $reason //= 'manual';
    Devel::Probe::disable();

    my $path = Path::Tiny::path($config_file);
    return unless $path && $path->is_file();
    my $contents = $path->slurp_utf8();
    return unless $contents;
    my $data = JSON::XS->new->utf8->decode($contents);
    return unless $data;

    foreach my $action (@{ $data->{actions} }) {
        if ($action->{action} eq 'enable') {
            Devel::Probe::enable();
            next;
        }
        if ($action->{action} eq 'disable') {
            Devel::Probe::disable();
            next;
        }
        if ($action->{action} eq 'dump') {
            Devel::Probe::dump();
            next;
        }
        if ($action->{action} eq 'clear') {
            Devel::Probe::clear();
            next;
        }
        if ($action->{action} eq 'define') {
            my $file = $action->{file};
            next unless $file;
            foreach my $line (@{ $action->{lines} // [] }) {
                Devel::Probe::add_probe($file, $line);
            }
            next;
        }
    }
}


1;
__END__