Add script for managing updates to deps

1 files changed, 389 insertions, 0 deletions

diff --git a/tools/update-deps-releases.pl b/tools/update-deps-releases.pl
new file mode 100755
index 000000000..586ae0fe4
--- /dev/null
+++ b/tools/update-deps-releases.pl
@@ -0,0 +1,389 @@
+#!/usr/bin/perl
+
+use v5.10;
+use strict;
+use warnings;
+
+use File::Slurp qw(slurp write_file);
+use File::stat;
+use File::Touch;
+use Data::Dumper qw(Dumper);
+use Carp;
+use Term::ANSIColor;
+use Term::ReadKey;
+use List::Util qw(first unpairs);
+use Clone qw(clone);
+
+sub get_deps {
+    my ($config, %fdeps) = @_;
+
+    my %deps;
+
+    return { } unless $config =~ /\{\s*deps\s*,\s*\[(.*?)\]/s;
+    my $sdeps = $1;
+
+    while ($sdeps =~ /\{\s*(\w+)\s*,\s*".*?"\s*,\s*\{\s*git\s*,\s*"(.*?)"\s*,\s*(?:{\s*tag\s*,\s*"(.*?)"|"(.*?)" )/sg) {
+        next unless not %fdeps or exists $fdeps{$1};
+        $deps{$1} = { repo => $2, commit => $3 || $4 };
+    }
+    return \%deps;
+}
+my (%info_updates, %top_deps_updates, %sub_deps_updates, @operations);
+
+sub top_deps {
+    state %deps;
+    if (not %deps) {
+        my $config = slurp "rebar.config";
+        croak "Unable to extract floating_deps" unless $config =~ /\{floating_deps, \[(.*?)\]/s;
+
+        my $fdeps = $1;
+        $fdeps =~ s/\s*//g;
+        my %fdeps = map { $_ => 1 } split /,/, $fdeps;
+        %deps = %{get_deps($config, %fdeps)};
+    }
+    return {%deps, %top_deps_updates};
+}
+
+sub update_deps_repos {
+    my $deps = top_deps();
+    mkdir(".deps-update") unless -d ".deps-update";
+    for my $dep (keys %{$deps}) {
+        my $dd = ".deps-update/$dep";
+        if (not -d $dd) {
+            say "Downloading $dep...";
+            my $repo = $deps->{$dep}->{repo};
+            $repo =~ s/^https?/git/;
+            system("git", "-C", ".deps-update", "clone", $repo);
+        } elsif (time() - stat($dd)->mtime > 24 * 60 * 60) {
+            say "Updating $dep...";
+            system("git", "-C", $dd, "fetch");
+            touch($dd)
+        }
+    }
+}
+
+sub sub_deps {
+    state %sub_deps;
+    if (not %sub_deps) {
+        my $deps = top_deps();
+        for my $dep (keys %{$deps}) {
+            my $rc = ".deps-update/$dep/rebar.config";
+            $sub_deps{$dep} = { };
+            next unless -f $rc;
+            $sub_deps{$dep} = get_deps(scalar(slurp($rc)));
+        }
+    }
+    return {%sub_deps, %sub_deps_updates};
+}
+
+sub rev_deps_helper {
+    my ($rev_deps, $dep) = @_;
+    if (not exists $rev_deps->{$dep}->{indirect}) {
+        my %deps = %{$rev_deps->{$dep}->{direct} || {}};
+        for (keys %{$rev_deps->{$dep}->{direct}}) {
+            %deps = (%deps, %{rev_deps_helper($rev_deps, $_)});
+        }
+        $rev_deps->{$dep}->{indirect} = \%deps;
+    }
+    return $rev_deps->{$dep}->{indirect};
+}
+
+sub rev_deps {
+    state %rev_deps;
+    if (not %rev_deps) {
+        my $sub_deps = sub_deps();
+        for my $dep (keys %$sub_deps) {
+            $rev_deps{$_}->{direct}->{$dep} = 1 for keys %{$sub_deps->{$dep}};
+        }
+        for my $dep (keys %$sub_deps) {
+            $rev_deps{$dep}->{indirect} = rev_deps_helper(\%rev_deps, $dep);
+        }
+    }
+    return \%rev_deps;
+}
+
+sub update_changelog {
+    my ($dep, $version, @reasons) = @_;
+    my $cl = ".deps-update/$dep/CHANGELOG.md";
+    return if not -f $cl;
+    my $reason = join "\n", map {"* $_"} @reasons;
+    my $content = slurp($cl);
+    if (not $content =~ /^# Version $version/) {
+        $content = "# Version $version\n\n$reason\n\n$content"
+    } else {
+        $content =~ s/(# Version $version\n\n)/$1$reason\n/;
+    }
+    write_file($cl, $content);
+}
+
+sub update_app_src {
+    my ($dep, $version) = @_;
+    my $app = ".deps-update/$dep/src/$dep.app.src";
+    return if not -f $app;
+    my $content = slurp($app);
+    $content =~ s/({\s*vsn\s*,\s*)".*"/$1"$version"/;
+    write_file($app, $content);
+}
+
+sub update_deps_versions {
+    my ($config_path, %deps) = @_;
+    my $config = slurp $config_path;
+
+    for (keys %deps) {
+        $config =~ s/(\{\s*$_\s*,\s*".*?"\s*,\s*\{\s*git\s*,\s*".*?"\s*,\s*)(?:{\s*tag\s*,\s*"(.*?)"\s*}|"(.*?)" )/$1\{tag, "$deps{$_}"}/s;
+    }
+
+    write_file($config_path, $config);
+}
+
+sub cmp_ver {
+    my @a = split /(\d+)/, $a;
+    my @b = split /(\d+)/, $b;
+    my $is_num = 1;
+
+    return - 1 if $#a == 0;
+    return 1 if $#b == 0;
+
+    while (1) {
+        my $ap = shift @a;
+        my $bp = shift @b;
+        $is_num = 1 - $is_num;
+
+        if (defined $ap) {
+            if (defined $bp) {
+                if ($is_num) {
+                    next if $ap == $bp;
+                    return 1 if $ap > $bp;
+                    return - 1;
+                } else {
+                    next if $ap eq $bp;
+                    return 1 if $ap gt $bp;
+                    return - 1;
+                }
+            } else {
+                return 1;
+            }
+        } elsif (defined $bp) {
+            return - 1;
+        } else {
+            return 0;
+        }
+    }
+}
+
+sub deps_git_info {
+    state %info;
+    if (not %info) {
+        my $deps = top_deps();
+        for my $dep (keys %{$deps}) {
+            my $dir = ".deps-update/$dep";
+            my @tags = `git -C "$dir" tag`;
+            chomp(@tags);
+            @tags = sort cmp_ver @tags;
+            my $last_tag = $tags[$#tags];
+            my @new = `git -C $dir log --oneline $last_tag..origin/master`;
+            my $new_tag = $last_tag;
+            $new_tag =~ s/(\d+)$/$1+1/e;
+            chomp(@new);
+            $info{$dep} = { last_tag => $last_tag, new_commits => \@new, new_tag => $new_tag };
+        }
+    }
+    return { %info, %info_updates };
+}
+
+sub show_commands {
+    my %commands = @_;
+    my @keys;
+    while (@_) {
+        push @keys, shift;
+        shift;
+    }
+    for (@keys) {
+        say color("red"), $_, color("reset"), ") $commands{$_}";
+    }
+    ReadMode(4);
+    while (1) {
+        my $key = ReadKey(0);
+        if (defined $commands{uc($key)}) {
+            ReadMode(0);
+            say "";
+            return uc($key);
+        }
+    }
+}
+
+sub schedule_operation {
+    my ($type, $dep, $tag, $reason, $op) = @_;
+
+    my $idx = first { $operations[$_]->{dep} eq $dep } 0..$#operations;
+
+    if (defined $idx) {
+        push @{$operations[$idx]->{reasons}}, $reason;
+        push @{$operations[$idx]->{operations}}, $op;
+        return if $type eq "update";
+        $operations[$idx]->{type} = $type;
+        $info_updates{$dep}->{new_commits} = [];
+        return;
+    }
+
+    my $info = deps_git_info();
+
+    $top_deps_updates{$dep} = {commit => $tag};
+    $info_updates{$dep} = {last_tag => $tag, new_tag => $tag,
+        new_commits => $type eq "tupdate" ? [] : $info->{$dep}->{new_commits}};
+
+    my $rev_deps = rev_deps();
+    @operations = sort {
+        exists $rev_deps->{$a->{dep}}->{indirect}->{$b->{dep}} ? -1 :
+            exists $rev_deps->{$b->{dep}}->{indirect}->{$a->{dep}} ? 1 : $a->{dep} cmp $b->{dep}
+    } (@operations, {
+            type => $type,
+            dep => $dep,
+            version => $tag,
+            reasons => ($reason ? [$reason] : []),
+            operations => ($op ? [$op] : [])}
+    );
+
+    my $sub_deps = sub_deps();
+
+    for (keys %{$rev_deps->{$dep}->{direct}}) {
+        schedule_operation("update", $_, $info->{$_}->{new_tag}, "Updating $dep to version $tag.", [$dep, $tag]);
+        $sub_deps_updates{$_} = $sub_deps_updates{$_} || clone($sub_deps->{$_});
+        $sub_deps_updates{$_}->{$dep}->{commit} = $tag;
+    }
+}
+
+sub git_tag {
+    my ($dep, $ver, $msg) = @_;
+
+    system("git", "-C", ".deps-update/$dep", "commit", "-a", "-m", $msg);
+    system("git", "-C", ".deps-update/$dep", "tag", $ver);
+}
+
+sub git_push {
+    my ($dep) = @_;
+    system("git", "-C", ".deps-update/$dep", "push");
+    system("git", "-C", ".deps-update/$dep", "push", "--tags");
+}
+
+update_deps_repos();
+
+while (1) {
+    my $top_deps = top_deps();
+    my $git_info = deps_git_info();
+    print color("bold blue"), "Dependences with newer tags:\n", color("reset");
+    my $old_deps = 0;
+    for my $dep (sort keys %$top_deps) {
+        next unless $git_info->{$dep}->{last_tag} ne $top_deps->{$dep}->{commit};
+        say color("red"), "$dep", color("reset"), ": $top_deps->{$dep}->{commit} -> $git_info->{$dep}->{last_tag}";
+        $old_deps = 1;
+    }
+    say "(none)" if not $old_deps;
+    say "";
+
+    print color("bold blue"), "Dependences that have commits after last tags:\n", color("reset");
+    my $changed_deps = 0;
+    for my $dep (sort keys %$top_deps) {
+        next unless @{$git_info->{$dep}->{new_commits}};
+        say color("red"), "$dep", color("reset"), " ($top_deps->{$dep}->{commit}):";
+        say "  $_" for @{$git_info->{$dep}->{new_commits}};
+        $changed_deps = 1;
+    }
+    say "(none)" if not $changed_deps;
+    say "";
+
+    my $cmd = show_commands($old_deps ? (U => "Update dependency") : (),
+        $changed_deps ? (T => "Tag new release") : (),
+        @operations ? (A => "Apply changes") : (),
+        E => "Exit");
+    last if $cmd eq "E";
+
+    if ($cmd eq "U") {
+        while (1) {
+            my @deps_to_update;
+            my @od;
+            my $idx = 1;
+            for my $dep (sort keys %$top_deps) {
+                next unless $git_info->{$dep}->{last_tag} ne $top_deps->{$dep}->{commit};
+                $od[$idx] = $dep;
+                push @deps_to_update, $idx++, "Update $dep to $git_info->{$dep}->{last_tag}";
+            }
+            last if $idx == 1;
+            my $cmd = show_commands(@deps_to_update, E => "Exit");
+            last if $cmd eq "E";
+
+            my $dep = $od[$cmd];
+            schedule_operation("update", $dep, $git_info->{$dep}->{last_tag});
+
+            $top_deps = top_deps();
+            $git_info = deps_git_info();
+        }
+    }
+
+    if ($cmd eq "T") {
+        while (1) {
+            my @deps_to_tag;
+            my @od;
+            my $idx = 1;
+            for my $dep (sort keys %$top_deps) {
+                next unless @{$git_info->{$dep}->{new_commits}};
+                $od[$idx] = $dep;
+                push @deps_to_tag, $idx++, "Tag $dep with version $git_info->{$dep}->{new_tag}";
+            }
+            last if $idx == 1;
+            my $cmd = show_commands(@deps_to_tag, E => "Exit");
+            last if $cmd eq "E";
+
+            my $dep = $od[$cmd];
+            my $d = $git_info->{$dep};
+            schedule_operation("tupdate", $dep, $d->{new_tag});
+
+            $top_deps = top_deps();
+            $git_info = deps_git_info();
+        }
+    }
+
+    if ($cmd eq "A") {
+        $top_deps = top_deps();
+        $git_info = deps_git_info();
+        my $sub_deps = sub_deps();
+
+        for my $dep (keys %$top_deps) {
+            for my $sdep (keys %{$sub_deps->{$dep}}) {
+                next if $sub_deps->{$dep}->{$sdep}->{commit} eq $top_deps->{$sdep}->{commit};
+                schedule_operation("update", $dep, $git_info->{$dep}->{new_tag},
+                    "Updating $sdep to version $top_deps->{$sdep}->{commit}.", [$sdep, $top_deps->{$sdep}->{commit}]);
+            }
+        }
+
+        %info_updates = ();
+        %top_deps_updates = ();
+        %sub_deps_updates = ();
+
+        $top_deps = top_deps();
+        $git_info = deps_git_info();
+        $sub_deps = sub_deps();
+
+        my %top_changes;
+        for my $op (@operations) {
+            update_changelog($op->{dep}, $op->{version}, @{$op->{reasons}})
+                if @{$op->{reasons}};
+            update_deps_versions(".deps-update/$op->{dep}/rebar.config", unpairs(@{$op->{operations}}))
+                if @{$op->{operations}};
+            if ($git_info->{$op->{dep}}->{last_tag} ne $op->{version}) {
+                update_app_src($op->{dep}, $op->{version});
+                git_tag($op->{dep}, $op->{version}, "Release $op->{version}");
+            }
+
+            $top_changes{$op->{dep}} = $op->{version};
+        }
+        update_deps_versions("rebar.config", %top_changes);
+
+        for my $op (@operations) {
+            if ($git_info->{$op->{dep}}->{last_tag} ne $op->{version}) {
+                git_push($op->{dep});
+            }
+        }
+        last;
+    }
+}