/usr/share/perl5/Dist/Zilla/Plugin/Run/Role/Runner.pm is in libdist-zilla-plugin-run-perl 0.013-1.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
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 | use strict;
use warnings;
package Dist::Zilla::Plugin::Run::Role::Runner;
BEGIN {
$Dist::Zilla::Plugin::Run::Role::Runner::AUTHORITY = 'cpan:GETTY';
}
{
$Dist::Zilla::Plugin::Run::Role::Runner::VERSION = '0.013';
}
# ABSTRACT: Role for the packages of Dist::Zilla::Plugin::Run
use Moose::Role;
use String::Formatter 0.102082 ();
use namespace::autoclean;
use File::Spec (); # core
use IPC::Open3 (); # core
use Config (); # core
has perlpath => (
is => 'ro',
isa => 'Str',
builder => 'current_perl_path',
);
has run => (
is => 'ro',
isa => 'ArrayRef',
default => sub { [] },
);
around BUILDARGS => sub {
my ( $orig, $class, @args ) = @_;
my $built = $class->$orig(@args);
foreach my $dep (qw( notexist_fatal )) {
if ( exists $built->{$dep} ) {
warn(" !\n ! $class attribute '$dep' is deprecated and has no effect.\n !\n");
delete $built->{$dep};
}
}
return $built;
};
sub call_script {
my ( $self, $params ) = @_;
foreach my $run_cmd (@{$self->run}) {
if ($run_cmd) {
my $command = $self->build_formatter($params)->format($run_cmd);
$self->log("Executing: $command");
# autoflush STDOUT so we can see command output right away
local $| = 1;
# combine stdout and stderr for ease of proxying through the logger
my $pid = IPC::Open3::open3(my ($in, $out), undef, $command);
while(defined(my $line = <$out>)){
chomp($line); # logger appends its own newline
$self->log($line);
}
# zombie repellent
waitpid($pid, 0);
my $status = ($? >> 8);
$self->log_fatal("Command exited with status $status ($?)") if $status;
$self->log("Command executed successfully");
}
}
}
around mvp_multivalue_args => sub {
my ($original, $self) = @_;
my @res = $self->$original();
push @res, qw( run );
@res;
};
my $path_separator = (File::Spec->catfile(qw(a b)) =~ m/^a(.+?)b$/)[0];
sub build_formatter {
my ( $self, $params ) = @_;
# stringify build directory
my $dir = $params->{dir} || $self->zilla->built_in;
$dir = $dir ? "$dir" : '';
return String::Formatter->new({
codes => {
# not always available
# explicitly pass a string (not an object) [rt-72008]
a => defined $params->{archive} ? "$params->{archive}" : '',
d => $dir,
n => $self->zilla->name,
p => $path_separator,
v => $self->zilla->version,
# positional replace (backward compatible)
s => sub { shift(@{ $params->{pos} }) || '' },
x => $self->perlpath,
},
});
}
sub current_perl_path {
# see perlvar $^X
my $perl = $Config::Config{perlpath};
if ($^O ne 'VMS') {
$perl .= $Config::Config{_exe}
unless $perl =~ m/$Config::Config{_exe}$/i;
}
return $perl;
}
1;
# vim: set ts=4 sts=4 sw=4 expandtab smarttab:
__END__
=pod
=head1 NAME
Dist::Zilla::Plugin::Run::Role::Runner - Role for the packages of Dist::Zilla::Plugin::Run
=head1 VERSION
version 0.013
=head1 DESCRIPTION
This is the base role for all the plugins L<Dist::Zilla::Plugin::Run> delivers. You don't need this.
=head1 AUTHOR
Torsten Raudssus <torsten@raudssus.de> L<http://www.raudssus.de/>
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2010 by L<Raudssus Social Software|http://www.raudssus.de/>.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut
|