view release on metacpan or search on metacpan
t/00-compile.t view on Meta::CPAN
my @warnings;
for my $lib (@module_files)
{
# see L<perlfaq8/How can I capture STDERR from an external command?>
my $stderr = IO::Handle->new;
diag('Running: ', join(', ', map { my $str = $_; $str =~ s/'/\\'/g; q{'} . $str . q{'} }
$^X, @switches, '-e', "require q[$lib]"))
if $ENV{PERL_COMPILE_TEST_DEBUG};
my $pid = open3($stdin, '>&STDERR', $stderr, $^X, @switches, '-e', "require q[$lib]");
binmode $stderr, ':crlf' if $^O eq 'MSWin32';
my @_warnings = <$stderr>;
waitpid($pid, 0);
is($?, 0, "$lib loaded ok");
shift @_warnings if @_warnings and $_warnings[0] =~ /^Using .*\bblib/
and not eval { +require blib; blib->VERSION('1.01') };
t/00-compile.t view on Meta::CPAN
@switches = (@switches, split(' ', $1)) if $1;
close $fh and skip("$file uses -T; not testable with PERL5LIB", 1)
if grep { $_ eq '-T' } @switches and $ENV{PERL5LIB};
my $stderr = IO::Handle->new;
diag('Running: ', join(', ', map { my $str = $_; $str =~ s/'/\\'/g; q{'} . $str . q{'} }
$^X, @switches, '-c', $file))
if $ENV{PERL_COMPILE_TEST_DEBUG};
my $pid = open3($stdin, '>&STDERR', $stderr, $^X, @switches, '-c', $file);
binmode $stderr, ':crlf' if $^O eq 'MSWin32';
my @_warnings = <$stderr>;
waitpid($pid, 0);
is($?, 0, "$file compiled ok");
shift @_warnings if @_warnings and $_warnings[0] =~ /^Using .*\bblib/
and not eval { +require blib; blib->VERSION('1.01') };
view all matches for this distribution
view release on metacpan or search on metacpan
#
# instance variables
#
field $stdout : param : reader;
field $stderr : param : reader;
field $exit_code : param : reader;
field $error_message : param : reader;
#
# class methods
my $code = eval { App::Gimei::Runner->new->execute(@args) };
$param{exit_code} = $code;
$param{error_message} = $@;
};
return $class->new( %param, stdout => $capture[0], stderr => $capture[1] );
}
}
1;
view all matches for this distribution
view release on metacpan or search on metacpan
upstream/tracking branch. Thanks to Walter Smuts and Johannes Altmanninger
for their help in figuring out the details.
- Support quoted filenames in diff output. git-autofixup now works with
filenames containing non-ASCII characters.
- Improve error messages and handling. For git commands that are expected to
fail, their stderr is captured, annotated with the command, and printed, to
clarify the cause of errors.
- Deprecate --gitopt|-g in favor of using the GIT_CONFIG_{COUNT,KEY,VALUE}
environment variables.
# 0.003002
view all matches for this distribution
view release on metacpan or search on metacpan
t/00-compile.t view on Meta::CPAN
my @warnings;
for my $lib (@module_files)
{
# see L<perlfaq8/How can I capture STDERR from an external command?>
my $stderr = IO::Handle->new;
diag('Running: ', join(', ', map { my $str = $_; $str =~ s/'/\\'/g; q{'} . $str . q{'} }
$^X, @switches, '-e', "require q[$lib]"))
if $ENV{PERL_COMPILE_TEST_DEBUG};
my $pid = open3($stdin, '>&STDERR', $stderr, $^X, @switches, '-e', "require q[$lib]");
binmode $stderr, ':crlf' if $^O eq 'MSWin32';
my @_warnings = <$stderr>;
waitpid($pid, 0);
is($?, 0, "$lib loaded ok");
shift @_warnings if @_warnings and $_warnings[0] =~ /^Using .*\bblib/
and not eval { +require blib; blib->VERSION('1.01') };
t/00-compile.t view on Meta::CPAN
@switches = (@switches, split(' ', $1)) if $1;
close $fh and skip("$file uses -T; not testable with PERL5LIB", 1)
if grep { $_ eq '-T' } @switches and $ENV{PERL5LIB};
my $stderr = IO::Handle->new;
diag('Running: ', join(', ', map { my $str = $_; $str =~ s/'/\\'/g; q{'} . $str . q{'} }
$^X, @switches, '-c', $file))
if $ENV{PERL_COMPILE_TEST_DEBUG};
my $pid = open3($stdin, '>&STDERR', $stderr, $^X, @switches, '-c', $file);
binmode $stderr, ':crlf' if $^O eq 'MSWin32';
my @_warnings = <$stderr>;
waitpid($pid, 0);
is($?, 0, "$file compiled ok");
shift @_warnings if @_warnings and $_warnings[0] =~ /^Using .*\bblib/
and not eval { +require blib; blib->VERSION('1.01') };
view all matches for this distribution
view release on metacpan or search on metacpan
- updated ChangeLog
- fixed finding module listed on cli between recent and real repositories
- fixed tests - checking is repository cloned and where it is clone
- skip testing for Windows OS / not supported / linux only
- add comments in scripts for few tests
- fixed stderr leak when reading from nonexisting config file
0.1.12 2022-07-05 12:25
- added "provides" as required by Kwalitee
- updated ChangeLog
view all matches for this distribution
view release on metacpan or search on metacpan
lib/App/Git/Workflow/Command/BranchConflicts.pm view on Meta::CPAN
use Pod::Usage ();
use Data::Dumper qw/Dumper/;
use English qw/ -no_match_vars /;
use App::Git::Workflow;
use App::Git::Workflow::Command qw/get_options/;
use Capture::Tiny qw/capture_stderr/;
our $VERSION = 0.6;
our $workflow = App::Git::Workflow->new;
our ($name) = $PROGRAM_NAME =~ m{^.*/(.*?)$}mxs;
our %option;
lib/App/Git/Workflow/Command/BranchConflicts.pm view on Meta::CPAN
}
$workflow->git->reset('HEAD');
$workflow->git->clean('-xfd');
$workflow->git->checkout('.');
capture_stderr {
$workflow->git->checkout('-');
};
}
if (%conflicts) {
lib/App/Git/Workflow/Command/BranchConflicts.pm view on Meta::CPAN
my @checkouts;
sub checkout_branch {
my ($self, $branch) = @_;
my $local = 'branch-conflicts-' . sprintf '%03i', scalar @checkouts;
capture_stderr {
$workflow->git->checkout('-b', $local, '--no-track', $branch);
};
push @checkouts, $local;
lib/App/Git/Workflow/Command/BranchConflicts.pm view on Meta::CPAN
}
sub merge_branch_conflicts {
my ($self, $branch) = @_;
capture_stderr {
eval { $workflow->git->merge('--no-commit', $branch) };
};
my $status = $workflow->git->status;
eval { $workflow->git->merge('--abort'); };
view all matches for this distribution
view release on metacpan or search on metacpan
lib/Test/Git/Workflow/Command.pm view on Meta::CPAN
$data->{STD}{IN} ||= '';
open $stdin, '<', \$data->{STD}{IN};
# run the code
my $error;
my ($stdout, $stderr) = capture { local *STDIN = $stdin; eval { $module->run() }; $error = $@; };
## Tests
if ($error) {
#die $error, $stderr if !$data->{error};
is $error, $data->{error}, "Error matches"
or ( ref $error && diag explain $error, $data->{error} );
}
# STDOUT
lib/Test/Git/Workflow/Command.pm view on Meta::CPAN
or diag explain $actual, $data->{STD}{OUT};
}
# STDERR
if ( !ref $data->{STD}{ERR} ) {
is $stderr, $data->{STD}{ERR}, "STDERR $data->{name} run"
or diag explain $stderr, $data->{STD}{ERR};
}
elsif ( ref $data->{STD}{ERR} eq 'Regexp' ) {
like $stderr, $data->{STD}{ERR}, "STDERR $data->{name} run"
or diag explain $stderr, $data->{STD}{ERR};
}
elsif ( ref $data->{STD}{ERR} eq 'HASH' ) {
my $actual = $data->{STD}{ERR_PRE} ? $data->{STD}{ERR_PRE}->($stdout) : $stdout;
is_deeply $actual, $data->{STD}{ERR}, "STDERR $data->{name} run"
or diag explain $actual, $data->{STD}{ERR};
view all matches for this distribution
view release on metacpan or search on metacpan
t/01-script.t view on Meta::CPAN
push @cmd, $script;
diag "Testing script/git-find with command line:\n", join ' ', @cmd;
# Run the tests
my ($stdout, $stderr, $exit) = capture {
return system(@cmd, '-h');
};
cmp_ok $exit>>8, '==', 0, 'exit code -h';
}
view all matches for this distribution
view release on metacpan or search on metacpan
t/00-compile.t view on Meta::CPAN
my @warnings;
for my $lib (@module_files)
{
# see L<perlfaq8/How can I capture STDERR from an external command?>
my $stderr = IO::Handle->new;
diag('Running: ', join(', ', map { my $str = $_; $str =~ s/'/\\'/g; q{'} . $str . q{'} }
$^X, @switches, '-e', "require q[$lib]"))
if $ENV{PERL_COMPILE_TEST_DEBUG};
my $pid = open3($stdin, '>&STDERR', $stderr, $^X, @switches, '-e', "require q[$lib]");
binmode $stderr, ':crlf' if $^O eq 'MSWin32';
my @_warnings = <$stderr>;
waitpid($pid, 0);
is($?, 0, "$lib loaded ok");
shift @_warnings if @_warnings and $_warnings[0] =~ /^Using .*\bblib/
and not eval { +require blib; blib->VERSION('1.01') };
t/00-compile.t view on Meta::CPAN
@switches = (@switches, split(' ', $1)) if $1;
close $fh and skip("$file uses -T; not testable with PERL5LIB", 1)
if grep { $_ eq '-T' } @switches and $ENV{PERL5LIB};
my $stderr = IO::Handle->new;
diag('Running: ', join(', ', map { my $str = $_; $str =~ s/'/\\'/g; q{'} . $str . q{'} }
$^X, @switches, '-c', $file))
if $ENV{PERL_COMPILE_TEST_DEBUG};
my $pid = open3($stdin, '>&STDERR', $stderr, $^X, @switches, '-c', $file);
binmode $stderr, ':crlf' if $^O eq 'MSWin32';
my @_warnings = <$stderr>;
waitpid($pid, 0);
is($?, 0, "$file compiled ok");
shift @_warnings if @_warnings and $_warnings[0] =~ /^Using .*\bblib/
and not eval { +require blib; blib->VERSION('1.01') };
view all matches for this distribution
view release on metacpan or search on metacpan
t/00-compile.t view on Meta::CPAN
my @warnings;
for my $lib (@module_files)
{
# see L<perlfaq8/How can I capture STDERR from an external command?>
my $stderr = IO::Handle->new;
diag('Running: ', join(', ', map { my $str = $_; $str =~ s/'/\\'/g; q{'} . $str . q{'} }
$^X, @switches, '-e', "require q[$lib]"))
if $ENV{PERL_COMPILE_TEST_DEBUG};
my $pid = open3($stdin, '>&STDERR', $stderr, $^X, @switches, '-e', "require q[$lib]");
binmode $stderr, ':crlf' if $^O eq 'MSWin32';
my @_warnings = <$stderr>;
waitpid($pid, 0);
is($?, 0, "$lib loaded ok");
shift @_warnings if @_warnings and $_warnings[0] =~ /^Using .*\bblib/
and not eval { +require blib; blib->VERSION('1.01') };
t/00-compile.t view on Meta::CPAN
@switches = (@switches, split(' ', $1)) if $1;
close $fh and skip("$file uses -T; not testable with PERL5LIB", 1)
if grep { $_ eq '-T' } @switches and $ENV{PERL5LIB};
my $stderr = IO::Handle->new;
diag('Running: ', join(', ', map { my $str = $_; $str =~ s/'/\\'/g; q{'} . $str . q{'} }
$^X, @switches, '-c', $file))
if $ENV{PERL_COMPILE_TEST_DEBUG};
my $pid = open3($stdin, '>&STDERR', $stderr, $^X, @switches, '-c', $file);
binmode $stderr, ':crlf' if $^O eq 'MSWin32';
my @_warnings = <$stderr>;
waitpid($pid, 0);
is($?, 0, "$file compiled ok");
shift @_warnings if @_warnings and $_warnings[0] =~ /^Using .*\bblib/
and not eval { +require blib; blib->VERSION('1.01') };
view all matches for this distribution
view release on metacpan or search on metacpan
files => $test->{'files'},
repository => $repository,
);
# Try to commit.
my $stderr;
lives_ok(
sub
{
$stderr = Capture::Tiny::capture_stderr(
sub
{
$repository->run( 'commit', '-m', 'Test message.' );
}
);
note( $stderr );
},
'Commit the changes.',
);
like(
$stderr,
$test->{'expected'},
"The output matches expected results.",
);
}
);
view all matches for this distribution
view release on metacpan or search on metacpan
files => $files,
repository => $repository,
);
# Try to commit.
my $stderr;
lives_ok(
sub
{
$stderr = Capture::Tiny::capture_stderr(
sub
{
$repository->run( 'commit', '-m', 'Test message.' );
}
);
note( $stderr );
},
'Commit the changes.',
);
if ( $test->{'allow'} )
{
unlike(
$stderr,
$failure,
"The output matches expected results.",
);
}
else
{
like(
$stderr,
$failure,
"The output matches expected results.",
);
}
}
view all matches for this distribution
view release on metacpan or search on metacpan
files => $files,
repository => $repository,
);
# Try to commit.
my $stderr;
my $exit_status;
lives_ok(
sub
{
$stderr = Capture::Tiny::capture_stderr(
sub
{
my @args = $test->{'no_verify'}
? ( '--no-verify' )
: '';
$repository->run( 'commit', '-m', 'Test message.', @args );
$exit_status = $? >> 8;
}
);
note( $stderr );
},
'Commit the changes.',
);
# Test messages printed by git hooks prior to the commit itself.
if ( $test->{'no_verify'} )
{
ok(
!defined( $stderr ) || ( $stderr !~ /\w/ ),
'No error message is printed prior to the commit.',
) || diag( "STDERR: >$stderr<." );
}
else
{
like(
$stderr,
qr/\Q$failure_message\E/,
'The commit failed with an error message.',
);
}
view all matches for this distribution
view release on metacpan or search on metacpan
files => $files,
repository => $repository,
);
# Try to commit.
my $stderr;
lives_ok(
sub
{
$stderr = Capture::Tiny::capture_stderr(
sub
{
$repository->run( 'commit', '-m', 'Test message.' );
}
);
note( $stderr );
},
'Commit the changes.',
);
like(
$stderr,
$test->{'expected'},
"The output matches expected results.",
);
}
);
view all matches for this distribution
view release on metacpan or search on metacpan
if !defined( $branch ) || ( $branch eq '' );
lives_ok(
sub
{
my $stderr = Capture::Tiny::capture_stderr(
sub
{
$repository->run( 'checkout', '-b', $branch );
}
);
note( $stderr );
},
'Switch branches.',
);
# Set up test files.
files => $test->{'files'},
repository => $repository,
);
# Try to commit.
my $stderr;
lives_ok(
sub
{
$stderr = Capture::Tiny::capture_stderr(
sub
{
$repository->run( 'commit', '-m', $test->{'commit_message'} );
}
);
note( $stderr );
},
'Commit the changes.',
);
like(
$stderr,
$test->{'expected'},
"The output matches expected results.",
);
}
);
view all matches for this distribution
view release on metacpan or search on metacpan
lib/App/GitHooks/Plugin/PerlCompile.pm view on Meta::CPAN
my $lib_paths = $config->get( 'PerlCompile', 'lib_paths' );
my @lib = map { ( '-I', $_ ) } split( /\s*,\s*/, $lib_paths // '' );
# Execute perl -cw.
my $path = File::Spec->catfile( $repository->work_tree(), $file );
my ( $pid, $stdin, $stdout, $stderr ) = System::Command->spawn( $^X, '-cw', @lib, $path );
# Retrieve the output.
my $output;
{
local $/ = undef;
$output = <$stderr>;
chomp( $output );
}
# Raise an exception if we didn't get "syntax OK".
die "$output\n"
view all matches for this distribution
view release on metacpan or search on metacpan
files => $test->{'files'},
repository => $repository,
);
# Try to commit.
my $stderr;
lives_ok(
sub
{
$stderr = Capture::Tiny::capture_stderr(
sub
{
$repository->run( 'commit', '-m', 'Test message.' );
}
);
note( $stderr );
},
'Commit the changes.',
);
like(
$stderr,
$test->{'expected'},
"The output matches expected results.",
);
}
);
view all matches for this distribution
view release on metacpan or search on metacpan
files => $test->{'files'},
repository => $repository,
);
# Try to commit.
my $stderr;
lives_ok(
sub
{
$stderr = Capture::Tiny::capture_stderr(
sub
{
$repository->run( 'commit', '-m', 'Test message.' );
}
);
note( $stderr );
},
'Commit the changes.',
);
like(
$stderr,
$test->{'expected'},
"The output matches expected results.",
);
}
);
view all matches for this distribution
view release on metacpan or search on metacpan
files => $test->{'files'},
repository => $repository,
);
# Try to commit.
my $stderr;
lives_ok(
sub
{
$stderr = Capture::Tiny::capture_stderr(
sub
{
$repository->run( 'commit', '-m', 'Test message.' );
}
);
note( $stderr );
},
'Commit the changes.',
);
like(
$stderr,
$test->{'expected'},
"The output matches expected results.",
);
}
);
view all matches for this distribution
view release on metacpan or search on metacpan
if !defined( $branch ) || ( $branch eq '' );
lives_ok(
sub
{
my $stderr = Capture::Tiny::capture_stderr(
sub
{
$repository->run( 'checkout', '-b', $branch );
}
);
note( $stderr );
},
'Switch branches.',
);
# Set up test files.
view all matches for this distribution
view release on metacpan or search on metacpan
files => $test->{'files'},
repository => $repository,
);
# Try to commit.
my $stderr;
lives_ok(
sub
{
$stderr = Capture::Tiny::capture_stderr(
sub
{
$repository->run( 'commit', '-m', 'Test message.' );
}
);
note( $stderr );
},
'Commit the changes.',
);
like(
$stderr,
$test->{'expected'},
"The output matches expected results.",
);
}
);
view all matches for this distribution
view release on metacpan or search on metacpan
files => $test->{'files'},
repository => $repository,
);
# Try to commit.
my $stderr;
my $exit_status;
lives_ok(
sub
{
$stderr = Capture::Tiny::capture_stderr(
sub
{
$repository->run( 'commit', '-m', $test->{'commit_message'} );
$exit_status = $? >> 8;
}
);
note( $stderr );
},
'Commit the changes.',
);
like(
$stderr,
$test->{'expected'},
"The output matches expected results.",
);
is(
view all matches for this distribution
view release on metacpan or search on metacpan
files => $test->{'files'},
repository => $repository,
);
# Try to commit.
my $stderr;
lives_ok(
sub
{
$stderr = Capture::Tiny::capture_stderr(
sub
{
$repository->run( 'commit', '-m', $test->{'commit_message'} );
}
);
note( $stderr );
},
'Commit the changes.',
);
like(
$stderr,
$test->{'expected'},
"The output matches expected results.",
);
}
);
view all matches for this distribution
view release on metacpan or search on metacpan
lib/App/GitHooks/Plugin/RubyCompile.pm view on Meta::CPAN
return $PLUGIN_RETURN_SKIPPED
if $git_action eq 'D';
# Execute ruby -c.
my $path = $repository->work_tree() . '/' . $file;
my ( $pid, $stdin, $stdout, $stderr ) = System::Command->spawn( 'ruby', '-W0', '-c', $path );
# Retrieve the output.
chomp( my $message_out = do { local $/ = undef; <$stdout> } );
# Raise an exception if we didn't get "syntax OK".
if ( $message_out !~ /^Syntax\ OK$/x ) {
my @warnings = <$stderr>;
foreach my $warning ( @warnings ) {
chomp( $warning );
$warning =~ s/^\Q$path\E:/Line /;
}
die join( "\n", @warnings ) . "\n";
view all matches for this distribution
view release on metacpan or search on metacpan
files => $test->{'files'},
repository => $repository,
);
# Try to commit.
my $stderr;
lives_ok(
sub
{
$stderr = Capture::Tiny::capture_stderr(
sub
{
$repository->run( 'commit', '-m', 'Test message.' );
}
);
note( $stderr );
},
'Commit the changes.',
);
like(
$stderr,
$test->{'expected'},
"The output matches expected results.",
);
}
);
view all matches for this distribution
view release on metacpan or search on metacpan
files => $test->{'files'},
repository => $repository,
);
# Try to commit.
my $stderr;
lives_ok(
sub
{
$stderr = Capture::Tiny::capture_stderr(
sub
{
$repository->run( 'commit', '-m', 'Test message.' );
}
);
note( $stderr );
},
'Commit the changes.',
);
like(
$stderr,
$test->{'expected'},
"The output matches expected results.",
);
}
);
view all matches for this distribution
view release on metacpan or search on metacpan
lib/App/GitHooks/Test.pm view on Meta::CPAN
path => 'test.pl',
content => "#!perl\n\nuse strict;\nbareword;\n",
);
# Try to commit.
my $stderr;
my $exit_status;
lives_ok(
sub
{
$stderr = Capture::Tiny::capture_stderr(
sub
{
$repository->run( 'commit', '-m', 'Test message.' );
$exit_status = $? >> 8;
}
);
note( $stderr );
},
'Commit the changes.',
);
like(
$stderr,
$test->{'expected'},
"The output matches expected results.",
);
is(
view all matches for this distribution
view release on metacpan or search on metacpan
lib/App/GitHubUtils.pm view on Meta::CPAN
}
log_info "Creating repo '%s' ...", $repo;
my ($out, $err);
IPC::System::Options::system(
{log=>1, capture_stdout=>\$out, capture_stderr=>\$err},
"github-cmd",
defined($args{github_cmd_config_profile}) ? ("--config-profile", $args{github_cmd_config_profile}) : (),
"create-repo", $repo);
my $exit = $?;
view all matches for this distribution
view release on metacpan or search on metacpan
t/01_issues.t view on Meta::CPAN
#!perl
use strict;
use warnings;
use utf8;
use Capture::Tiny qw/capture capture_stderr/;
use File::Spec::Functions qw/catfile/;
use FindBin;
use Hash::MultiValue;
use Plack::Request;
t/01_issues.t view on Meta::CPAN
subscribe => 'issues',
issues => 'opened',
),
});
my $got = capture_stderr{ $g2i->respond_to_ikachan($req) };
like $got, qr!\[INFO\] POST $channel, \00303\[issue opened \(#13\)\] This is new issue \(\@moznion\)\17 https://github.com/moznion/sandbox/issues/13!;
};
subtest 'issue closed' => sub {
open my $fh, '<', catfile($FindBin::Bin, 'resources', 'issues', 'closed.json');
t/01_issues.t view on Meta::CPAN
subscribe => 'issues',
issues => 'closed',
),
});
my $got = capture_stderr{ $g2i->respond_to_ikachan($req) };
like $got, qr!\[INFO\] POST $channel, \00303\[issue closed \(#13\)\] This is new issue \(\@moznion\)\17 https://github.com/moznion/sandbox/issues/13!;
};
subtest 'issue reopened' => sub {
open my $fh, '<', catfile($FindBin::Bin, 'resources', 'issues', 'reopened.json');
t/01_issues.t view on Meta::CPAN
subscribe => 'issues',
issues => 'reopened',
),
});
my $got = capture_stderr{ $g2i->respond_to_ikachan($req) };
like $got, qr!\[INFO\] POST $channel, \00303\[issue reopened \(#13\)\] This is new issue \(\@moznion\)\17 https://github.com/moznion/sandbox/issues/13!;
};
subtest 'subscribe all actions' => sub {
open my $fh, '<', catfile($FindBin::Bin, 'resources', 'issues', 'opened.json');
t/01_issues.t view on Meta::CPAN
payload => $payload,
subscribe => 'issues',
),
});
my $got = capture_stderr{ $g2i->respond_to_ikachan($req) };
like $got, qr!\[INFO\] POST $channel, \00303\[issue opened \(#13\)\] This is new issue \(\@moznion\)\17 https://github.com/moznion/sandbox/issues/13!;
};
subtest 'not subscribe action' => sub {
open my $fh, '<', catfile($FindBin::Bin, 'resources', 'issues', 'opened.json');
t/01_issues.t view on Meta::CPAN
subscribe => 'issues',
issues => 'close',
),
});
my $got = capture_stderr{ $g2i->respond_to_ikachan($req) };
ok !$got;
};
done_testing;
view all matches for this distribution