File Coverage

blib/lib/Code/TidyAll/Role/RunsCommand.pm
Criterion Covered Total %
statement 48 48 100.0
branch 4 6 66.6
condition 1 3 33.3
subroutine 14 14 100.0
pod n/a
total 67 71 94.3


line stmt bran cond sub pod time code
1              
2             use strict;
3 4     4   1863 use warnings;
  4         10  
  4         105  
4 4     4   19  
  4         9  
  4         100  
5             use IPC::Run3 qw(run3);
6 4     4   19 use List::SomeUtils qw(any);
  4         10  
  4         194  
7 4     4   23 use Specio::Library::Builtins;
  4         7  
  4         171  
8 4     4   24 use Specio::Library::Numeric;
  4         16  
  4         33  
9 4     4   32109 use Text::ParseWords qw(shellwords);
  4         11  
  4         30  
10 4     4   29015 use Try::Tiny;
  4         2697  
  4         299  
11 4     4   31  
  4         10  
  4         213  
12             use Moo::Role;
13 4     4   24  
  4         7  
  4         35  
14             our $VERSION = '0.81';
15              
16             has ok_exit_codes => (
17             is => 'ro',
18             isa => t( 'ArrayRef', of => t('PositiveOrZeroInt') ),
19             default => sub { [0] },
20             );
21              
22             # We will end up getting $self->argv from the Plugin base class.
23              
24             my $self = shift;
25             my @argv = @_;
26 9     9   49  
27 9         49 my $output;
28             my @cmd = ( shellwords( $self->cmd ), shellwords( $self->argv ), @argv );
29 9         26 try {
30 9         90 local $?;
31             run3( \@cmd, \undef, \$output, \$output );
32 9     9   500 my $code = $? >> 8;
33 9         47 if ( $self->_is_bad_exit_code($code) ) {
34 9         262887 my $signal = $? & 127;
35 9 100       175 my $msg = "exited with $code";
36 3         71 $msg .= " - received signal $signal" if $signal;
37 3         43 $msg .= " - output was:\n$output" if defined $output and length $output;
38 3 50       47 die "$msg\n";
39 3 50 33     82 }
40 3         106 }
41             catch {
42             die sprintf(
43             "Running [%s] failed\n %s",
44 3     3   162 ( join q{ }, @cmd ),
45             $_,
46             );
47             };
48              
49 9         1795 return $output;
50             }
51 6         671  
52             my $self = shift;
53             my $code = shift;
54              
55 9     9   82 return !( any { $code == $_ } @{ $self->ok_exit_codes } );
56 9         44 }
57              
58 9     15   141 1;
  15         258  
  9         188  
59              
60             # ABSTRACT: A role for plugins which run external commands
61              
62              
63             =pod
64              
65             =encoding UTF-8
66              
67             =head1 NAME
68              
69             Code::TidyAll::Role::RunsCommand - A role for plugins which run external commands
70              
71             =head1 VERSION
72              
73             version 0.81
74              
75             =head1 SYNOPSIS
76              
77             package Whatever;
78             use Moo;
79             with 'Code::TidyAll::Role::RunsCommand';
80              
81             =head1 DESCRIPTION
82              
83             This is a a role for plugins which run external commands
84              
85             =head1 ATTRIBUTES
86              
87             =over
88              
89             =item cmd
90              
91             The command to run. This is just the executable and should not include
92             additional arguments.
93              
94             =back
95              
96             =head1 METHODS
97              
98             =head2 _run_or_die(@argv)
99              
100             This method run the plugin's command, combining any values provided to the
101             plugin's C<argv> attribute with those passed to the method.
102              
103             The plugin's C<argv> attribute is parsed with the C<shellwords> subroutine from
104             L<Text::ParseWords> in order to turn the C<argv> string into a list. This
105             ensures that running the command does not spawn an external shell.
106              
107             The C<@argv> passed to the command comes after the values from C<argv>
108             attribute. The assumption is that this will be what passes a file or source
109             string to the external command.
110              
111             If the command exits with a non-zero status, then this method throws an
112             exception. The error message it throws include the command that was run (with
113             arguments), the exit status, any signal received by the command, and the
114             command's output.
115              
116             Both C<stdout> and C<stderr> from the command are combined into a single string
117             returned by the method.
118              
119             =head2 _is_bad_exit_code($code)
120              
121             This method returns true if the exit code is bad and false otherwise. By
122             default all non-zero codes are bad, but some programs may be expected to exit
123             non-0 when they encounter validation/tidying issues.
124              
125             =head1 SUPPORT
126              
127             Bugs may be submitted at L<https://github.com/houseabsolute/perl-code-tidyall/issues>.
128              
129             =head1 SOURCE
130              
131             The source code repository for Code-TidyAll can be found at L<https://github.com/houseabsolute/perl-code-tidyall>.
132              
133             =head1 AUTHORS
134              
135             =over 4
136              
137             =item *
138              
139             Jonathan Swartz <swartz@pobox.com>
140              
141             =item *
142              
143             Dave Rolsky <autarch@urth.org>
144              
145             =back
146              
147             =head1 COPYRIGHT AND LICENSE
148              
149             This software is copyright (c) 2011 - 2022 by Jonathan Swartz.
150              
151             This is free software; you can redistribute it and/or modify it under
152             the same terms as the Perl 5 programming language system itself.
153              
154             The full text of the license can be found in the
155             F<LICENSE> file included with this distribution.
156              
157             =cut