File: RunsCommand.pm

package info (click to toggle)
libcode-tidyall-perl 0.78~ds-1
  • links: PTS, VCS
  • area: main
  • in suites: bullseye
  • size: 1,048 kB
  • sloc: perl: 5,061; lisp: 47; sh: 4; makefile: 2
file content (166 lines) | stat: -rw-r--r-- 3,816 bytes parent folder | download
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
package Code::TidyAll::Role::RunsCommand;

use strict;
use warnings;

use IPC::Run3 qw(run3);
use List::SomeUtils qw(any);
use Specio::Library::Builtins;
use Specio::Library::Numeric;
use Text::ParseWords qw(shellwords);
use Try::Tiny;

use Moo::Role;

our $VERSION = '0.78';

has ok_exit_codes => (
    is      => 'ro',
    isa     => t( 'ArrayRef', of => t('PositiveOrZeroInt') ),
    default => sub { [0] },
);

# We will end up getting $self->argv from the Plugin base class.

sub _run_or_die {
    my $self = shift;
    my @argv = @_;

    my $output;
    my @cmd = ( shellwords( $self->cmd ), shellwords( $self->argv ), @argv );
    try {
        local $?;
        run3( \@cmd, \undef, \$output, \$output );
        my $code = $? >> 8;
        if ( $self->_is_bad_exit_code($code) ) {
            my $signal = $? & 127;
            my $msg    = "exited with $code";
            $msg .= " - received signal $signal" if $signal;
            $msg .= " - output was:\n$output"    if defined $output and length $output;
            die "$msg\n";
        }
    }
    catch {
        die sprintf(
            "%s failed\n    %s",
            ( join q{ }, @cmd ),
            $_,
        );
    };

    return $output;
}

sub _is_bad_exit_code {
    my $self = shift;
    my $code = shift;

    return !( any { $code == $_ } @{ $self->ok_exit_codes } );
}

1;

# ABSTRACT: A role for plugins which run external commands

__END__

=pod

=encoding UTF-8

=head1 NAME

Code::TidyAll::Role::RunsCommand - A role for plugins which run external
commands

=head1 VERSION

version 0.78

=head1 SYNOPSIS

    package Whatever;
    use Moo;
    with 'Code::TidyAll::Role::RunsCommand';

=head1 DESCRIPTION

This is a a role for plugins which run external commands

=head1 ATTRIBUTES

=over

=item cmd

The command to run. This is just the executable and should not include
additional arguments.

=back

=head1 METHODS

=head2 _run_or_die(@argv)

This method run the plugin's command, combining any values provided to the
plugin's C<argv> attribute with those passed to the method.

The plugin's C<argv> attribute is parsed with the C<shellwords> subroutine from
L<Text::ParseWords> in order to turn the C<argv> string into a list. This
ensures that running the command does not spawn an external shell.

The C<@argv> passed to the command comes after the values from C<argv>
attribute. The assumption is that this will be what passes a file or source
string to the external command.

If the command exits with a non-zero status, then this method throws an
exception. The error message it throws include the command that was run (with
arguments), the exit status, any signal received by the command, and the
command's output.

Both C<stdout> and C<stderr> from the command are combined into a single string
returned by the method.

=head2 _is_bad_exit_code($code)

This method returns true if the exit code is bad and false otherwise. By
default all non-zero codes are bad, but some programs may be expected to exit
non-0 when they encounter validation/tidying issues.

=head1 SUPPORT

Bugs may be submitted at
L<https://github.com/houseabsolute/perl-code-tidyall/issues>.

I am also usually active on IRC as 'autarch' on C<irc://irc.perl.org>.

=head1 SOURCE

The source code repository for Code-TidyAll can be found at
L<https://github.com/houseabsolute/perl-code-tidyall>.

=head1 AUTHORS

=over 4

=item *

Jonathan Swartz <swartz@pobox.com>

=item *

Dave Rolsky <autarch@urth.org>

=back

=head1 COPYRIGHT AND LICENSE

This software is copyright (c) 2011 - 2020 by Jonathan Swartz.

This is free software; you can redistribute it and/or modify it under the same
terms as the Perl 5 programming language system itself.

The full text of the license can be found in the F<LICENSE> file included with
this distribution.

=cut