Data-Dumper-Interp
view release on metacpan or search on metacpan
lib/Data/Dumper/Interp.pm view on Meta::CPAN
#s/^[^diha]*\K(?:lvis|visl)/avisl/; # 'visl' same as 'avisl' for bw compat.
s/([ahid]?vis|set_defaults)// or error "can not infer the basic function";
my $basename = $1; # avis, hvis, ivis, dvis, or vis
my $N = s/(\d+)// ? $1 : undef;
my %mod = map{$_ => 1} split //, $_;
delete $mod{"_"}; # ignore underscores in names
if (($Debug//0) > 1) {
warn "## (D=$Debug) methname=$methname base=$basename \$_=$_\n";
}
## if ($basename =~ /^[id]/) {
## error "'$1' is inapplicable to $basename" if /([ahl])/;
## }
## error "'$1' mis-placed: Only allowed as '${1}vis'" if /([ahi])/;
# All these subs can be called as either or methods or functions.
# If the first argument is an object it is used, otherwise a new object
# is created; then option-setting methods are called as implied by
# the specific sub name.
#
# Finally the _Do() method is invoked for primatives like 'vis'.
#
# For ivis/dvis, control jumps to _Interpolate() which uses the object
# repeatedly when calling primatives to interpolate values into the string.
my $listform = '';
my $signature = $basename =~ /^[ah]/ ? '@' : '_'; # avis(@) ivis(_) vis(_)
my $code = "sub $methname($signature)";
if ($basename eq "vis") {
my $listform = delete($mod{l}) ? 'l' : '';
$code .= " { &__getself_s->_Listform('${listform}')";
}
elsif ($basename eq "avis") {
my $listform = delete($mod{l}) ? 'l' : 'a';
$code .= " { &__getself_a->_Listform('${listform}')";
}
elsif ($basename eq "hvis") {
my $listform = delete($mod{l}) ? 'l' : 'h';
$code .= " { &__getself_h->_Listform('${listform}')";
}
elsif ($basename eq "set_defaults") {
$code .= " { &__getself" ;
}
elsif ($basename eq "ivis") {
$code .= " { \@_ = ( &__getself" ;
}
elsif ($basename eq "dvis") {
$code .= " { \@_ = ( &__getself->_EnabUseqqFeature(_utfoutput() ? ':showspaces:condense' : ':condense')" ;
#$code .= " { \@_ = ( &__getself->_EnabUseqqFeature(':showspaces')" ;
}
else { oops "basename=",u($basename) }
my $useqq = "";
$useqq .= ":unicode:controlpics" if delete $mod{c};
$useqq .= ":condense" if delete $mod{C};
$code .= '->Debug(2)' if delete $mod{D};
$useqq .= ":hex" if delete $mod{h};
$code .= '->Objects(0)' if delete $mod{o}; # show internals
$code .= '->Objects({overloads => "transparent"})' if delete $mod{O}; # hide overloaded objects, not even showing classname
$useqq .= ":octets" if delete $mod{B};
$code .= '->Refaddr(1)' if delete $mod{r};
$useqq .= ":underscores" if delete $mod{u};
$code .= "->Useqq(\$Useqq.'${useqq}')" if $useqq ne "";
$code .= "->_EnabUseqqFeature(_utfoutput() ? ':showspaces:condense' : ':condense')" if delete($mod{d}) or $basename eq "dvis";
$code .= "->Useqq(0)" if delete $mod{q};
$code .= "->Maxdepth($N)" if defined($N);
if ($basename =~ /^([id])vis/) {
$code .= ", shift, '$1' ); goto &_Interpolate }";
}
elsif ($basename eq 'set_defaults') {
$code .= "->_SetDefaults }";
} else {
$code .= "->_Do }";
}
for (keys %mod) { error "Unknown or inappropriate modifier '$_'" }
if ($proto_only) {
$code =~ s/ *\{.*/;/ or oops;
}
# To see the generated code
# use Data::Dumper::Interp qw/:debug :DEFAULT/; # or :all
if ($Debug) {
warn "# generated: $code\n";
}
eval "$code"; oops "code=$code\n\$@=$@" if $@;
}#_generate_sub
sub visnew() { __PACKAGE__->new() } # shorthand
# $Carp::RefArgFormatter may be set to this to format traceback args
# The optional options are for use when currying, e.g.
# $Carp::RefArgFormatter = sub($) { Data::Dumper::Interp::CarpArgFormatter($_[0], Maxdepth=9, ...) }
sub RefArgFormatter {
my ($item, %opts) = @_;
$opts{Maxdepth} //= 3;
$opts{MaxStringwidth} //= 1000;
# Use whatever global defaults the user may have set...
#$opts{Refaddr} //= 1;
#$opts{Objects} //= {objects => 1, overloads => "tagged"};
my $obj = Data::Dumper::Interp::visnew;
for my $optname (keys %opts) {
$obj->$optname($opts{$optname});
}
return $obj->vis($item)
}
############# only internals follow ############
BEGIN {
if (! Data::Dumper->can("Maxrecurse")) {
# Supply if missing in older Data::Dumper
lib/Data/Dumper/Interp.pm view on Meta::CPAN
# # Some platforms (bsd?) carp if the terminal size can not be determined.
# # We don't want to see any such warnings. Also there might be a
# # __WARN__ trap which we don't want to trigger
# #
# # Sigh. It never ends! On some platforms (different libc?)
# # "stty" directly prints "stdin is not a tty" which we can not trap.
# # Probably this is a bug in Term::Readkey where it should redirect
# # such messages to /dev/null. So we have to do it here.
# require Capture::Tiny;
# () = Capture::Tiny::capture_merged(sub{
# delete local $SIG{__WARN__};
# delete local $SIG{__DIE__};
# ($width, $height) = eval{ Term::ReadKey::GetTerminalSize($fh) };
# });
}
return $width; # possibly undef (sometimes seems to be zero ?!?)
}
}
sub _set_default_Foldwidth() {
_SaveAndResetPunct();
$Foldwidth = _get_terminal_width || 80;
_RestorePunct();
undef $Foldwidth1;
}
use constant _UNIQUE => substr(refaddr \&oops,-5);
use constant {
_MAGIC_NOQUOTES_PFX => "|NQMagic${\_UNIQUE}|",
_MAGIC_KEEPQUOTES_PFX => "|KQMagic${\_UNIQUE}|",
_MAGIC_REFPFX => "|RPMagic${\_UNIQUE}|",
_MAGIC_ELIDE_NEXT => "|ENMagic${\_UNIQUE}|",
};
#---------------------------------------------------------------------------
my $my_maxdepth;
our $my_visit_depth = 0;
my ($maxstringwidth, $truncsuffix, $trunctailwidth, $objects,
$opt_refaddr, $listform, $debug);
my ($sortkeys, $ovopt);
sub _Do {
oops unless @_ == 1;
my $self = $_[0];
local $_;
&_SaveAndResetPunct;
($maxstringwidth, $truncsuffix, $trunctailwidth, $objects, $opt_refaddr, $listform, $debug)
= @$self{qw/MaxStringwidth Truncsuffix Trunctailwidth Objects Refaddr _Listform Debug/};
$sortkeys = $self->Sortkeys;
$maxstringwidth = 0 if ($maxstringwidth //= 0) >= INT_MAX;
$truncsuffix //= "...";
$trunctailwidth = min($trunctailwidth//0, $maxstringwidth);
$ovopt = "tagged";
if (ref($objects) eq "HASH") {
foreach my $key (keys %$objects) {
if ($key eq 'show_classname') { # DEPRECATED
$ovopt = $objects->{$key} ? "tagged" : "transparent"
}
elsif ($key eq 'overloads') {
if (!defined($objects->{$key})) {
$ovopt = "tagged";
}
elsif ($objects->{$key} =~ /^(?:tagged|transparent|ignore)$/) {
$ovopt = $objects->{$key}
}
else { confess "Invalid 'overloads' sub-opt value '$objects->{$key}'" }
}
elsif ($key eq 'objects') { }
else {
confess "Objects hashref value has unknown key '$key'\n";
}
}
$objects = $objects->{objects} // 1;
}
$objects = [ $objects ] unless ref($objects //= []) eq 'ARRAY';
my @orig_values = $self->dd->Values;
croak "Exactly one item may be in Values" if @orig_values != 1;
my $original = $orig_values[0];
btw "##ORIGINAL=",u($original),"=",_dbvis($original) if $debug;
_croak_or_confess "*vis($original) called in void context.\nDid you forget to 'say ...'?"
if ! defined wantarray;
# Allow one extra level if we wrapped the user's args in __getself_[ah]
$my_maxdepth = $self->Maxdepth || INT_MAX;
++$my_maxdepth if $listform && $my_maxdepth < INT_MAX;
oops unless $my_visit_depth == 0;
my $modified = $self->visit($original); # see Data::Visitor
btw "## DD input : ",_dbvis($modified) if $debug;
$self->dd->Values([$modified]);
# Always call Data::Dumper with Indent(0) and Pad("") to get a single
# maximally-compact string, and then manually fold the result to Foldwidth,
# inserting the user's Pad before each line *except* the first.
#
# Also disable Maxdepth because we handle that ourself (see visit_ref).
my $users_Maxdepth = $self->Maxdepth; # implemented by D::D
$self->Maxdepth(0);
my $users_pad = $self->Pad();
$self->Pad("");
my ($dd_result, $our_result);
my ($sAt, $sQ) = ($@, $?);
{ my $dd_warning = "";
{ local $SIG{__WARN__} = sub{ $dd_warning .= $_[0] };
eval{ $dd_result = $self->dd->Dump };
}
if ($dd_warning || $@) {
warn "Data::Dumper complained:\n$dd_warning\n$@" if $debug;
($@, $?) = ($sAt, $sQ);
$our_result = $self->dd->Values([$original])->Dump;
}
}
($@, $?) = ($sAt, $sQ);
$self->Pad($users_pad);
$self->Maxdepth($users_Maxdepth);
$our_result //= $self->_postprocess_DD_result($dd_result, $original);
lib/Data/Dumper/Interp.pm view on Meta::CPAN
These work the same way as variables/methods in Data::Dumper.
Each config method has a corresponding global variable
in package C<Data::Dumper::Interp> which provides the default value.
When a config method is called without arguments the current value is returned,
and when called with an argument the value is changed and
the object is returned so that calls can be chained.
=head2 MaxStringwidth(I<INTEGER>)
=head2 Truncsuffix(I<"...">)
=head2 Trunctailwidth(I<INTEGER>)
Longer strings are truncated and I<Truncsuffix> appended.
MaxStringwidth=0 (the default) means no length limit.
If I<Trunctailwidth> is set, characters are deleted from the middle, leaving
that many characters from the end of the string.
=head2 Foldwidth(I<INTEGER>)
Defaults to the terminal width at the time of first use.
=head2 Objects(I<FALSE>);
=head2 Objects(I<1>);
=head2 Objects(I<"classname">)
=head2 Objects(I<[ list of classnames ]>)
A I<false> value disables special handling of objects
(that is, blessed things) and internals are shown as with Data::Dumper.
A "1" (the default) enables for all objects,
otherwise only for the specified class name(s) or derived classes.
When enabled, object internals are never shown.
The class and abbreviated address are shown as with C<addrvis>
e.g. "Foo::Bar<392:0f0>", unless the object overloads
the stringification ('""') operator,
or array-, hash-, scalar-, or glob- deref operators;
in that case the first overloaded operator found will be evaluated,
the object replaced by the result, and the check repeated.
By default, "(classname)" is prepended to the result of an overloaded operator
to make clear what happened.
=head2 Objects(I<< {objects => VALUE, overloads => OVOPT} >>)
This form, passing a hashref,
allows passing additional options for blessed objects:
=over
B<overloads =E<gt> "tagged"> (the default): "(classname)" is prepended to the result when an overloaded operator is evaluated.
B<overloads =E<gt> "transparent"> : The overload results
will appear unadorned, i.e. they will look as if the overload result
was the original value.
B<overloads =E<gt> "ignore"> : Overloaded operators are not evaluated at all;
the original object's abbreviated refaddr is shown
(if you want to see object internals, disable I<Objects> entirely.)
Deprecated: B<show_classname =E<gt> False> : Please use S<< B<overloads =E<gt> "transparent"> instead. >>
=back
The I<objects> value indicates whether and for which classes special
object handling is enabled (false, "1", "classname" or [list of classnames]).
=head2 Refaddr(I<BOOL>)
If true, references are identified as with C<addrvis>.
=head2 Sortkeys(I<SUBREF>)
The default sorts numeric substrings in keys by numerical
value, e.g. "A.20" sorts before "A.100". See C<Data::Dumper> documentation.
=head2 Useqq(I<argument>)
0 means generate 'single quoted' strings when possible.
1 means generate "double quoted" strings as-is from Data::Dumper.
Non-ASCII charcters will likely appeqar as hex or octal escapes.
Otherwise generate "double quoted" strings enhanced according to option
keywords given as a :-separated list, e.g. Useqq("unicode:controlpics").
The avilable options are:
=over 4
=item "unicode"
Printable ("graphic")
characters are shown as themselves rather than hex escapes, and
'\n', '\t', etc. are shown for ASCII control codes.
=item "controlpics"
Show ASCII control characters using single "control picture" characters:
'â¤' is shown for newline instead of '\n', and
similarly †⇠∠⛠⌠â ≠for \0 \a \b \e \f \r \t.
Every character occupies the same space with a fixed-width font, but
the tiny "control picures" can be hard to read;
to see traditional \n etc. while still seeing wide characters as themselves,
set C<Useqq> to just "unicode";
=item "octets"
Optimize for viewing binary strings (i.e. strings of octets, not "wide"
characters). Octal escapes are shown instead of \n, \r, etc.
=item "showspaces"
Make space characters visible (as 'â£').
(An older "spacedots" option used Middle Dot for this purpose)
=item "condense"
Repeated characters in strings are shown as "⸨I<char>xI<repcount>⸩".
For example
( run in 0.623 second using v1.01-cache-2.11-cpan-39bf76dae61 )