(maint) Add extra maint tooling
cherry-picks of 5b87fc0f74 and 55586a638f
Peter Rabbitson authored 7 years ago
Peter Rabbitson committed 3 years ago
|
0 |
#!/bin/bash
|
|
1 |
|
|
2 |
set -e
|
|
3 |
|
|
4 |
[[ -e Makefile.PL ]] || ( echo "Not in the right dir" && exit 1 )
|
|
5 |
|
|
6 |
clear
|
|
7 |
echo
|
|
8 |
|
|
9 |
export TRAVIS=true
|
|
10 |
export TRAVIS_REPO_SLUG="x/DBIx-Class"
|
|
11 |
export DBI_DSN="dbi:ODBC:server=NonexistentServerAddress"
|
|
12 |
export DBI_DRIVER="ADO"
|
|
13 |
|
|
14 |
toggle_booleans=( \
|
|
15 |
$( grep -ohP '\bDBIC_[0-9_A-Z]+' -r lib/ --exclude-dir Optional | sort -u | grep -vP '^(DBIC_TRACE(_PROFILE)?|DBIC_.+_DEBUG)$' ) \
|
|
16 |
DBIC_SHUFFLE_UNORDERED_RESULTSETS \
|
|
17 |
DBICTEST_ASSERT_NO_SPURIOUS_EXCEPTION_ACTION \
|
|
18 |
DBICTEST_RUN_ALL_TESTS \
|
|
19 |
DBICTEST_SQLITE_REVERSE_DEFAULT_ORDER \
|
|
20 |
)
|
|
21 |
|
|
22 |
for var in "${toggle_booleans[@]}"
|
|
23 |
do
|
|
24 |
if [[ -z "${!var}" ]] ; then
|
|
25 |
export $var=1
|
|
26 |
echo -n "$var "
|
|
27 |
fi
|
|
28 |
done
|
|
29 |
echo -e "\n\n^^ variables above **automatically** set to '1'"
|
|
30 |
|
|
31 |
provecmd="nice prove -QlrswTj10"
|
|
32 |
|
|
33 |
echo -e "
|
|
34 |
Executing \`$provecmd $@\` via $(which perl) within the following environment:
|
|
35 |
|
|
36 |
$(env | grep -P 'TEST|HARNESS|MAKE|TRAVIS|PERL|DBIC|PATH|SHELL' | LC_ALL=C sort | cat -v)
|
|
37 |
"
|
|
38 |
|
|
39 |
$provecmd "$@"
|
|
0 |
#!/usr/bin/env perl
|
|
1 |
|
|
2 |
use warnings;
|
|
3 |
use strict;
|
|
4 |
|
|
5 |
use HTTP::Tiny;
|
|
6 |
use JSON::PP;
|
|
7 |
|
|
8 |
( my $build_id = $ARGV[0]||'' ) =~ /^[0-9]+$/
|
|
9 |
or die "Expecting a numeric build id as argument\n";
|
|
10 |
|
|
11 |
my $base_url = "http://api.travis-ci.com/build/$build_id?include=build.jobs";
|
|
12 |
print "Retrieving $base_url\n";
|
|
13 |
|
|
14 |
my $resp = (
|
|
15 |
my $ua = HTTP::Tiny->new( default_headers => { 'Travis-API-Version' => 3 } )
|
|
16 |
)->get( $base_url );
|
|
17 |
|
|
18 |
die "Unable to retrieve $resp->{url}: $resp->{status}\n$resp->{content}\n\n"
|
|
19 |
unless $resp->{success};
|
|
20 |
|
|
21 |
my @jobs = ( map
|
|
22 |
{ ( ($_->{id}||'') =~ /^([0-9]+)$/ ) ? [ $1 => $_->{number} ] : () }
|
|
23 |
@{( eval { decode_json( $resp->{content} )->{jobs} } || [] )}
|
|
24 |
) or die "Unable to find any jobs:\n$resp->{content}\n\n";
|
|
25 |
|
|
26 |
my $dir = "TravisCI_build_$build_id";
|
|
27 |
|
|
28 |
mkdir $dir
|
|
29 |
unless -d $dir;
|
|
30 |
|
|
31 |
for my $job (@jobs) {
|
|
32 |
my $log_url = "http://api.travis-ci.com/v3/job/$job->[0]/log.txt";
|
|
33 |
my $dest_fn = "$dir/job_$job->[1].$job->[0].log.gz";
|
|
34 |
|
|
35 |
print "Retrieving $log_url into $dest_fn\n";
|
|
36 |
|
|
37 |
$resp = $ua->mirror( $log_url, $dest_fn, {
|
|
38 |
headers => { 'Accept-Encoding' => 'gzip' }
|
|
39 |
});
|
|
40 |
warn "Error retrieving $resp->{url}: $resp->{status}\n$resp->{content}\n\n"
|
|
41 |
unless $resp->{success};
|
|
42 |
}
|