From: Graham Knop <haarg@haarg.org>
Date: Mon, 6 Apr 2020 15:26:33 +0000 (+0200)
Subject: add ppport checks and commands
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=d7576b8196124dc3838ea120e9f53ad9f07b2dae;p=p5sagit%2FDistar.git

add ppport checks and commands
---

diff --git a/lib/Distar.pm b/lib/Distar.pm
index c597b9a..2d98ccc 100644
--- a/lib/Distar.pm
+++ b/lib/Distar.pm
@@ -189,6 +189,7 @@ END_FRAG
 
     my $distar_lib = File::Basename::dirname(__FILE__);
     my $helpers = File::Spec->catdir($distar_lib, 'Distar', 'helpers');
+    my $abshelpers = File::Spec->rel2abs($helpers);
 
     my $licenses = $self->{LICENSE} || $self->{META_ADD}{license} || $self->{META_MERGE}{license};
     my $authors = $self->{AUTHOR};
@@ -198,6 +199,7 @@ END_FRAG
     my %vars = (
       DISTAR_LIB => $self->quote_literal($distar_lib),
       HELPERS => $self->quote_literal($helpers),
+      ABSHELPERS => $self->quote_literal($abshelpers),
       REMAKE => join(' ', '$(PERLRUN)', '-I$(DISTAR_LIB)', '-MDistar', 'Makefile.PL', map { $self->quote_literal($_) } @ARGV),
       BRANCH => $self->{BRANCH} ||= 'master',
       CHANGELOG => $self->{CHANGELOG} ||= 'Changes',
@@ -302,6 +304,37 @@ END_FRAG
       ],
     ), @bump_targets;
 
