view release on metacpan or  search on metacpan

lib/Devel/Optic.pm  view on Meta::CPAN

package Devel::Optic;
$Devel::Optic::VERSION = '0.015';
# ABSTRACT: Production safe data inspector

use strict;
use warnings;

use Carp qw(croak);
use Scalar::Util qw(looks_like_number);
use Ref::Util qw(is_ref is_arrayref is_hashref is_scalarref is_coderef is_regexpref);

use Sub::Info qw(sub_info);

use PadWalker qw(peek_my);

use Devel::Optic::Lens::Perlish;

use constant {
    DEFAULT_SCALAR_TRUNCATION_SIZE => 256,
    DEFAULT_SCALAR_SAMPLE_SIZE => 64,
    DEFAULT_SAMPLE_COUNT => 4,
};

sub new {
    my ($class, %params) = @_;
    my $uplevel = $params{uplevel} // 1;

    if (!$uplevel || !looks_like_number($uplevel) || $uplevel < 1) {
        croak "uplevel should be integer >= 1, not '$uplevel'";
    }

    my $self = {
        uplevel => $uplevel,

        # substr size for scalar subjects
        scalar_truncation_size => $params{scalar_truncation_size} // DEFAULT_SCALAR_TRUNCATION_SIZE,

        # when building a sample, how much of each scalar child to substr
        scalar_sample_size => $params{scalar_sample_size} // DEFAULT_SCALAR_SAMPLE_SIZE,

        # how many keys or indicies to display in a sample from a hashref/arrayref
        sample_count => $params{sample_count} // DEFAULT_SAMPLE_COUNT,

        lens => $params{lens} // Devel::Optic::Lens::Perlish->new,
    };

    bless $self, $class;
}

sub inspect {
    my ($self, $query) = @_;
    my $scope = peek_my($self->{uplevel});
    my $full_picture = $self->{lens}->inspect($scope, $query);
    return $self->fit_to_view($full_picture);
}

# This sub is effectively a very basic serializer. It could probably be made
# much more information-dense by adopting strategies from real serializers, or
# by incorporating hints from the user on their desired space<->thoroughness
# tradeoff.
sub fit_to_view {
    my ($self, $subject) = @_;

    my $ref = ref $subject;
    my $reasonably_summarized_with_substr = !is_ref($subject) || is_regexpref($subject) || is_scalarref($subject);

    if ($reasonably_summarized_with_substr) {
        if (!defined $subject) {
            return "(undef)";
        }