diffchanges.pl

#!/usr/bin/env perl
use strict;
use warnings;

# Usage: cpan-outdated -v | diffchanges.pl

use LWP::UserAgent;
use Algorithm::Diff;

my $ua = LWP::UserAgent->new;

while ( my $line = <STDIN> ) {
    my ($dist, $instv, $cpanv, $file) = split /\s+/, $line;
    $dist =~ s/::/-/g;

    printf "%s %s => %s\n", $dist, $instv, $cpanv;

    my $change_file_name;
    my $old_changes;
    for my $tmp_change_file_name ( qw/Changes CHANGES Changelog ChangeLog CHANGELOG/ ) {
        my $res = $ua->get(qq{http://cpansearch.perl.org/dist/$dist-$instv/$tmp_change_file_name});
        unless ( $res->is_success && $res->request->uri =~ m/$tmp_change_file_name$/ ) {
            next;
        }
        $old_changes = $res->content;
        if ( $old_changes ) {
            $change_file_name = $tmp_change_file_name;
            last;
        }
    }
    if ( !$old_changes || !$change_file_name ) {
        print "no old_changes", "\n\n";
        next;
    }

    my $res = $ua->get(qq{http://cpansearch.perl.org/dist/$dist-$cpanv/$change_file_name});
    unless ( $res->is_success && $res->request->uri =~ m/$change_file_name$/ && $res->content) {
        print "no new_changes", "\n\n";
        next;
    }
    my $new_changes = $res->content;

    print_diff($old_changes, $new_changes);
    print "\n";
}


sub print_diff {
    my ($old_changes, $new_changes) = @_;

    my $diff = Algorithm::Diff->new( [split /\n/, $old_changes], [split /\n/, $new_changes] );

    # copy from Algorithm::Diff SYNOPSYS
    $diff->Base( 1 );   # Return line numbers, not indices
    while(  $diff->Next()  ) {
        next   if  $diff->Same();
        my $sep = '';
        if(  ! $diff->Items(2)  ) {
            printf "%d,%dd%d\n",
                $diff->Get(qw( Min1 Max1 Max2 ));
        } elsif(  ! $diff->Items(1)  ) {
            printf "%da%d,%d\n",
                $diff->Get(qw( Max1 Min2 Max2 ));
        } else {
            $sep = "---\n";
            printf "%d,%dc%d,%d\n",
                $diff->Get(qw( Min1 Max1 Min2 Max2 ));
        }
        print "< $_\n"   for  $diff->Items(1);
        print $sep;
        print "> $_\n"   for  $diff->Items(2);
    }
}