carton_merge.pl

#!/usr/bin/env perl

use v5.22;

use feature qw(signatures);
no warnings qw(experimental::signatures);

use Getopt::Long;
use Carton::Snapshot;

my $file_left = Carton::Snapshot->new( path => $ARGV[0] );
my $file_right =
  Carton::Snapshot->new( path => $ARGV[1] || 'cpanfile.snapshot' );

$file_left->load;
$file_right->load;

my $p =
  Getopt::Long::Parser->new( config => [ "no_ignore_case", "pass_through" ], );

my $version_from;
my $merge_direction;
my $ignore_missing;
my $outfile;

$p->getoptions(
  "vf|version=s" => \$version_from,
  "m|merge=s"    => \$merge_direction,
  "no-missing"   => \$ignore_missing,
  "outfile=s"    => \$outfile,
);

$merge_direction //= 'right';
$version_from    //= 'right';
$ignore_missing  //= 0;
$outfile         //= 'cpanfile.snapshot';

my %modules_left =
  map { $_->name =~ s/-[0-9._]+$//r => $_ } $file_left->distributions;
my %modules_right =
  map { $_->name =~ s/-[0-9._]+$//r => $_ } $file_right->distributions;

my $merged         = Carton::Snapshot->new( path => $outfile );
my $merge          = {};
my $retain_version = $merge_direction eq $version_from;

$merge =
  merge( \%modules_left, \%modules_right, $retain_version, $ignore_missing )
  if $merge_direction eq 'right'
;

$merge =
  merge( \%modules_right, \%modules_left, $retain_version, $ignore_missing )
  if $merge_direction eq 'left'
;

$merged->add_distribution($_) for values %$merge;
$merged->save;

sub merge ( $from, $into, $retain_version, $ignore_missing ) {
  foreach my $dist ( keys %$from ) {
    $into->{$dist} = $from->{$dist} if $into->{$dist} && !$retain_version;
    $into->{$dist} = $from->{$dist} if ( !$into->{$dist} && !$ignore_missing );
  }

  return $into;
}