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