initial import

Changes

@@ -0,0 +1,4 @@
+Revision history for String-Flogger
+
+1.000     2008-10-13
+          first release

dist.ini

@@ -0,0 +1,17 @@
+dist    = String-Flogger
+version = 1.000
+author  = Ricardo SIGNES <rjbs@cpan.org>
+license = Perl_5
+copyright_holder = Ricardo SIGNES <rjbs@cpan.org>
+
+[Prereq]
+JSON          = 0
+Params::Util  = 0
+Scalar::Util  = 0
+Sub::Exporter = 0
+
+[@Filter]
+bundle = @Classic
+remove = PodVersion
+
+[PodWeaver]

lib/String/Flogger.pm

@@ -0,0 +1,85 @@
+use strict;
+use warnings;
+package String::Flogger;
+# ABSTRACT - string munging for loggers
+
+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 ];
+
+=head1 SYNOPSIS
+
+  use String::Flogger qw(flog);
+
+  my @inputs = (
+    'simple!',
+
+    [ 'slightly %s complex', 'more' ],
+
+    [ 'and inline some data: %s', { look => 'data!' } ],
+
+    [ 'and we can defer evaluation of %s if we want', sub { 'stuff' } ],
+
+    sub { 'while avoiding sprintfiness, if needed' },
+  );
+
+  say flog($_) for @inputs;
+
+The above will output:
+
+  simple!
+
+  slightly more complex
+
+  and inline some data: {{{ "look": "data!" }}}
+
+  and we can defer evaluation of %s if we want
+
+  while avoiding sprintfiness, if needed
+
+=cut
+
+sub _encrefs {
+  my ($self, $messages) = @_;
+  return map { ref $_ ? ('{{' . $self->_stringify_ref($_) . '}}') : $_ }
+         map { blessed($_) ? sprintf('obj(%s)', "$_") : $_ }
+         map { _CODELIKE($_) ? scalar $_->() : $_ }
+         @$messages;
+}
+
+my $JSON;
+sub _stringify_ref {
+  my ($self, $ref) = @_;
+
+  require JSON;
+  $JSON ||= JSON->new
+                ->ascii(1)
+                ->canonical(1)
+                ->allow_nonref(1)
+                ->space_after(1)
+                ->convert_blessed(1);
+
+  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 sprintf $fmt, $class->_encrefs(\@data);
+  }
+
+  return $class->_encrefs([ $input ]);
+}
+
+1;

t/synopsis.t

@@ -0,0 +1,31 @@
+#!perl
+use strict;
+use warnings;
+use Test::More tests => 5;
+use String::Flogger qw(flog);
+
+is(
+  flog('simple!'),
+  'simple!',
+);
+
+is(
+  flog([ 'slightly %s complex', 'more' ]),
+  'slightly more complex',
+);
+
+is(
+  flog([ 'and inline some data: %s', { look => 'data!' } ]),
+  'and inline some data: {{{"look": "data!"}}}',
+);
+
+is(
+  flog([ 'and we can defer evaluation of %s if we want', sub { 'stuff' } ]),
+  'and we can defer evaluation of stuff if we want',
+);
+
+is(
+  flog(sub { 'while avoiding sprintfiness, if needed' }),
+  'while avoiding sprintfiness, if needed',
+);
+