File Coverage

blib/lib/Tail/Tool/Plugin/Spacing.pm
Criterion Covered Total %
statement 30 34 88.2
branch 4 4 100.0
condition n/a
subroutine 8 9 88.8
pod 2 2 100.0
total 44 49 89.8


line stmt bran cond sub pod time code
1             package Tail::Tool::Plugin::Spacing;
2              
3             # Created on: 2010-10-06 14:17:00
4             # Create by: Ivan Wills
5             # $Id$
6             # $Revision$, $HeadURL$, $Date$
7             # $Revision$, $Source$, $Date$
8              
9 3     3   2266 use Moose;
  3         460903  
  3         24  
10 3     3   18938 use warnings;
  3         8  
  3         119  
11 3     3   637 use version;
  3         1990  
  3         51  
12 3     3   257 use Carp;
  3         5  
  3         206  
13 3     3   1777 use List::MoreUtils qw/pairwise/;
  3         33819  
  3         19  
14 3     3   3765 use English qw/ -no_match_vars /;
  3         1741  
  3         24  
15              
16             extends 'Tail::Tool::PreProcess';
17              
18             our $VERSION = version->new('0.4.8');
19              
20             has last_time => (
21             is => 'rw',
22             isa => 'Int',
23             init_arg => undef,
24             );
25             has times => (
26             is => 'rw',
27             isa => 'ArrayRef[Int]',
28             default => sub {[]},
29             );
30             has lines => (
31             is => 'rw',
32             isa => 'ArrayRef[Int]',
33             default => sub {[]},
34             );
35             has '+many' => (
36             default => 0,
37             );
38              
39             around BUILDARGS => sub {
40             my ($orig, $class, @params) = @_;
41             my %param;
42              
43             if ( ref $params[0] eq 'HASH' ) {
44             %param = %{ shift @params };
45             }
46             else {
47             %param = @params;
48             }
49              
50             for my $param ( keys %param) {
51             my $value = $param{$param};
52             if ( !ref $value ) {
53             $value = [ split /,/xms, $value ];
54             }
55             $param{$param} = $value;
56             }
57              
58             return $class->$orig(%param);
59             };
60              
61             sub process {
62 3     3 1 2464 my ( $self, $line ) = @_;
63 3         7 my @lines = ($line);
64              
65 3         93 my $last = $self->last_time;
66 3         84 $self->last_time(time);
67 3 100       11 return @lines if !$last;
68              
69 2         5 my $diff = time - $last;
70              
71 2     4   8 for my $time ( pairwise {[$a, $b]} @{ $self->times }, @{ $self->lines } ) {
  4         11  
  2         58  
  2         53  
72 4 100       19 unshift @lines, ("\n") x $time->[1] if $diff >= $time->[0];
73             }
74              
75 2         17 return @lines;
76             }
77              
78             sub summarise {
79 0     0 1   my ($self) = @_;
80              
81 0           return "times = " . ( join ', ', @{ $self->times } ) . ", lines = " . ( join ', ', @{ $self->lines } );
  0            
  0            
82             }
83              
84             1;
85              
86             __END__
87              
88             =head1 NAME
89              
90             Tail::Tool::Plugin::Spacing - Prints spaces when there has been a pause in running.
91              
92             =head1 VERSION
93              
94             This documentation refers to Tail::Tool::Plugin::Spacing version 0.4.8.
95              
96             =head1 SYNOPSIS
97              
98             use Tail::Tool::Plugin::Spacing;
99              
100             # Brief but working code example(s) here showing the most common usage(s)
101             # This section will be as far as many users bother reading, so make it as
102             # educational and exemplary as possible.
103              
104             my $sp = Tail::Tool::Plugin::Spacing(
105             times => [ 2, 5 ],
106             lines => [ 2, 5 ],
107             );
108              
109             $sp->process("test\n");
110             # returns ("test\n");
111              
112             ...
113              
114             # 2 seconds later
115             $sp->process("test\n");
116             # returns ( "\n", "\n", "test\n" );
117              
118             ...
119              
120             # another 5 seconds later
121             $sp->process("test\n");
122             # returns ( "\n", "\n", "\n", "\n", "\n", "\n", "\n", "test\n" );
123             # ie 7 blank lines ( 2 lines + 5 lines )
124              
125             =head1 DESCRIPTION
126              
127             =head1 SUBROUTINES/METHODS
128              
129             =head2 C<new (%params)>
130              
131             Param: C<times> - [int] - The minimum time (in seconds) for a pause to be
132             considered to have occurred, resulting in the corresponding number of lines
133             (in the C<lines> argument) prepended to the found line.
134              
135             Param: C<lines> - [int] - The number of lines to print when the corresponding
136             period in C<times> is reached.
137              
138             Description: create a new object
139              
140             =head2 C<process ()>
141              
142             Description: Prints spaces based on time between last call and this one and
143             the settings.
144              
145             =head2 C<summarise ()>
146              
147             Returns a string that summarise the current settings of the plugin instance
148              
149             =head1 DIAGNOSTICS
150              
151             =head1 CONFIGURATION AND ENVIRONMENT
152              
153             =head1 DEPENDENCIES
154              
155             =head1 INCOMPATIBILITIES
156              
157             =head1 BUGS AND LIMITATIONS
158              
159             There are no known bugs in this module.
160              
161             Please report problems to Ivan Wills (ivan.wills@gamil.com).
162              
163             Patches are welcome.
164              
165             =head1 AUTHOR
166              
167             Ivan Wills - (ivan.wills@gamil.com)
168             <Author name(s)> (<contact address>)
169              
170             =head1 LICENSE AND COPYRIGHT
171              
172             Copyright (c) 2010 Ivan Wills (14 Mullion Close, Hornsby Heights, NSW, Australia, 2077).
173             All rights reserved.
174              
175             This module is free software; you can redistribute it and/or modify it under
176             the same terms as Perl itself. See L<perlartistic>. This program is
177             distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY;
178             without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
179             PARTICULAR PURPOSE.
180              
181             =cut