Group
Extension

Dist-Zilla-PluginBundle-Author-KENTNL/utils/delta_meta.pl

#!/usr/bin/env perl

use strict;
use warnings;
use utf8;

if ( @ARGV != 2 ) {
  warn "Expected: delta_deps OLD.JSON NEW.JSON";
}

use JSON;
use Data::Dump qw( pp );
use Path::Tiny qw( path );
use Data::Difference qw( data_diff );

my $transcoder = JSON->new();
my $left       = $transcoder->decode( path( $ARGV[0] )->slurp );
my $right      = $transcoder->decode( path( $ARGV[1] )->slurp );

for my $bad (qw( prereqs x_Dist_Zilla x_BuiltWith )) {
  delete $left->{$bad};
  delete $right->{$bad};
}

sub get_type {
  if ( not exists $_[0]->{b} and exists $_[0]->{a} ) {
    return 'removed';
  }
  if ( exists $_[0]->{b} and not exists $_[0]->{a} ) {
    return 'added';
  }
  if ( exists $_[0]->{b} and exists $_[0]->{a} ) {
    return 'changed';
  }
  die "Unhandled combination";
}

my $colors = {
  added   => "\e[32m",
  removed => "\e[31m",
  changed => "\e[34m",
};
binmode( *STDOUT, ':utf8' );

sub prefix_data {
  my ( $prefix, $suffix, $data ) = @_;
  my (@lines) = split qq[\n], $data;
  return join q[], map { $prefix . $_ . $suffix } @lines;
}

for my $d ( data_diff( $left, $right ) ) {
  my $type  = get_type($d);
  my $color = $colors->{$type};
  print "$color$type\e[0m: " . join q[/], @{ $d->{path} };
  print qq[\n];
  if ( $type eq 'added' ) {
    print prefix_data( qq[+\t ] . $color, qq{\e[0m\n}, pp( $d->{b} ) );
  }
  if ( $type eq 'removed' ) {
    print prefix_data( qq[-\t ] . $color, qq{\e[0m\n}, pp( $d->{a} ) );
  }
  if ( $type eq 'changed' ) {
    print prefix_data( qq[-\t ] . $colors->{removed}, qq{\e[0m\n}, pp( $d->{a} ) );
    print prefix_data( qq[+\t ] . $colors->{added},   qq{\e[0m\n}, pp( $d->{b} ) );
  }
}


Powered by Groonga
Maintained by Kenichi Ishigaki <ishigaki@cpan.org>. If you find anything, submit it on GitHub.