Ticket #1044: tracetwobranches.pl

#!/usr/local/bin/perl
# tracetwobranches.pl
use strict;
use warnings;
use 5.10.0;
use Carp;
use File::Temp;
use Getopt::Long;
use lib qw( /home/jimk/gitwork/parrot/lib );
use Parrot::Configure::Trace;

my $topdir = q{/home/user};
my $sandbox = qq{$topdir/gitwork/parrot};
chdir $sandbox or croak "Unable to change to $sandbox: $!";
my (@branches, @els);
my $max_step = '';
GetOptions(
    'branch=s' => \@branches,
    'max-step=i' => \$max_step,
    'el=s' => \@els,
) or exit(1);

croak "Must provide 2 branches as command-line arguments"
    unless (@branches == 2);
croak "Must provide at least 1 Parrot::Configure 'data' element"
    unless @els;
my @outputs;
foreach my $br (@branches) {
    push @outputs, traceformatteddiff($br, \@els, $max_step);
}

say $_ for @outputs;
prepare_run($branches[0]);

sub traceformatteddiff {
    my ($br, $elsref, $max_step) = @_;
    my $rv = prepare_run($br);
    my $output = '';
    $output .= "Working on branch $br\n";
    croak "prepare_run() did not exit properly" unless $rv;
    system(qq{$^X Configure.pl --configure_trace})
        and croak "Unable to configure";
    croak ".configure_trace.sto not found"
        unless (-e './.configure_trace.sto');
    my $obj = Parrot::Configure::Trace->new();
    croak "Parrot::Configure::Trace object undefined"
        unless defined $obj;
    foreach my $el (@$elsref) {
        $output .= "Element: $el\n";
        my $attr = $obj->diff_data_c( {
            attr        => $el,
        } );
        foreach my $step (@$attr) {
            my $human_step = $step->{number} + 1;
            unless ($max_step and $human_step > $max_step) {
                $output .= sprintf("# %2d  %s\n" =>
                    ($human_step, $step->{name})
                );
                $output .= "  before: '$step->{before}'\n";
                $output .= "   after: '$step->{after}'\n";
            }
        }
        $output .= "\n";
    }

    return $output;
}

sub prepare_run {
    my $br = shift;
    if (-e 'Makefile') {
        system(q{make realclean --quiet 1>/dev/null})
            and croak "Unable to make realclean";
    }
    system(qq{git checkout $br})
        and croak "Unable to checkout $br";
    return 1;
}