view release on metacpan or  search on metacpan

lib/Data/Printer.pm  view on Meta::CPAN

    my $rc_filename = Data::Printer::Config::_get_first_rc_file_available();
    $rc_arguments = Data::Printer::Config::load_rc_file($rc_filename);

    if (
           exists $rc_arguments->{'_'}{live_update}
        && defined $rc_arguments->{'_'}{live_update}
        && $rc_arguments->{'_'}{live_update} =~ /\A\d+\z/
        && $rc_arguments->{'_'}{live_update} > 0) {
        my $now = time;
        my $last_mod = (stat $rc_filename)[9];
        {
            no warnings 'redefine';
            *_initialize = sub {
                if (time - $now > $rc_arguments->{'_'}{live_update}) {
                    my $new_last_mod = (stat $rc_filename)[9];
                    if (defined $new_last_mod && $new_last_mod > $last_mod) {
                        $now = time;
                        $last_mod = $new_last_mod;
                        $rc_arguments = Data::Printer::Config::load_rc_file($rc_filename);
                        if (!exists $rc_arguments->{'_'}{live_update} || !$rc_arguments->{'_'}{live_update}) {
                            *_initialize = sub {};
                        }
                    }
                }
            };
        }
    }
}

sub np (\[@$%&];%) {
    my (undef, %properties) = @_;

    _initialize();

    my $caller = caller;
    my $args_to_use = _fetch_args_with($caller, \%properties);
    return '' if $args_to_use->{quiet};
    my $printer = Data::Printer::Object->new($args_to_use);

    # force color level 0 on 'auto' colors:
    if ($printer->colored eq 'auto') {
        $printer->{_output_color_level} = 0;
    }

    my $ref = ref $_[0];
    if ($ref eq 'ARRAY' || $ref eq 'HASH' || ($ref eq 'REF' && ref ${$_[0]} eq 'REF')) {
        $printer->{_refcount_base}++;
    }
    my $output = $printer->parse($_[0]);
    if ($printer->caller_message_position eq 'after') {
        $output .= $printer->_write_label;
    }
    else {
        $output = $printer->_write_label . $output;
    }
    return $output;
}


sub p (\[@$%&];%) {
    my (undef, %properties) = @_;

    _initialize();

    my $caller = caller;
    my $args_to_use = _fetch_args_with($caller, \%properties);
    my $want_value = defined wantarray;

    # return as quickly as possible under 'quiet'.
    if ($args_to_use->{quiet}) {
        # we avoid creating a Data::Printer::Object instance
        # to speed things up, since we don't do anything under 'quiet'.
        my $return_type = Data::Printer::Common::_fetch_anyof(
            $args_to_use, 'return_value', 'pass', [qw(pass dump void)]
        );
        return _handle_output(undef, undef, $want_value, $_[0], $return_type, 1);
    }

    my $printer = Data::Printer::Object->new($args_to_use);

    if ($printer->colored eq 'auto' && $printer->return_value eq 'dump' && $want_value) {
        $printer->{_output_color_level} = 0;
    }

    my $ref = ref $_[0];
    if ($ref eq 'ARRAY' || $ref eq 'HASH' || ($ref eq 'REF' && ref ${$_[0]} eq 'REF')) {
        $printer->{_refcount_base}++;
    }
    my $output = $printer->parse($_[0]);
    if ($printer->caller_message_position eq 'after') {
        $output .= $printer->_write_label;
    }
    else {
        $output = $printer->_write_label . $output;
    }

    return _handle_output($output, $printer->{output_handle}, $want_value, $_[0], $printer->return_value, undef);
}

# This is a p() clone without prototypes. Just like regular Data::Dumper,
# this version expects a reference as its first argument. We make a single
# exception for when we only get one argument, in which case we ref it
# for the user and keep going.
sub _p_without_prototypes  {
    my (undef, %properties) = @_;

    my $item;
    if (!ref $_[0] && @_ == 1) {
        my $item_value = $_[0];
        $item = \$item_value;
    }

    _initialize();

    my $caller = caller;
    my $args_to_use = _fetch_args_with($caller, \%properties);
    my $want_value = defined wantarray;

    # return as quickly as possible under 'quiet'.
    if ($args_to_use->{quiet}) {