gistfile1.pl

#!/usr/bin/env perl

use strict;
use warnings;

use 5.20.0;
use feature 'postderef';
no warnings 'experimental::postderef';

use File::pushd qw( pushd );
use File::Slurper qw( write_text );
use Getopt::Long;
use List::AllUtils qw( uniq );
use Path::Class::Rule;
use Try::Tiny;
use YAML qw( Dump DumpFile LoadFile );

sub main {
    my $dir;
    GetOptions( 'dir:s' => \$dir );
    die "You must provide a --dir option\n" unless $dir;

    my $iter = Path::Class::Rule->new;
    $iter->file->name('.travis.yml');
    my $next = $iter->iter($dir);

    while ( defined( my $file = $next->() ) ) {
        my $dir = pushd( $file->parent );
        next unless `git remote show -n origin` =~ /autarch|urth/;

        my $err;
        my $travis = try {
            LoadFile('.travis.yml');
        }
        catch {
            $err = "YAML parsing error: $_\n";
        };

        next unless $travis || $err;

        if ($err) {
            print "\n\n\n", $file, "\n";
            print $err;
            next;
        }

        _update_travis($travis)
            or next;

        my $yaml = Dump($travis);
        $yaml = _fixup_yaml($yaml);

        print "\n\n\n", $file, "\n";
        print $yaml;

        write_text( '.travis.yml', $yaml );
    }
}

sub _update_travis {
    my $travis = shift;

    return 0
        unless grep {/perl-travis-helper|travis-perl/}
        $travis->{before_install}->@*;

    _fixup_helpers_usage($travis);
    _rewrite_perl_block($travis);
    _update_matrix($travis);
    _maybe_disable_sudo($travis);

    return 1;
}

sub _fixup_helpers_usage {
    my $travis = shift;

    if ( grep { !/cpan-install/ } $travis->{install}->@* ) {
        $travis->{before_install}->[0]
            = 'git clone git://github.com/travis-perl/helpers ~/travis-perl-helpers';
        $travis->{before_install}->[1] = 'source ~/travis-perl-helpers/init';
    }
    else {
        delete $travis->{install};
        delete $travis->{script};

        $travis->{before_install}
            = ['eval $(curl https://travis-perl.github.io/init) --auto'];
    }

    return;
}

my @all_perls = qw(
    blead
    dev
    5.22.0
    5.20.2
    5.18.3
    5.16.3
    5.14.4
    5.12.5
    5.10.1
    5.8.8
);

sub _rewrite_perl_block {
    my $travis = shift;

    my $has_xs = Path::Class::Rule->new->file->name(qr/\.xs/)->all('.');

    my @perls = @all_perls;
    unless ( grep {/5\.8/} $travis->{perl}->@* ) {
        pop @perls;
    }

    if ($has_xs) {
        $travis->{perl} = [ map { $_, $_ . '-thr' } @perls ];
    }
    else {
        $travis->{perl} = [ map { $_ =~ s/\.\d+$//r } @perls ];
    }

    return;
}

sub _update_matrix {
    my $travis = shift;

    $travis->{matrix} = {
        include => [
            {
                perl => '5.22',
                env  => 'COVERAGE=1',
            }
        ],
        allow_failures => [ { perl => 'blead' } ],
    };

    return;
}

sub _maybe_disable_sudo {
    my $travis = shift;

    return
        if grep {/sudo/}
        map     { $travis->{$_}->@* }
        grep    { exists $travis->{$_} } qw( before_install install );

    $travis->{sudo} = 0;
    $travis->{addons}{apt}{packages}
        = [ sort { $a cmp $b } uniq( $travis->{addons}{apt}{packages}->@*, 'aspell' ) ];

    return;
}

my @blocks_order = qw(
    sudo
    addons
    language
    perl
    matrix
    env
    before_install
    install
    script
    notifications
);

my %known_blocks = map { $_ => 1 } @blocks_order;

sub _fixup_yaml {
    my $yaml = shift;

    $yaml =~ s/sudo: 0/sudo: false/g;

    my $re = qr/^
                (([a-z][^\n]+): # key:
                    (?:
                        (?:$)\n.+?
                    |
                        \ .+?\n
                    )
                )
                (?=^[a-z]|\z)
               /xms;

    my %blocks;
    while ( $yaml =~ /$re/g ) {
        $blocks{$2} = $1;
    }

    for my $block ( keys %blocks ) {
        die "Unknown block: $block" unless $known_blocks{$block};
    }

    return "---\n" . join q{}, map { $blocks{$_} }
        grep { $blocks{$_} } @blocks_order;
}

main();