File Coverage

blib/lib/Footprintless/Log.pm
Criterion Covered Total %
statement 77 98 78.5
branch 23 48 47.9
condition 1 3 33.3
subroutine 19 21 90.4
pod 5 5 100.0
total 125 175 71.4


line stmt bran cond sub pod time code
1 3     3   96812 use strict;
  3         5  
  3         75  
2 3     3   12 use warnings;
  3         3  
  3         122  
3              
4             package Footprintless::Log;
5             $Footprintless::Log::VERSION = '1.26';
6             # ABSTRACT: A log manager
7             # PODNAME: Footprintless::Log
8              
9 3     3   13 use parent qw(Footprintless::MixableBase);
  3         5  
  3         16  
10              
11 3     3   103 use Carp;
  3         5  
  3         141  
12 3         160 use Footprintless::Command qw(
13             command
14             tail_command
15 3     3   912 );
  3         7  
16 3     3   691 use Footprintless::CommandOptionsFactory;
  3         6  
  3         65  
17 3     3   15 use Footprintless::Localhost;
  3         4  
  3         78  
18 3         146 use Footprintless::Mixins qw(
19             _entity
20 3     3   723 );
  3         7  
21 3         95 use Footprintless::Util qw(
22             dumper
23             invalid_entity
24 3     3   18 );
  3         4  
25 3     3   13 use Log::Any;
  3         3  
  3         11  
