Script to update all my .travis.yml files at once

gistfile1.txt

#!/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( first_index uniq );
use Path::Class::Rule;
use Try::Tiny;
use YAML qw( Dump 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;

        no warnings 'once';
        local $YAML::QuoteNumericStrings = 1;
        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 ( ( $travis->{script} && $travis->{script}->@* > 3 )
        || grep { !/cpan-install/ } $travis->{install}->@* ) {

        my $i = ( first_index {/travis-perl|haarg/}
            $travis->{before_install}->@* ) // 0;
        $travis->{before_install}->[$i]
            = 'git clone git://github.com/travis-perl/helpers ~/travis-perl-helpers';
        $travis->{before_install}->[ $i + 1 ]
            = 'source ~/travis-perl-helpers/init';
    }
    else {
        delete $travis->{install};
        delete $travis->{script};

        my $i = ( first_index {/travis-perl|haarg/}
            $travis->{before_install}->@* ) // 0;
        $travis->{before_install}[$i]
            = 'eval $(curl https://travis-perl.github.io/init) --auto';
        splice( $travis->{before_install}->@*, $i + 1, 0 );
    }

    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 { $_ eq 'dev' ? $_ : ( $_, $_ . '-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', 'aspell-en',
        )
    ];

    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();