update-schemas

#!/usr/bin/env perl
# vim: set ts=8 sts=2 sw=2 tw=100 et ft=perl :
use strict;
use warnings;
use 5.020;
no autovivification warn => qw(fetch store exists delete);
use if "$]" >= 5.022, experimental => 're_strict';
no if "$]" >= 5.031009, feature => 'indirect';
no if "$]" >= 5.033001, feature => 'multidimensional';
no if "$]" >= 5.033006, feature => 'bareword_filehandles';
no if "$]" >= 5.041009, feature => 'smartmatch';
no feature 'switch';
use open ':std', ':encoding(UTF-8)'; # force stdin, stdout, stderr into utf8
use Mojo::File 'path';
use Mojo::UserAgent;
use Digest::MD5 'md5_hex';
use JSON::Schema::Modern 0.624;
use Test::File::ShareDir -share => { -dist => { 'OpenAPI-Modern' => 'share' } };
use lib 'lib';  # make sure we load the newly-patched version of our modules
use OpenAPI::Modern::Utilities qw(OAS_SCHEMAS OAS_VERSIONS);

# { download URL -> filename (in share) }
my %files = (
  (OpenAPI::Modern::Utilities::_BUNDLED_SCHEMAS->%{ map @$_, values OAS_SCHEMAS->%* }),
  'https://raw.githubusercontent.com/OAI/OpenAPI-Specification/main/LICENSE' => 'oas/LICENSE',
);

my $web_url = 'https://spec.openapis.org/oas';

my $ua = Mojo::UserAgent->new(max_redirects => 3);
say "# fetching   $web_url" if $ENV{DEBUG};
my $res = $ua->get($web_url)->result;
die "Failed to fetch $web_url", $res->code, " ", $res->message if $res->is_error;

# keys are existing OAS schema URLs, as listed in OpenAPI::Modern::Utilities
# values is the list of all schemas found on the website of the same type
my %new_schemas;

# check the website and find all files that are newer than what we've got
my $links;
foreach my $e ($res->dom->find('a[href]')->each) {
  my $link = $e->{href};
  next if $link !~ m{^/oas/(?:${\ join('|', map quotemeta($_), OAS_VERSIONS->@*)})/[a-z-]+/\d{4}-\d{2}-\d{2}\z};

  ++$links;
  $link = Mojo::URL->new($web_url)->path($link)->to_string; # get full URL, normalizing slashes

  if (my ($existing) = grep !/github/ && $link =~ m{^\Q${\substr($_, 0, -10)}\E}, keys %files) {
    $new_schemas{$existing} //= [];
    push $new_schemas{$existing}->@*, $link if $existing lt $link;
  }
}

die "no links found on $web_url?!" if not $links;

# identify outdated schema files, and replace all references to them in the repository
if (my @outdated_schemas = grep $new_schemas{$_}->@*, reverse sort keys %new_schemas) {
  warn join("\n", 'these outdated entries will be replaced everywhere they are found (including in this script itself):',
    map "$_ -> $new_schemas{$_}->[0]", @outdated_schemas), "\n\n";

  # now we just keep track of the newest version of each..
  %new_schemas = map +($_ => $new_schemas{$_}->[0]), @outdated_schemas;

  if ($ENV{DEBUG}) {
    foreach my $outdated (@outdated_schemas) {
      say 'replacing "'.$outdated.'" with "'.$new_schemas{$outdated}.'"';
    }
  }

  foreach my $file (split("\n", `git ls-files`) ) {
    next if $file =~ m{^share/oas/};  # skip references in the files we are replacing

    $file = path($file);
    my $content = $file->slurp;
    $content =~ s/$_/$new_schemas{$_}/g foreach @outdated_schemas;
    $file->spew($content);
  }

  # update the values of %files for all schemas that are outdated
  # we want to download even unchanged files to make sure the checksum matches
  foreach my $outdated (@outdated_schemas) {
    $files{$new_schemas{$outdated}} = delete $files{$outdated};
  }
}

my $json_decoder = JSON::Schema::Modern::_JSON_BACKEND()->new->utf8(1);
my $js = JSON::Schema::Modern->new;
my %checksums;

# download fresh copies of all files, validate against their schemas
foreach my $uri (sort keys %files) {
  my $target = $files{$uri};

  say "# fetching   $uri -> share/$target" if $ENV{DEBUG};
  my $res = $ua->get($uri)->result;
  die "Failed to fetch $uri", $res->code, " ", $res->message if $res->is_error;

  $target = path('share', $target);
  $target->dirname->make_path;
  my $exists = -e $target;
  $target->spew(my $content = $res->body);
  system('git add '.$target) if not $exists;
  $checksums{$target} = md5_hex($content);

  next if $target->basename eq 'LICENSE';

  # perform a simple validation, which should use a metaschema that is already preloaded into the
  # JSON::Schema::Modern instance
  my $schema = $json_decoder->decode($content);
  say '# validating ', $schema->{'$id'}, ' -> ', $target if $ENV{DEBUG};
  my $result = $js->validate_schema($schema, { strict => 1, validate_formats => 1 });
  die $result->dump if not $result->valid;
}

# update checksums for other dirty files
if (keys %checksums) {
  foreach my $file (glob('share/3.*/*')) {
    system(qw(git diff --quiet --stat), $file);
    $checksums{$file} = md5_hex(path($file)->slurp) if $?;
  }
}

# compute checksums and record them in the test, preserving unaffected entries
my $checksums_file = path('t/checksums.t');
my $checksums_content = $checksums_file->slurp;
$checksums_content =~ m/^__DATA__$/mg;
%checksums = ((split /\s/, substr($checksums_content, pos($checksums_content)+1)), %checksums);
$checksums_file->spew(substr($checksums_content, 0, pos($checksums_content)+1)
  .join("\n", map $_.' '.$checksums{$_}, sort keys %checksums)."\n");

# only edit Changes file if there are updated files to be committed
my @changed_versions = grep +(
  system('git diff --quiet --stat share/oas/'.$_) >> 8
), OAS_VERSIONS->@*;

if (@changed_versions) {
  my ($seen_next, $seen_blank);
  my $versions = (@changed_versions > 1 ? 's ' : ' ').join(', ', @changed_versions);
  say '# edited Changes file for OAS version'.$versions if $ENV{DEBUG};

  my $changes_file = path('Changes');
  my $changes_content = $changes_file->slurp('UTF-8');
  $changes_content =~ m/^\{\{\$NEXT\}\}$/mg;
  $changes_content =~ m/^$/mg;    # find first empty line after {{$NEXT}}, and insert before it.
  my $leader = ' 'x10;
  $changes_content =~ s/\G/$leader- updated bundled schemas for OAS version${versions} to their latest\n$leader  published versions\n/m;
  $changes_file->spew($changes_content, 'UTF-8');

  exec 'git commit -m"update bundled schemas for OAS '.join(', ', @changed_versions).' to latest versions" Changes lib share t';
}
else {
  say '# no changes to bundled schemas';
}