26              
27             my $logger = Log::Any->get_logger();
28              
29             sub _action_args {
30 28     28   57 my ($args) = @_;
31 28 100       70 return '' unless ($args);
32              
33 15         29 my $ref = ref($args);
34 15 50       31 return "$args " unless ($ref);
35              
36 15 50       30 croak("unsupported ref type [$ref] for action options")
37             unless ( $ref eq 'ARRAY' );
38              
39 15 50       55 return scalar(@$args)
40             ? join( ' ', @$args, '' )
41             : '';
42             }
43              
44             sub cat {
45 15     15 1 56 my ( $self, %options ) = @_;
46              
47 15         39 my $action_args = _action_args( $options{args} );
48              
49             return $self->{command_runner}
50             ->run_or_die( command( "cat $action_args$self->{log_file}", $self->{command_options} ),
51 15         62 $self->_runner_options( $options{runner_options} ) );
52             }
53              
54             sub follow {
55 1     1 1 5 my ( $self, %options ) = @_;
56              
57 1         2 eval {
58             $self->{command_runner}->run_or_die(
59             tail_command( $self->{log_file}, follow => 1, $self->{command_options} ),
60             $self->_runner_options( $options{runner_options}, $options{until} )
61 1         8 );
62             };
63 1 50       34 if ($@) {
64 1         24 my $exception = $self->{command_runner}->get_exception();
65 1 50 33     27 croak($@) unless ( $exception && $exception =~ /^until found .*$/ );
66             }
67             }
68              
69             sub grep {
70 5     5 1 15 my ( $self, %options ) = @_;
71              
72 5         12 my $action_args = _action_args( $options{args} );
73              
74             return $self->{command_runner}
75             ->run_or_die( command( "grep $action_args$self->{log_file}", $self->{command_options} ),
76 5         22 $self->_runner_options( $options{runner_options} ) );
77             }
78              
79             sub head {
80 4     4 1 12 my ( $self, %options ) = @_;
81              
82 4         16 my $action_args = _action_args( $options{args} );
83              
84             return $self->{command_runner}
85             ->run_or_die( command( "head $action_args$self->{log_file}", $self->{command_options} ),
86 4         24 $self->_runner_options( $options{runner_options} ) );
87             }
88              
89             sub _init {
90 9     9   18 my ( $self, %options ) = @_;
91              
92 9         41 $self->{spec} = $self->_entity( $self->{coordinate}, 1 );
93              
94             # Allow string, hashref with file key, or object
95 9         17 my $ref = ref( $self->{spec} );
96 9 50       25 if ($ref) {
97 0 0       0 if ( $ref eq 'HASH' ) {
    0          
98 0 0       0 if ( $self->{spec}{file} ) {
99 0         0 $self->{log_file} = $self->{spec}{file};
100             }
101             else {
102 0         0 invalid_entity( $self->{coordinate}, "must be file, or hashref with 'file' key" );
103             }
104             }
105             elsif ( $ref eq 'SCALAR' ) {
106 0         0 $self->{log_file} = $self->{spec};
107             }
108             else {
109 0         0 invalid_entity( $self->{coordinate}, "must be file, or hashref with 'file' key" );
110             }
111             }
112             else {
113 9         22 $self->{log_file} = $self->{spec};
114             }
115              
116 9         25 $self->{command_runner} = $self->{factory}->command_runner();
117             $self->{command_options} = $self->{factory}->command_options(
118 9         34 %{ $self->{factory}->entities()->fill(
119             $self->{coordinate},
120 9         20 { hostname => undef,
121             ssh => undef,
122             ssh_username => undef,
123             sudo_command => undef,
124             sudo_username => undef
125             },
126             ancestry => 1
127             )
128             }
129             );
130              
131 9         69 return $self;
132             }
133              
134             sub _runner_options {
135 29     29   83 my ( $self, $runner_options, $until ) = @_;
136              
137 29 100       70 $runner_options = {} unless ($runner_options);
138              
139 29         41 my $options = {};
140 29 100       70 if ($until) {
141 1 50       6 if ( $runner_options->{out_buffer} ) {
    50          
142             $options->{out_callback} = sub {
143 0     0   0 my ($line) = @_;
144 0         0 ${ $runner_options->{out_buffer} } .= "$line\n";
  0         0  
145 0 0       0 die('until found') if ( $line =~ $until );
146 0         0 };
147             }
148             elsif ( $runner_options->{out_callback} ) {
149             $options->{out_callback} = sub {
150 4     4   11 my ($line) = @_;
151 4         8 &{ $runner_options->{out_callback} }($line);
  4         20  
152 4 100       58 die('until found') if ( $line =~ $until );
153 1         15 };
154             }
155             else {
156 0         0 my $handle = $runner_options->{out_handle};
157             $options->{out_callback} = sub {
158 0     0   0 my ($line) = @_;
159 0 0       0 print( $handle "$line\n" ) if ($handle);
160 0 0       0 die('until found') if ( $line =~ $until );
161 0         0 };
162             }
163             }
164             else {
165 28 50       77 if ( exists( $runner_options->{out_buffer} ) ) {
    50          
    100          
166 0         0 $options->{out_buffer} = $runner_options->{out_buffer};
167             }
168             elsif ( exists( $runner_options->{out_callback} ) ) {
169 0         0 $options->{out_callback} = $runner_options->{out_callback};
170             }
171             elsif ( exists( $runner_options->{out_handle} ) ) {
172 4         8 $options->{out_handle} = $runner_options->{out_handle};
173             }
174             }
175              
176 29 50       76 if ( exists( $runner_options->{err_buffer} ) ) {
    50          
    50          
177 0         0 $options->{err_buffer} = $runner_options->{err_buffer};
178             }
179             elsif ( exists( $runner_options->{err_callback} ) ) {
180 0         0 $options->{err_callback} = $runner_options->{err_callback};
181             }
182             elsif ( exists( $runner_options->{err_handle} ) ) {
183 0         0 $options->{err_handle} = $runner_options->{err_handle};
184             }
185              
186 29         136 return $options;
187             }
188              
189             sub tail {
190 4     4 1 10 my ( $self, %options ) = @_;
191              
192 4         14 my $action_args = _action_args( $options{args} );
193              
194             return $self->{command_runner}
195             ->run_or_die( command( "tail $action_args$self->{log_file}", $self->{command_options} ),
196 4         18 $self->_runner_options( $options{runner_options} ) );
197             }
198              
199             1;
200              
201             __END__