+    if ( $self->{XS} && keys %{ $self->{XS} } ) {
+      my $ppport_options = '';
+
+      if (my $perl_version = $self->{MIN_PERL_VERSION}) {
+        $ppport_options .= " --compat-version=$perl_version";
+      }
+
+      $vars{PPPORT_OPTIONS} = $ppport_options;
+      $vars{PPPORT_FILE} = 'ppport.h';
+
+      push @out, (
+        'ppport-update:', [
+          '$(ABSPERLRUN) $(HELPERS)/ppport update $(PPPORT_FILE)',
+        ],
+        'ppport-patch:', [
+          '$(ABSPERLRUN) $(HELPERS)/ppport patch $(PPPORT_FILE) $(PPPORT_OPTIONS) $(XS_FILES)',
+        ],
+        'ppport-strip: create_distdir', [
+          $self->cd('$(DISTVNAME)',
+            '$(ABSPERLRUN) $(ABSHELPERS)/ppport strip $(PPPORT_FILE) $(XS_FILES)',
+          ),
+        ],
+        'pppatch: ppport-patch',
+        'check-ppport:' => [
+          '$(ABSPERLRUN) $(HELPERS)/ppport check $(PPPORT_FILE) $(PPPORT_OPTIONS) $(XS_FILES)',
+        ],
+        'preflight: check-ppport',
+        'distdir: ppport-strip',
+      );
+    }
+
     join('',
       $dist_test,
       "\n\n# --- Distar section:\n\n",
diff --git a/lib/Distar/helpers/ppport b/lib/Distar/helpers/ppport
new file mode 100755
index 0000000..9127966
--- /dev/null
+++ b/lib/Distar/helpers/ppport
@@ -0,0 +1,152 @@
+#!/usr/bin/env perl
+use strict;
+use warnings;
+
+sub filter_file {
+  my ($old, $filter) = @_;
+  my $new = "$old.$$.new";
+  $filter ||= sub { shift };
+
+  open my $in, '<', $old,
+    or die "unable to read $old: $!";
+  open my $out, '>', $new
+    or die "unable to write $new: $!";
+
+  while (<$in>) {
+    print $out $filter->($_);
+  }
+  close $in;
+  close $out;
+  rename $new, $old
+    or die "Unable to update $old: $!";
+}
+
+my $command = shift;
+my $ppport = shift;
+
+if ($command eq 'update') {
+  if (!eval { require Devel::PPPort }) {
+    print STDERR "Devel::PPPort not installed, cannot update!\n";
+    exit 1;
+  }
+
+  require HTTP::Tiny;
+  require version;
+  require JSON::PP;
+
+  my $local_ppport_version;
+  my $installed_ppport_version = Devel::PPPort->VERSION;
+  my $remote_ppport_version;
+
+  {
+    my $ua = HTTP::Tiny->new(verify_SSL => 1);
+    my $proto = eval { HTTP::Tiny->can_ssl } ? 'https' : 'http';
+    my $res = $ua->get("$proto://fastapi.metacpan.org/v1/module/Devel::PPPort");
+    if ($res->{success}) {
+      my $content = $res->{content};
+      my $data = JSON::PP::decode_json($content);
+      if (my $v = $data->{version}) {
+        $remote_ppport_version = version->new($v);
+      }
+    }
+  }
+
+  if ($remote_ppport_version) {
+    if ($remote_ppport_version > $installed_ppport_version) {
+      print STDERR "Updated version of Devel::PPPort ($remote_ppport_version) is available!\n";
+      print STDERR "Installed version is $installed_ppport_version.\n";
+    }
+  }
+  else {
+    print STDERR "Unable to check latest version of Devel::PPPort!\n";
+  }
+
+  if (-f $ppport and my $v = `"$^X" "$ppport" --version`) {
+    if ($v =~ /\AThis is .* (v?\d+(?:\.\d+)*)\.?\n?\z/) {
+      $local_ppport_version = version->new($1);
+    }
+    elsif ($v =~ /stripped/) {
+      print "Updating stripped $ppport to $installed_ppport_version.\n";
+      exec $^X, $ppport, '--unstrip';
+    }
+  }
+
+  if ($local_ppport_version > $installed_ppport_version) {
+    print STDERR "Refusing to downgrade $ppport $local_ppport_version using Devel::PPPort $installed_ppport_version.\n";
+    exit 1;
+  }
+  elsif ($local_ppport_version < $installed_ppport_version) {
+    print "Updating $ppport from $local_ppport_version to $installed_ppport_version.\n";
+    Devel::PPPort::WriteFile($ppport);
+  }
+  else {
+    print "$ppport ($local_ppport_version) is up to date.\n";
+  }
+}
+elsif ($command eq 'diff') {
+  exec $^X, $ppport, '--quiet', @ARGV;
+}
+elsif ($command eq 'check') {
+  my @args = @ARGV;
+  my $args = join ' ', map qq{"$_"}, @args;
+  my $output = `"$^X" "$ppport" --quiet $args`;
+  if ($output =~ /\S/) {
+    print STDERR "$ppport requires changes:\n";
+    print $output;
+    exit 1;
+  }
+}
+elsif ($command eq 'patch') {
+  my @args = @ARGV;
+  my @files = grep -f, @args;
+  my $out = system $^X, $ppport, '--copy=.pppatch', @args;
+  for my $file (@files) {
+    my $patched = "$file.pppatch";
+    if (-e $patched) {
+      rename $patched, $file;
+    }
+  }
+  exit $out;
+}
+elsif ($command eq 'strip') {
+  if (!-f $ppport) {
+    exit 0;
+  }
+
+  my @files = @ARGV;
+  my $have_ppport;
+  XS_FILES: for my $file (@files) {
+    open my $fh, '<', $file
+      or die "unable to read $file: $!";
+    while (<$fh>) {
+      if (m{^\s*#include "(?:\.\.?/)*\Q$ppport\E"}) {
+        $have_ppport = 1;
+        last XS_FILES;
+      }
+    }
+    close $fh;
+  }
+  if ($have_ppport) {
+    print "Stripping $ppport\n";
+
+    # break hardlinks
+    filter_file($ppport);
+
+    system $^X, $ppport, '--strip';
+  }
+  else {
+    print "Removing unused ppport.h";
+
+    filter_file('MANIFEST', sub {
+      my $line = shift;
+      $line =~ /\A\Q$ppport\E\s/ ? '' : $line;
+    });
+
+    unlink $ppport
+      or die "Unable to delete $ppport: $!";
+  }
+  exit 0;
+}
+else {
+  die "Invalid command!\n";
+}