File Coverage

lib/Text/Prefix.pm
Criterion Covered Total %
statement 101 116 87.0
branch 55 86 63.9
condition 18 33 54.5
subroutine 14 15 93.3
pod 2 3 66.6
total 190 253 75.1


line stmt bran cond sub pod time code
1             package Text::Prefix;
2              
3             # ABSTRACT: Prepend strings with timestamps and potentially other contextually-relevant information.
4              
5 2     2   182284 use strict;
  2         4  
  2         44  
6 2     2   10 use warnings;
  2         2  
  2         42  
7              
8 2     2   464 use Sys::Hostname;
  2         1554  
  2         89  
9 2     2   558 use File::Valet qw(rd_f wr_f ap_f);
  2         17869  
  2         113  
10 2     2   14 use Time::HiRes;
  2         4  
  2         13  
11 2     2   758 use Time::TAI::Simple;
  2         63647  
  2         111  
12              
13 2     2   14 use vars qw(@EXPORT @EXPORT_OK @ISA $VERSION);
  2         3  
  2         148  
14              
15             BEGIN {
16 2     2   13 require Exporter;
17 2         22 @ISA = qw(Exporter);
18 2         6 $VERSION = '1.00';
19 2         1971 @EXPORT = @EXPORT_OK = ();
20             }
21              
22             sub new {
23 5     5 1 1520 my ($class, %opt_hr) = @_;
24 5         13 my $self = {
25             opt_hr => \%opt_hr
26             };
27 5         10 bless ($self, $class);
28              
29 5         6 foreach my $k0 (keys %{$self->{opt_hr}}) {
  5         21  
30 10         19 my $k1 = join('_', split(/-/, $k0));
31 10 50       23 next if ($k0 eq $k1);
32 0         0 $self->{opt_hr}->{$k1} = $self->{opt_hr}->{$k0};
33 0         0 delete $self->{opt_hr}->{$k0};
34             }
35              
36 5         20 $self->{data_label} = $self->opt('label', 'd');
37 5         13 $self->{format} = $self->opt('format','space');
38 5 50       12 $self->{format} = 'kvp' if ($self->opt('kvp'));
39 5         14 $self->{host} = hostname();
40 5 50       56 $self->{host} = $1 if ($self->{host} =~ /(.+?)\./);
41 5 100       10 if (my $mask = $self->opt('host_sans')) {
42 2 50       33 $self->{host} = $1 if ($self->{host} =~ /(.+?)$mask$/);
43             }
44 5         14 $self->{perlcode} = $self->opt('perl', '');
45 5 50       16 if (my $pf = $self->opt('perlf')) {
46 0 0       0 die "no such file (passed via perlf): '$pf'" unless (-e $pf);
47 0         0 $self->{perlcode} = File::Valet::rd_f($pf);
48             }
49 5 100       26 $ENV{HOSTNAME} = $ENV{HOST} = $self->{host} if ($self->{perlcode} ne '');
50 5 100       9 if ($self->opt('order')) {
51 2         6 $self->{order_ar} = [split(/\s*,\s*/, $self->opt('order'))];
52             } else {
53 3         4 my @order_list;
54 3 50 66     4 push @order_list, 'lt' unless ($self->opt('no_date') || $self->opt('no_time') || $self->opt('no_human_date'));
      66        
55 3 50 66     10 push @order_list, 'tm' unless ($self->opt('no_date') || $self->opt('no_time') || $self->opt('no_epoch'));
      66        
56 3 50 33     7 push @order_list, 'hn' if ($self->opt('host') || $self->opt('host_sans'));
57 3 100       7 push @order_list, 'st' if ($self->opt('with'));
58 3 50 33     7 push @order_list, 'pl' if ($self->opt('perl') || $self->opt('perlf'));
59 3         7 push @order_list, $self->{data_label};
60 3         5 $self->{order_ar} = \@order_list;
61             }
62              
63 5 100       12 if (my $tai = $self->opt('tai')) {
64 2         3 my $tai_mode = 'tai10';
65 2 50       5 $tai_mode = 'tai35' if ($tai eq '35');
66 2 50       5 $tai_mode = 'tai' if ($tai eq '0');
67 2         11 $self->{tai_or} = Time::TAI::Simple->new(mode => $tai_mode);
68             }
69              
70 5         1449 return $self;
71             }
72              
73             sub prefix {
74 3     3 1 12 my ($self, $s) = @_;
75 3 50       4 ap_f($self->opt('pretee'), $s) if ($self->opt('pretee'));
76 3         5 chomp($s);
77 3         5 my $pl = '';
78 3 100       42 $pl = join(' ', split(/[\r\n]+/, eval($self->{perlcode}))) if ($self->{perlcode} ne '');
79 3         9 my $hr = {$self->{data_label} => $s};
80 3 100 66     12 $hr->{tm} = $self->_tm() unless ($self->opt('no_date') || $self->opt('no_epoch'));
81 3 100 66     8 $hr->{lt} = $self->_lt() unless ($self->opt('no_date') || $self->opt('no_human_date'));
82 3 100 66     10 $hr->{hn} = $self->{host} if ($self->opt('host') || $self->opt('host_sans'));
83 3 100       11 $hr->{st} = $self->opt('with') if ($self->opt('with'));
84 3 100 66     5 $hr->{pl} = $pl if ($self->opt('perl') || $self->opt('perlf'));
85 3         6 my $output = '';
86 3 50       4 my $pad = $self->opt('no_space') ? '' : ' ';
87 3         6 foreach my $k (@{$self->{order_ar}}) {
  3         4  
88 9 50       16 next unless(defined($hr->{$k}));
89 9         10 my $v = $hr->{$k};
90 9 50       17 if ($self->{format} eq 'kvp') {
    50          
    50          
91 0         0 $output .= "$k=$v\t";
92             }
93             elsif ($self->{format} eq 'csv') {
94 0         0 $output .= "\"$v\",";
95             }
96             elsif ($self->{format} eq 'tab') {
97 0         0 $output .= "$v\t";
98             }
99             else { # assume 'space'
100 9         15 $output .= "$v$pad";
101             }
102             }
103 3 50       6 chop($output) if ($pad);
104 3 50       4 ap_f($self->opt('tee'), "$output\n") if ($self->opt('tee'));
105 3         10 return $output;
106             }
107              
108             sub _isotime {
109 0     0   0 my ($self, $tm) = @_;
110 0 0       0 $tm = $self->_tm() unless(defined($tm));
111 0         0 my ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst) = localtime($tm);
112 0         0 my $iso_date = sprintf('%04d-%02d-%02d', $year + 1900, $mon + 1, $mday);
113 0         0 my $iso_time = sprintf('%02d:%02d:%02d', $hour, $min, $sec);
114 0 0 0     0 $iso_time .= substr($tm-int($tm), 1, 5) if ($self->opt('hires') || $self->opt('tai'));
115 0         0 return "$iso_date $iso_time";
116             }
117              
118             sub _tm {
119 4     4   6 my ($self) = @_;
120 4         5 my $tm;
121 4 100       12 $tm = $self->{tai_or}->time() if (defined($self->{tai_or}));
122 4 50       12 $tm = Time::HiRes::time() if ($self->opt('hires'));
123 4 100       12 $tm = time() unless($tm);
124 4 100       24 if ($tm =~ /\.\d+/) {
125 2 50       8 if (length($tm) >= 15) {
126 2         6 $tm = substr($tm, 0, 15);
127             } else {
128 0         0 $tm .= '0'x(15-length($tm));
129             }
130             }
131 4         9 return $tm;
132             }
133              
134             sub _lt {
135 2     2   4 my ($self, $tm) = @_;
136 2 50       4 $tm = $self->_tm() unless(defined($tm));
137 2 50       4 return $self->_isotime($tm) if ($self->opt('iso'));
138 2         57 my $lt = localtime($tm);
139 2 50       6 return substr($lt, 4, 15) if ($self->opt('short'));
140 2 50       7 return substr($lt, 11, 5) if ($self->opt('shorter'));
141 2         8 return $lt;
142             }
143              
144             sub opt {
145 115     115 0 145 my ($self, $name, $default_value, $alt_hr) = @_;
146 115         253 return _def($self->{opt_hr}->{$name}, $alt_hr->{$name}, $default_value);
147             }
148              
149             sub _def {
150 115 100   115   128 foreach my $v (@_) { return $v if (defined($v)); }
  307         460  
151 83         211 return undef;
152             }
153              
154             1;
155              
156             =head1 NAME
157              
158             Text::Prefix - Prepend strings with timestamps and potentially other contextually-relevant information.
159              
160             =head1 SYNOPSIS
161              
162             use Text::Prefix;
163              
164             # Simple case: prepend strings with timestamps.
165             #
166             my $px = Text::Prefix->new(); # default just prepends timestamp
167             my $s = $px->prefix("some string");
168             #
169             # $s is now: "Fri Jun 9 16:45:25 2017 1497051925 some string"
170              
171             # More complex case: ISO timestamp, no epoch timestamp, high-resolution
172             # TAI-10 time, hostname, and length of string, in CSV format
173             #
174             my $px = Text::Prefix->new(
175             format => 'csv',
176             host => 1,
177             iso => 1,
178             no_epoch => 1,
179             perl => 'length($s)',
180             tai => 1
181             );
182             my $s = $px->prefix("another string");
183             #
184             # $s is now: '"2017-06-09 16:50:59.9161","xiombarg","14","another string"'
185              
186             =head1 DESCRIPTION
187              
188             B contains the logic implementing the B utility (included in this package). It takes arbitrary strings as
189             input and produces output with various contextually-relevant information preceding the string. A variety of output formats are also
190             supported, as well as output field reordering.
191              
192             This is handy, for instance, when tailing a logfile which does not contain timestamps. B adds a timestamp prefix to each
193             line it is given.
194              
195             =head1 METHODS
196              
197             There are only two methods provided by this package, C and C.
198              
199             =over 4
200              
201             =item B (%options)
202              
203             =over 4
204              
205             (Class method) Returns a new instance of B. The object's default attributes are overridden by any options given.
206              
207             Currently the following attributes may be set:
208              
209             =over 4
210              
211             B =E kvp, tab, csv, space
212              
213             Format the output as a kvp (tab-delimited "key=value" pairs), tab-delimited, comma-delimited, or space-delimited values.
214              
215             (default: "space")
216              
217             B =E 0, 1
218              
219             Set to 1 to use high-resolution timestamps.
220              
221             (default: 0)
222              
223             B =E 0, 1
224              
225             Set to 1 to prefix output with the local hostname.
226              
227             (default: 0)
228              
229             B =E regular expression string
230              
231             Set to a string to exclude the matching part of the hostname from prefix. Implies setting B.
232              
233             (default: none)
234              
235             B =E 0, 1
236              
237             Set to 1 to use ISO-8601 formatted timestamps (more or less).
238              
239             (default: 0)
240              
241             B
242              
243             When output format is "kvp", use the provided string as the key value for the field containing the input string.
244              
245             (default: "d")
246              
247             B =E 0, 1
248              
249             Set to 1 to omit any timestamps from prefixed text (corresponding to output fields "lt" and "tm").
250              
251             (default: 0)
252              
253             B =E 0, 1
254              
255             Set to 1 to omit human-readable timestamps from prefixed text (corresponding to output field "lt").
256              
257             (default: 0)
258              
259             B =E 0, 1
260              
261             Set to 1 to omit epoch timestamps from prefixed text (corresponding to output field "tm").
262              
263             (default: 0)
264              
265             B =E CSV string
266              
267             Given a comma-separated list of key names, change the ordering of the named output fields.
268              
269             Currently supported output fields are:
270              
271             =over 4
272              
273             B - Human-readable timestamp string (mnemonic, "localtime")
274              
275             B - Epoch timestamp
276              
277             B - Hostname
278              
279             B - Literal string provided via passing C parameter to C
280              
281             B - Value returned by evaluating perl provided via C or C parameters passed to C
282              
283             B - Original input string, potentially modified via C or C side-effects. Key may be renamed via C
284              
285             =back
286              
287             (default: "lt, tm, hn, st, pl, d")
288              
289             B =E string containing perl code
290              
291             The provided string will be C'd for every line of input, and its return value included in the output prefix. The input string is available to this code in the variable "$s".
292              
293             (default: none)
294              
295             B =E filename
296              
297             Just like B except the perl code is read from the given file.
298              
299             (default: none)
300              
301             B =E filename
302              
303             When provided, input is appended to the file of the given name before C evaluation or any other reformatting.
304              
305             (default: none)
306              
307             B =E 0, 1
308              
309             Set to 1 to shorten the human-readable timestamp field somewhat.
310              
311             (default: 0)
312              
313             B =E 0, 1
314              
315             Set to 1 to shorten the human-readable timestamp to only the hour and minute (HH:MM).
316              
317             (default: 0)
318              
319             B =E 0, 10, 35
320              
321             When provided, timestamps will reflect TAI-0, TAI-10, or TAI-35 time instead of system time. If option's value is anything other than 0 or 10 or 35, TAI-10 will be assumed. See also: L. TAI time is a high-resolution time, so a fractional second will be included in prefix timestamps.
322              
323             (default: none)
324              
325             B =E filename
326              
327             Just like C, but the output string will be appended to the named file.
328              
329             (default: none)
330              
331             B =E string
332              
333             When provided, the output will include the literal string in its prefix.
334              
335             (default: none)
336              
337             =back
338              
339             =back
340              
341             =item B (string)
342              
343             =over 4
344              
345             Returns the given string after applying the formatting and prefixing rules passed to C.
346              
347             =back
348              
349             =back
350              
351             =head1 TODO
352              
353             Since this module was implemented specifically to support the functionality of the C tool, it lacks some obvious features which a programmer using the module directly might expect:
354              
355             =over 4
356              
357             C should probably take a C option, to supplement C and C.
358              
359             C should support a format option which causes C to return a hashref or arrayref instead of a string.
360              
361             =back
362              
363             =head1 HISTORY
364              
365             =over 4
366              
367             C started life in 2001 as an extremely simple throwaway script. Like many "throwaway" scripts, this one grew haphazardly with little
368             regard to best practices. The author has used it almost every day since then, and was intensely embarrassed by the state of its source code, but
369             it took him until 2017 to get around to refactoring it into C.
370              
371             =back
372              
373             =head1 AUTHORS
374              
375             =over 4
376              
377             TTKCIAR
378              
379             =back
380              
381             =head1 COPYRIGHT AND LICENSE
382              
383             =over 4
384              
385             Copyright (C) 2017 Bill "TTK" Moyer. All rights reserved.
386              
387             This library is free software. You may use it, redistribute it and/or modify it under the same terms as Perl itself.
388              
389             =back