File Coverage

blib/lib/Devel/Optic.pm

Criterion	Covered	Total	%
statement	84	88	95.4
branch	43	44	97.7
condition	18	20	90.0
subroutine	11	12	91.6
pod	3	3	100.0
total	159	167	95.2

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)";
        }

        if ($subject eq "") {
            return '"" (len 0)';
        }

        $subject = $$subject if is_scalarref($subject);
        my $scalar_truncation_size = $self->{scalar_truncation_size};
        my $len = length $subject;

        # simple scalars we can truncate (PadWalker always returns refs, so
        # this is pretty safe from accidentally substr-ing an array or hash).
        # Also, once we know we're dealing with a gigantic string (or
        # number...), we can trim much more aggressively without hurting user
        # understanding too much.

        if ($len <= $scalar_truncation_size) {
            return sprintf(
                "%s%s (len %d)",
                $ref ? "$ref " : "",
                $subject,
                $len,
            );
        }

        return sprintf(
            "%s%s (truncated to len %d; len %d)",
            $ref ? "$ref " : "",
            substr($subject, 0, $scalar_truncation_size) . "...",
            $scalar_truncation_size,
            $len,
        );
    }

    my $sample_count = $self->{sample_count};
    my $scalar_sample_size = $self->{scalar_sample_size};
    my $sample_text = "(no sample)";
    if (is_hashref($subject)) {
        my @sample;
        my @keys = keys %$subject;
        my $key_count = scalar @keys;
        $sample_count = $key_count > $sample_count ? $sample_count : $key_count;
        my @sample_keys = @keys[0 .. $sample_count - 1];
        for my $key (@sample_keys) {
            my $val = $subject->{$key};
            my $val_chunk;
            if (ref $val) {
                $val_chunk = ref $val;
            } elsif (!defined $val) {
                $val_chunk = '(undef)';
            } else {
                $val_chunk = substr($val, 0, $scalar_sample_size);
                $val_chunk .= '...' if length($val_chunk) < length($val);
            }
            my $key_chunk = substr($key, 0, $scalar_sample_size);
            $key_chunk .= '...' if length($key_chunk) < length($key);
            push @sample, sprintf("%s => %s", $key_chunk, $val_chunk);
        }
        $sample_text = sprintf("{%s%s} (%d keys)",
            join(', ', @sample),
            $key_count > $sample_count ? ' ...' : '',
            $key_count,
        );
    } elsif (is_arrayref($subject)) {
        my @sample;
        my $total_len = scalar @$subject;
        $sample_count = $total_len > $sample_count ? $sample_count : $total_len;
        for (my $i = 0; $i < $sample_count; $i++) {
            my $val = $subject->[$i];
            my $val_chunk;
            if (ref $val) {
                $val_chunk = ref $val;
            } elsif (!defined $val) {
                $val_chunk = '(undef)';
            } else {
                $val_chunk = substr($val, 0, $scalar_sample_size);
                $val_chunk .= '...' if length($val_chunk) < length($val);
            }
            push @sample, $val_chunk;
        }
        $sample_text = sprintf("[%s%s] (len %d)",
            join(', ', @sample),
            $total_len > $sample_count ? ' ...' : '',
            $total_len,
        );
    } elsif (is_coderef($subject)) {
        my $info = sub_info($subject);
        $sample_text = sprintf("sub %s { ... } (L%d-%d in %s (%s))",
            $info->{name},
            $info->{start_line},
            $info->{end_line},
            $info->{package},
            $info->{file},
        );
    }

    return "$ref: $sample_text";
}

1;

__END__