1use strict;
2use warnings;
3package String::Flogger;
4# ABSTRACT: string munging for loggers
5$String::Flogger::VERSION = '1.101245';
6use Params::Util qw(_ARRAYLIKE _CODELIKE);
7use Scalar::Util qw(blessed);
8use Sub::Exporter::Util ();
9use Sub::Exporter -setup => [ flog => Sub::Exporter::Util::curry_method ];
10
11#pod =head1 SYNOPSIS
12#pod
13#pod   use String::Flogger qw(flog);
14#pod
15#pod   my @inputs = (
16#pod     'simple!',
17#pod
18#pod     [ 'slightly %s complex', 'more' ],
19#pod
20#pod     [ 'and inline some data: %s', { look => 'data!' } ],
21#pod
22#pod     [ 'and we can defer evaluation of %s if we want', sub { 'stuff' } ],
23#pod
24#pod     sub { 'while avoiding sprintfiness, if needed' },
25#pod   );
26#pod
27#pod   say flog($_) for @inputs;
28#pod
29#pod The above will output:
30#pod
31#pod   simple!
32#pod
33#pod   slightly more complex
34#pod
35#pod   and inline some data: {{{ "look": "data!" }}}
36#pod
37#pod   and we can defer evaluation of stuff if we want
38#pod
39#pod   while avoiding sprintfiness, if needed
40#pod
41#pod =method flog
42#pod
43#pod This method is described in the synopsis.
44#pod
45#pod =method format_string
46#pod
47#pod   $flogger->format_string($fmt, \@input);
48#pod
49#pod This method is used to take the formatted arguments for a format string (when
50#pod C<flog> is passed an arrayref) and turn it into a string.  By default, it just
51#pod uses C<L<perlfunc/sprintf>>.
52#pod
53#pod =cut
54
55sub _encrefs {
56  my ($self, $messages) = @_;
57  return map { blessed($_) ? sprintf('obj(%s)', "$_")
58             : ref $_      ? $self->_stringify_ref($_)
59             : defined $_  ? $_
60             :              '{{null}}' }
61         map { _CODELIKE($_) ? scalar $_->() : $_ }
62         @$messages;
63}
64
65my $JSON;
66sub _stringify_ref {
67  my ($self, $ref) = @_;
68
69  if (ref $ref eq 'SCALAR' or ref $ref eq 'REF') {
70    my ($str) = $self->_encrefs([ $$ref ]);
71    return "ref($str)";
72  }
73
74  require JSON::MaybeXS;
75  $JSON ||= JSON::MaybeXS->new
76                         ->ascii(1)
77                         ->canonical(1)
78                         ->allow_nonref(1)
79                         ->space_after(1)
80                         ->convert_blessed(1);
81
82  # This is horrible.  Just horrible.  I wish I could do this with a callback
83  # passed to JSON: https://rt.cpan.org/Ticket/Display.html?id=54321
84  # -- rjbs, 2013-01-31
85  local *UNIVERSAL::TO_JSON = sub { "obj($_[0])" };
86
87  return '{{' . $JSON->encode($ref) . '}}'
88}
89
90sub flog {
91  my ($class, $input) = @_;
92
93  my $output;
94
95  if (_CODELIKE($input)) {
96    $input = $input->();
97  }
98
99  return $input unless ref $input;
100
101  if (_ARRAYLIKE($input)) {
102    my ($fmt, @data) = @$input;
103    return $class->format_string($fmt, $class->_encrefs(\@data));
104  }
105
106  return $class->format_string('%s', $class->_encrefs([$input]));
107}
108
109sub format_string {
110  my ($self, $fmt, @input) = @_;
111  sprintf $fmt, @input;
112}
113
1141;
115
116__END__
117
118=pod
119
120=encoding UTF-8
121
122=head1 NAME
123
124String::Flogger - string munging for loggers
125
126=head1 VERSION
127
128version 1.101245
129
130=head1 SYNOPSIS
131
132  use String::Flogger qw(flog);
133
134  my @inputs = (
135    'simple!',
136
137    [ 'slightly %s complex', 'more' ],
138
139    [ 'and inline some data: %s', { look => 'data!' } ],
140
141    [ 'and we can defer evaluation of %s if we want', sub { 'stuff' } ],
142
143    sub { 'while avoiding sprintfiness, if needed' },
144  );
145
146  say flog($_) for @inputs;
147
148The above will output:
149
150  simple!
151
152  slightly more complex
153
154  and inline some data: {{{ "look": "data!" }}}
155
156  and we can defer evaluation of stuff if we want
157
158  while avoiding sprintfiness, if needed
159
160=head1 METHODS
161
162=head2 flog
163
164This method is described in the synopsis.
165
166=head2 format_string
167
168  $flogger->format_string($fmt, \@input);
169
170This method is used to take the formatted arguments for a format string (when
171C<flog> is passed an arrayref) and turn it into a string.  By default, it just
172uses C<L<perlfunc/sprintf>>.
173
174=head1 AUTHOR
175
176Ricardo SIGNES <rjbs@cpan.org>
177
178=head1 COPYRIGHT AND LICENSE
179
180This software is copyright (c) 2014 by Ricardo SIGNES <rjbs@cpan.org>.
181
182This is free software; you can redistribute it and/or modify it under
183the same terms as the Perl 5 programming language system itself.
184
185=cut
186