File Coverage

blib/lib/String/Flogger.pm

Criterion	Covered	Total	%
statement	41	42	97.6
branch	15	16	93.7
condition	5	6	83.3
subroutine	10	11	90.9
pod	2	2	100.0
total	73	77	94.8

use strict;
use warnings;
package String::Flogger;
# ABSTRACT: string munging for loggers
$String::Flogger::VERSION = '1.101245';
use Params::Util qw(_ARRAYLIKE _CODELIKE);
use Scalar::Util qw(blessed);
use Sub::Exporter::Util ();
use Sub::Exporter -setup => [ flog => Sub::Exporter::Util::curry_method ];

#pod =head1 SYNOPSIS
#pod
#pod   use String::Flogger qw(flog);
#pod
#pod   my @inputs = (
#pod     'simple!',
#pod
#pod     [ 'slightly %s complex', 'more' ],
#pod
#pod     [ 'and inline some data: %s', { look => 'data!' } ],
#pod
#pod     [ 'and we can defer evaluation of %s if we want', sub { 'stuff' } ],
#pod
#pod     sub { 'while avoiding sprintfiness, if needed' },
#pod   );
#pod
#pod   say flog($_) for @inputs;
#pod
#pod The above will output:
#pod
#pod   simple!
#pod
#pod   slightly more complex
#pod
#pod   and inline some data: {{{ "look": "data!" }}}
#pod
#pod   and we can defer evaluation of stuff if we want
#pod
#pod   while avoiding sprintfiness, if needed
#pod
#pod =method flog
#pod
#pod This method is described in the synopsis.
#pod
#pod =method format_string
#pod
#pod   $flogger->format_string($fmt, \@input);
#pod
#pod This method is used to take the formatted arguments for a format string (when
#pod C is passed an arrayref) and turn it into a string.  By default, it just
#pod uses C>.
#pod
#pod =cut

sub _encrefs {
  my ($self, $messages) = @_;
  return map { blessed($_) ? sprintf('obj(%s)', "$_")
             : ref $_      ? $self->_stringify_ref($_)
             : defined $_  ? $_
             :              '{{null}}' }
         map { _CODELIKE($_) ? scalar $_->() : $_ }
         @$messages;
}

my $JSON;
sub _stringify_ref {
  my ($self, $ref) = @_;

  if (ref $ref eq 'SCALAR' or ref $ref eq 'REF') {
    my ($str) = $self->_encrefs([ $$ref ]);
    return "ref($str)";
  }

  require JSON::MaybeXS;
  $JSON ||= JSON::MaybeXS->new
                         ->ascii(1)
                         ->canonical(1)
                         ->allow_nonref(1)
                         ->space_after(1)
                         ->convert_blessed(1);

  # This is horrible.  Just horrible.  I wish I could do this with a callback
  # passed to JSON: https://rt.cpan.org/Ticket/Display.html?id=54321
  # -- rjbs, 2013-01-31
  local *UNIVERSAL::TO_JSON = sub { "obj($_[0])" };

  return '{{' . $JSON->encode($ref) . '}}'
}

sub flog {
  my ($class, $input) = @_;

  my $output;

  if (_CODELIKE($input)) {
    $input = $input->();
  }

  return $input unless ref $input;

  if (_ARRAYLIKE($input)) {
    my ($fmt, @data) = @$input;
    return $class->format_string($fmt, $class->_encrefs(\@data));
  }

  return $class->format_string('%s', $class->_encrefs([$input]));
}

sub format_string {
  my ($self, $fmt, @input) = @_;
  sprintf $fmt, @input;
}

1;

__END__