—

              
package Devel::DDCWarn;
use strictures 2;
use Data::Dumper::Compact;
use base qw(Exporter);
our $VERSION = '0.006000';
$VERSION =~ tr/_//d;
our @EXPORT = map +($_, $_.'T'), qw(Df Dto Dwarn Derr);
our $ddc = Data::Dumper::Compact->new;
sub import {
  my ($class, @args) = @_;
  my $opts;
  if (@args and ref($args[0]) eq 'HASH') {
    $opts = shift @args;
  } else {
    while (@args and $args[0] =~ /^-(.*)$/) {
      my $k = $1;
      my $v = (shift(@args), shift(@args));
      $opts->{$k} = $v;
    }
  }
  $ddc = Data::Dumper::Compact->new($opts) if $opts;
  return if @args == 1 and $args[0] eq ':none';
  $class->export_to_level(1, @args);
}
sub _ef {
  map +(@_ > 1 ? [ list => $_ ] : $_->[0]),
    [ map $ddc->expand($_), @_ ];
}
sub Df { $ddc->format(_ef(@_)) }
sub DfT {
  my ($tag, @args) = @_;
  my @fmt = (ref($tag) eq 'ARRAY'
    ? do { ($tag, my $tweak) = @$tag; _ef($tweak->(@args)) }
    : _ef(@args)
  );
  $ddc->format([ list => [ [ key => $tag ], @fmt ] ]);
}
sub _dto {
  my ($fmt, $noret, $to, @args) = @_;
  return unless @args > $noret;
  $to->($fmt->(@args));
  return wantarray ? @args[$noret..$#args] : $args[$noret];
}
sub Dto { _dto(\&Df, 0, @_) }
sub DtoT { _dto(\&DfT, 1, @_) }
my $W = sub { warn $_[0] };
sub Dwarn { Dto($W, @_) }
sub DwarnT { DtoT($W, @_) }
sub Dwarn1 {
  return () unless @_;
  my $one = shift;
  wantarray ? (Dwarn($one), @_) : Dwarn($one)
}
my $E = sub { print STDERR $_[0] };
sub Derr { Dto($E, @_) }
sub DerrT { DtoT($E, @_) }
sub Derr1 {
  return () unless @_;
  my $one = shift;
  wantarray ? (Derr($one), @_) : Derr($one)
}
1;
HideShow 172 lines of Pod
=head1 NAME
Devel::DDCWarn - Easy printf-style debugging with L<Data::Dumper::Compact>
=head1 SYNOPSIS
  use Devel::DDCWarn;
   
  my $x = Dwarn some_sub_call(); # warns and returns value
  my @y = Derr other_sub_call(); # prints to STDERR and returns value
   
  my $x = DwarnT X => some_sub_call(); # warns with tag 'X' and returns value
  my @y = DerrT X => other_sub_call(); # similar
=head1 DESCRIPTION
L<Devel::DDCWarn> is a L<Devel::Dwarn> equivalent for L<Data::Dumper::Compact>.
The idea, basically, is that it's incredibly annoying to start off with code
like this:
  return some_sub_call();
and then realise you need the value, so you have to write:
  my @ret = some_sub_call();
  warn Dumper [ THE_THING => @ret ];
  return @ret;
With L<Devel::DDCWarn>, one can instead write:
  return DwarnT THE_THING => some_sub_call();
and expect it to Just Work.
To integrate with your logging, you can do:
  our $L = sub { $log->debug("DDC debugging: ".$_[0] };
  ...
  return DtoT $L, THE_THING => some_sub_call();
When applying printf debugging style approaches, it's also very useful to
be able to do:
  perl -MDevel::DDCwarn ...
and then within the code being debugged, abusing the fact that a prefix of ::
is short for main:: so we can add:
  return ::DwarnT THE_THING => some_sub_call();
and if we forget to remove them, the lack of command-line L<Devel::DDCWarn>
exported into main:: will produce a compile time failure. This is exceedingly
useful for noticing you forgot to remove a debug statement I<before> you
commit it along with the test and fix.
=head1 EXPORTS
All of these subroutines are exported by default.
L<Data::Dumper::Compact> is referred to herein as DDC.
=head2 Dwarn
  my $x = Dwarn make_x();
  my @y = Dwarn make_y_array();
C<warn()>s the L</Df> DDC dump of its input, then returns the first element
in scalar context or all arguments in list context.
=head2 Derr
  my $x = Derr make_x();
  my @y = Derr make_y_array();
prints the L</Df> DDC dump of its input to STDERR, then returns the first
element in scalar context or all arguments in list context.
=head2 DwarnT
  my $x = Dwarn TAG => make_x();
  my @y = Dwarn TAG => make_y_array();
Like L</Dwarn>, but passes its first argument, the tag, through to L</DfT>
but skips it for the return value.
=head2 DerrT
  my $x = Derr TAG => make_x();
  my @y = Derr TAG => make_y_array();
Like L</Derr>, but accepts a tag argument that is included in the output
but is skipped for the return value.
=head2 Dto
  Dto(sub { warn $_[0] }, @args);
Like L</Dwarn>, but instead of warning, calls the subroutine passed as the
first argument - this function is low level but still returns the C<@args>.
=head2 DtoT
  DtoT(sub { err $_[0] }, $tag, @args);
The tagged version of L<Dto>.
=head2 Df
  my $x = Df($thing);
  my $y = Df(@other_things);
A single value is returned formatted by DDC. Multiple values are transformed
to a DDC list.
=head2 DfT
  my $x = Df($tag => $thing);
  my $y = Df($tag => @other_things);
A tag plus a single value is formatted as a two element list. A tag plus
multiple values is formatted as a list containing the tag and a list of the
values.
If the tag is an arrayref, is assumed to be:
  my $x = Df([ $tag, $tweak ] => @things);
and what's dumped is C<<$tweak->(@things)>> instead of C<@things>. This
means that e.g. one can write:
  return Dwarn([ foo => sub { +{ @_ } } ], %things);
to output the things as a hashref while still returning a flattened hash.
=head1 CONFIGURATION
  use Devel::DDCWarn \%options, ...;
  perl -MDevel::DDCWarn=-optname,value,-other,value ...;
  $Devel::DDCWarn::ddc = Data::Dumper::Compact->new(\%options);
Options passed as a hashref on a C<use> line or using - prefixing on the
command line are used to initialise the L<Data::Dumper::Compact> object.
Note that this primarily being a debugging and/or scripting oriented tool, if
something initialises us again later, this will reset the (single) global
C<$ddc> used by this code and change all output throught the process.
However, if you need a localised change of formatting style, C<$ddc> is a full
fledged global so you are absolutely allowed to C<local> it:
  my $ddc = Data::Dumper::Compact->new(\%my_local_options);
  local $Devel::DDCWarn::ddc = $ddc;
If you have a convincing reason for using this functionality in a way where
the globality is a bug rather than a feature, please start a conversation
with the authors so we can figure out what to do about it.
=head1 COPYRIGHT
Copyright (c) 2019 the L<Data::Dumper::Compact/AUTHOR> and
L<Data::Dumper::Compact/CONTRIBUTORS> as listed in L<Data::Dumper::Compact>.
=head1 LICENSE
This library is free software and may be distributed under the same terms
as perl itself. See L<https://dev.perl.org/licenses/>.
=cut